# Copyright (c) 2002 Peter Guntert. All rights reserved.
## 7MACROS: bmrblist - CYANA macro
## 
## Parameters: file                      (required)
## 
## Writes a chemical shift list in the format of the BioMagResBank (for
## details, see http://www.bmrb.wisc.edu).

var i ii iq j k m n aa at s p out

syntax file=@f.bmrb

subroutine rescode string var
var olc tlc i
olc:='LGAVIPSTEDQNKRHFYWMC'
tlc:='LEU GLY ALA VAL ILE PRO SER THR GLU ASP GLN ASN LYS ARG HIS PHE TYR TRP MET CYS'
string:='$string'
if (lenstr(string).eq.1) then
  i=4*(index(olc,string)-1)+1
  if (i.lt.1) error "Unknown residue $string."
  $var:=$tlc(i:i+2)
else
  i=(index(tlc,string(1:3))+3)/4
  if (i.lt.1) error "Unknown residue $string."
  $var:=$olc(i:i)
end if
end


# ---- Write sequence with one letter codes ----

print "    _Residue_sequence_char_string" >$file
print >>
print ";" >>
do i 1 nr 20
  s:=
  do j i min(nr,i+19)
    rescode $rnam(j) aa
    s:={$s}$aa
  end do
  print " $s" >>
end do
print ";" >>
print >>

# ---- Write sequence with three letter codes and residue numbers ----

print "    loop_" >>
print "        _Residue_seq_code" >>
print "        _Residue_label" >>
print >>
do i 1 nr 5
  s:=
  do j i min(nr,i+4)
    n=rnum(j)-8; aa=rnam(j)
    s:='$s  $n(1:4) $aa(1:3)  '
  end do
  print "$s" >>
end do
print >>
print "    stop_" >>
print >>

# ---- Write chemical shifts ----

print "  loop_" >>
print "    _Chem_shift_list_number"    >>       
print "    _Residue_seq_code"          >>        
print "    _Residue_label"             >>         
print "    _Atom_name"                 >>         
print "    _Atom_type"                 >>
print "    _Chem_shift_value"          >>
print "    _Chem_shift_value_error"    >>
print "    _Chem_shift_ambiguity_type" >>
print >>
m=0
do i 1 na
  if (abs(shift(i,1)).lt.900.0) then
    j=iar(i); n=rnum(j)-8; aa=rnam(j); s=shift(i,1)
    if (element(i).eq.1) then
      m=m+1; at=anam(i); p=if(stereopartner(i).le.0,1,2)
      print "$m(1:6) $n(1:6) $aa(1:3)    $at(1:6) $at(1:1) $s(F9.2)  . $p(I4)" >>
    else if (element(i).gt.1) then
      m=m+1; at=anam(i); p=if(stereopartner(i).le.0,1,2)
      print "$m(1:6) $n(1:6) $aa(1:3)    $at(1:6) $at(1:1) $s(F8.1)   . $p(I4)" >>
    else if (numpro(i).eq.3 .and. element(max(1,heavyatom(i))).eq.6) then
      m=m+1; at=anam(i); p=if(stereopartner(i).le.0,1,2)
      print "$m(1:6) $n(1:6) $aa(1:3)    H$at(2:6) H $s(F9.2)  . $p(I4)" >>
    else
      do ii ifira(iar(i)) ifira(iar(i)+1)-1
        iq=pseudoatom(ii)
        if (iq.eq.i) then
          if (element(ii).ne.0) then
            m=m+1; at=anam(ii); p=if(stereopartner(ii).eq.0,3,2)
            print "$m(1:6) $n(1:6) $aa(1:3)    $at(1:6) $at(1:1) $s(F9.2)  . $p(I4)" >>
          else if (numpro(ii).eq.3 .and. element(max(1,heavyatom(ii))).eq.6) then
            m=m+1; at=anam(ii); p=2
            print "$m(1:6) $n(1:6) $aa(1:3)    H$at(2:6) H $s(F9.2)  . $p(I4)" >>
          else
            do k=ifira(iar(i)),ifira(iar(i)+1)-1
              iq=pseudoatom(k)
              if (iq.eq.ii) then
                m=m+1; at=anam(k); p=if(stereopartner(k).le.0,3,2)
                print "$m(1:6) $n(1:6) $aa(1:3)    $at(1:6) $at(1:1) $s(F9.2)  . $p(I4)" >>
              end if
            end do
          end if
        end if
      end do
    end if
  end if
end do
print >>
print " stop_" >>.
print "    BioMagResBank file \"$file\" written, $m chemical shift entries."