Changeset bd2278d for addend.f


Ignore:
Timestamp:
09/05/08 11:49:42 (16 years ago)
Author:
baerbaer <baerbaer@…>
Branches:
master
Children:
fafe4d6
Parents:
2ebb8b6
Message:

Reformatting comments and continuation marks.

Fortran 90 and higher use ! to mark comments no matter where they are in the
code. The only valid continuation marker is &.
I also added the SMMP.kdevelop.filelist to the repository to make it easier
to use kdevelop.

git-svn-id: svn+ssh://svn.berlios.de/svnroot/repos/smmp/trunk@12 26dc1dd8-5c4e-0410-9ffe-d298b4865968

File:
1 edited

Legend:

Unmodified
Added
Removed
  • addend.f

    r2ebb8b6 rbd2278d  
    1 c **************************************************************
    2 c
    3 c
    4 c This file contains the subroutines:  addend, redchg, rplgrp
    5 c
    6 c Copyright 2003-2005  Frank Eisenmenger, U.H.E. Hansmann,
    7 c                      Shura Hayryan, Chin-Ku
    8 c Copyright 2007       Frank Eisenmenger, U.H.E. Hansmann,
    9 c                      Jan H. Meinke, Sandipan Mohanty
    10 c
    11 c $Id: addend.f 334 2007-08-07 09:23:59Z meinke $
    12 c **************************************************************
     1! **************************************************************
     2!
     3!
     4! This file contains the subroutines:  addend, redchg, rplgrp
     5!
     6! Copyright 2003-2005  Frank Eisenmenger, U.H.E. Hansmann,
     7!                      Shura Hayryan, Chin-Ku
     8! Copyright 2007       Frank Eisenmenger, U.H.E. Hansmann,
     9!                      Jan H. Meinke, Sandipan Mohanty
     10!
     11! $Id: addend.f 334 2007-08-07 09:23:59Z meinke $
     12! **************************************************************
    1313      subroutine addend(nml,grpn,grpc)
    1414
    15 c ..............................................................
    16 c  PURPOSE:  modify terminal residues to complete bonding scheme
    17 c            with residue 'grpn' at N- and residue 'grpc' at C-terminus
    18 c            ! need initial co-ordinates for residues to modify
    19 c            ! for N-terminus: may add only simple groups
    20 c
    21 c  CALLS:  rplgrp,tolost,redchg
    22 c ..............................................................
     15! ..............................................................
     16!  PURPOSE:  modify terminal residues to complete bonding scheme
     17!            with residue 'grpn' at N- and residue 'grpc' at C-terminus
     18!            ! need initial co-ordinates for residues to modify
     19!            ! for N-terminus: may add only simple groups
     20!
     21!  CALLS:  rplgrp,tolost,redchg
     22! ..............................................................
    2323 
    2424      include 'INCL.H'
     
    3535
    3636      if (grn(:3).eq.'ace'.or.grc(:3).eq.'ace'
    37      #.or.grn(:3).eq.'nme'.or.grc(:3).eq.'nme') then
     37     &.or.grn(:3).eq.'nme'.or.grc(:3).eq.'nme') then
    3838
    3939        write(*,'(2a)') ' addend> N-Acetyl (ace) or N-Methylamide (nme)'
    40      #   ,' should be put in SEQUENCE file, not added as end groups'
     40     &   ,' should be put in SEQUENCE file, not added as end groups'
    4141
    4242        stop
    4343      endif
    4444
    45 c __________________________________________ N-terminus
     45! __________________________________________ N-terminus
    4646      ifirs=irsml1(nml)
    4747      rpat='n   '
     
    5555            else
    5656              write (*,'(2a)') ' addend> ',
    57      #         ' No N-terminal Hyp possible with ECEPP/3 dataset'
     57     &         ' No N-terminal Hyp possible with ECEPP/3 dataset'
    5858              stop
    5959            endif
     
    8383
    8484          write(*,'(2a)') ' addend> Can add only ',
    85      *     'nh2 or nh3+ to N-terminus'
     85     &     'nh2 or nh3+ to N-terminus'
    8686          stop
    8787
     
    9494
    9595        write(*,'(2a)') ' addend> Acetyl group',
    96      #     ' at N-terminus not modified'
    97       endif
    98 
    99 c __________________________________________ C-terminus
     96     &     ' at N-terminus not modified'
     97      endif
     98
     99! __________________________________________ C-terminus
    100100      ilars=irsml2(nml)
    101101      rpat='c   '
     
    124124
    125125          write(*,'(2a)') ' addend> Can add only ',
    126      #     'cooh or coo- to C-terminus'
     126     &     'cooh or coo- to C-terminus'
    127127          stop
    128128
     
    135135
    136136        write(*,'(2a)') ' addend> N-Methylamide',
    137      #     ' at C-terminus not modified'
    138 
    139       endif
    140 
    141 c ----------------------------- net charge of molecule
     137     &     ' at C-terminus not modified'
     138
     139      endif
     140
     141! ----------------------------- net charge of molecule
    142142      cg = 0.d0
    143143      do i=iatrs1(irsml1(nml)),iatrs2(irsml2(nml))
     
    145145      enddo
    146146      if (abs(cg).gt.1.d-5) write(*,'(a,i2,a,f7.3,/)')
    147      #        ' addend> Net charge of molecule #'
    148      #        ,nml,': ',cg
     147     &        ' addend> Net charge of molecule #'
     148     &        ,nml,': ',cg
    149149
    150150      return
    151151      end
    152 c ****************************************
     152! ****************************************
    153153      subroutine rplgrp(nml,nrs,rpat,sbrs)
    154154
    155 c ...............................................................
    156 c PURPOSE: replace atom(s) rooted at atom 'rpat' in residue
    157 c          'nrs' of molecule 'nml' by atom(s) rooted at
    158 c          'rpat' of residue 'sbrs' (same name of root
    159 c          atom 'rpat' maintains bonding geometry for
    160 c          preceeding atoms in 'nrs')
    161 c
    162 c          is NOT performed if 'rpat' is within mainchain,
    163 c          except it is first/last mainchain atom of 'nml'
    164 c
    165 c CALLS: dihedr,iopfil,iendst,eyring,fndbrn,redres,setsys,valang
    166 c ...............................................................
     155! ...............................................................
     156! PURPOSE: replace atom(s) rooted at atom 'rpat' in residue
     157!          'nrs' of molecule 'nml' by atom(s) rooted at
     158!          'rpat' of residue 'sbrs' (same name of root
     159!          atom 'rpat' maintains bonding geometry for
     160!          preceeding atoms in 'nrs')
     161!
     162!          is NOT performed if 'rpat' is within mainchain,
     163!          except it is first/last mainchain atom of 'nml'
     164!
     165! CALLS: dihedr,iopfil,iendst,eyring,fndbrn,redres,setsys,valang
     166! ...............................................................
    167167
    168168      include 'INCL.H'
     
    180180      nfi=iatrs1(nrs)
    181181      nla=iatrs2(nrs)
    182 c __________________________ indices of atoms to be replaced
     182! __________________________ indices of atoms to be replaced
    183183      do i=nfi,nla
    184184        if (rpat.eq.nmat(i)) then
     
    188188      enddo
    189189      write (*,'(4a,i4,a,i4)') ' rplgrp> cannot find atom >',rpat,
    190      #'< to be replaced in residue ',seq(nrs),nrs,' of molecule ',nml
     190     &'< to be replaced in residue ',seq(nrs),nrs,' of molecule ',nml
    191191      stop
    192192
     
    218218              if (ibdrg.ne.0) then
    219219                write (*,'(2a,i3)')
    220      #             ' rplgrp> Can handle only simple ring at 1st',
    221      #             ' atom of molecule #',nml
     220     &             ' rplgrp> Can handle only simple ring at 1st',
     221     &             ' atom of molecule #',nml
    222222                stop
    223223              endif
     
    245245        else
    246246          write (*,'(4a,i4,a,i4)')
    247      #      ' rplgrp> Cannot replace BACKBONE atom ',rpat,
    248      #      ' of residue ',seq(nrs),nrs,' in molecule #',nml
     247     &      ' rplgrp> Cannot replace BACKBONE atom ',rpat,
     248     &      ' of residue ',seq(nrs),nrs,' in molecule #',nml
    249249          stop
    250250        endif
    251251
    252252      endif  ! N-terminus
    253 c _________________________________ previous atoms
     253! _________________________________ previous atoms
    254254    2 if (nfirp.eq.nfi.and.nrs.eq.ifirs) goto 11
    255255      nxtbb1=iowat(nfirp)
    256256      if (nxtbb1.eq.nfi.and.nrs.eq.ifirs) goto 11
    257257      nxtbb2=iowat(nxtbb1)
    258 c _______________________________ get data for substituent atoms
     258! _______________________________ get data for substituent atoms
    259259    3 if (iopfil(lunlib,reslib,'old','formatted').le.izero) then
    260260        write (*,'(a,/,a,i3,2a)')
    261      #    ' rplgrp> ERROR opening library of residues:',
    262      #    ' LUN=',lunlib,' FILE=',reslib(1:iendst(reslib))
     261     &    ' rplgrp> ERROR opening library of residues:',
     262     &    ' LUN=',lunlib,' FILE=',reslib(1:iendst(reslib))
    263263        stop
    264264      endif
    265265      call redres(sbrs,natsb,nxtsb,nvrsb)
    266266      close (lunlib)
    267 c __________________________ indices of substituent atoms
     267! __________________________ indices of substituent atoms
    268268      do i=1,natsb
    269269        if (rpat.eq.nmath(i)) then
     
    273273      enddo
    274274      write (*,'(4a)') ' rplgrp> Cannot find atom >',rpat,
    275      #'< in substituent residue ',sbrs
     275     &'< in substituent residue ',sbrs
    276276      stop
    277277
     
    288288        enddo  ! ... branch atoms
    289289    5 enddo  ! ... branches
    290 c _________________________________________________ local axes at 'nfirp'
     290! _________________________________________________ local axes at 'nfirp'
    291291      call setsys(nxtbb1,nfirp,nxtbb2,x1,x2,x3,y1,y2,y3,z1,z2,z3)
    292292
     
    298298      zbaat(nfirp)=z3
    299299
    300 c _____________________ add virtual atoms
     300! _____________________ add virtual atoms
    301301      if (ntbb) then
    302302
     
    306306        sa=snbaat(nxtbb1)
    307307
    308 c ------------------- Eyring
     308! ------------------- Eyring
    309309        h2=-sa*ct
    310310        h3=-sa*st
     
    331331        st=sntoat(nxtbb1)
    332332
    333 c -------------------- Eyring with b.angle = 90 deg.
     333! -------------------- Eyring with b.angle = 90 deg.
    334334        xat(-ione)=xat(izero)-ct*(z2*x3-z3*x2)-st*z1
    335335        yat(-ione)=yat(izero)-ct*(z3*x1-z1*x3)-st*z2
     
    337337
    338338      endif
    339 c _____________________________________________ Shift atom data
     339! _____________________________________________ Shift atom data
    340340      nrp=nlarp-nfirp
    341341      nsb=nlasb-nfisb
     
    407407
    408408        enddo
    409 c ____________________________________________ Shift residue data
     409! ____________________________________________ Shift residue data
    410410        do i=nrs+1,irsml2(ntlml)
    411411          iatrs1(i)=iatrs1(i)+nsh
     
    418418        nsh=0
    419419      endif
    420 c _________________________________________ Correct data of 'nfirp'
     420! _________________________________________ Correct data of 'nfirp'
    421421      ish=nfirp-nfisb
    422422      ityat(nfirp)=ityath(nfisb)
     
    450450          if (nb.gt.mxbd) then
    451451            write (*,'(6a,/,2a,3(i4,a))')
    452      #      ' rplgrp> Cannot add atoms following ',rpat,
    453      #      ' from group ',sbrs,' to atom ',rpat,
    454      #      ' of residue ',seq(nrs),nrs,' in molecule #',nml,
    455      #      ' because need >',(mxbd+1),' bonds'
     452     &      ' rplgrp> Cannot add atoms following ',rpat,
     453     &      ' from group ',sbrs,' to atom ',rpat,
     454     &      ' of residue ',seq(nrs),nrs,' in molecule #',nml,
     455     &      ' because need >',(mxbd+1),' bonds'
    456456            stop
    457457          endif
     
    474474      endif
    475475      nbdat(nfirp)=nb
    476 c _________________________________________ Add data for substituent
     476! _________________________________________ Add data for substituent
    477477      ii=nfirp
    478478      do i=nfisb+1,nlasb
     
    527527
    528528      enddo  ! substituent atoms
    529 c ___________________________________________________ Take care of Variables
    530 c (assume variables of replaced group/substituent to be stored CONSECUTIVELY)
     529! ___________________________________________________ Take care of Variables
     530! (assume variables of replaced group/substituent to be stored CONSECUTIVELY)
    531531
    532532      ilavr=ivrml1(ntlml)+nvrml(ntlml)-1
     
    610610
    611611      return
    612 c __________________________________________ Errors
     612! __________________________________________ Errors
    613613   10 write (*,'(3a,/,2a,i4,a,i4,/,2a)')
    614      #   ' rplgrp> Cannot replace atom(s) following ',rpat,
    615      #   ' from INSIDE a ring','    in residue: ',seq(nrs),nrs,
    616      #   ' in molecule #',nml,' or in substitute: ',sbrs
     614     &   ' rplgrp> Cannot replace atom(s) following ',rpat,
     615     &   ' from INSIDE a ring','    in residue: ',seq(nrs),nrs,
     616     &   ' in molecule #',nml,' or in substitute: ',sbrs
    617617      stop
    618618   11 write (*,'(4a,i4,a,i4,/,a)')
    619      #   ' rplgrp> Cannot replace atom(s) following ',rpat,
    620      #   ' of residue ',seq(nrs),nrs,' in molecule #',nml,
    621      #   ' since necessary 2 previous atoms are not available'
     619     &   ' rplgrp> Cannot replace atom(s) following ',rpat,
     620     &   ' of residue ',seq(nrs),nrs,' in molecule #',nml,
     621     &   ' since necessary 2 previous atoms are not available'
    622622      stop
    623623
    624624      end
    625 c ****************************************
     625! ****************************************
    626626      subroutine redchg(nml,nrs,rpat,sbrs)
    627627
    628 c .........................................................
    629 c PURPOSE: read and place atomic point charges from residue
    630 c          'sbrs' to residue 'nrs' of molecule 'nml'
    631 c          from library 'chglib' with LUN=lunchg, if ilib=1
    632 c                       'reslib' with LUN=lunlib, if ilib=2
    633 c
    634 c CALLS: iopfil,iendst,tolost
    635 c ........................................................
     628! .........................................................
     629! PURPOSE: read and place atomic point charges from residue
     630!          'sbrs' to residue 'nrs' of molecule 'nml'
     631!          from library 'chglib' with LUN=lunchg, if ilib=1
     632!                       'reslib' with LUN=lunlib, if ilib=2
     633!
     634! CALLS: iopfil,iendst,tolost
     635! ........................................................
    636636
    637637      include 'INCL.H'
     
    677677        if (iopfil(lunchg,chgfil,'old','formatted').le.izero) then
    678678          write (*,'(a,/,a,i3,2a)')
    679      #      ' redchg> ERROR opening library of charges:',
    680      #      ' LUN=',lunchg,' FILE=',chgfil(1:iendst(chgfil))
     679     &      ' redchg> ERROR opening library of charges:',
     680     &      ' LUN=',lunchg,' FILE=',chgfil(1:iendst(chgfil))
    681681          stop
    682682        endif
     
    701701              enddo
    702702              write (*,'(6a)') ' redchg> Cannot find atom: ',atnm,
    703      #                        ' for entry: ',cgty,' in library: ',
    704      #                        chgfil(1:iendst(chgfil))
     703     &                        ' for entry: ',cgty,' in library: ',
     704     &                        chgfil(1:iendst(chgfil))
    705705              stop
    706706    2       enddo
     
    708708          else
    709709            write (*,'(4a)')
    710      #       ' redchg> must increase MXATH to read data for entry: ',
    711      #        cgty,' in library: ',chgfil(1:iendst(chgfil))
     710     &       ' redchg> must increase MXATH to read data for entry: ',
     711     &        cgty,' in library: ',chgfil(1:iendst(chgfil))
    712712            close(lunchg)
    713713            stop
     
    716716        goto 1
    717717    3   write (*,'(4a)')
    718      #   ' redchg> Cannot find entry: ',cgty,' in library: ',
    719      #      chgfil(1:iendst(chgfil))
     718     &   ' redchg> Cannot find entry: ',cgty,' in library: ',
     719     &      chgfil(1:iendst(chgfil))
    720720        close(lunchg)
    721721        stop
     
    725725        if (iopfil(lunlib,reslib,'old','formatted').le.izero) then
    726726          write (*,'(a,/,a,i3,2a)')
    727      #      ' redchg> ERROR opening library of residues:',
    728      #      ' LUN=',lunlib,' FILE=',reslib(1:iendst(reslib))
     727     &      ' redchg> ERROR opening library of residues:',
     728     &      ' LUN=',lunlib,' FILE=',reslib(1:iendst(reslib))
    729729          stop
    730730        endif
     
    748748              enddo
    749749              write (*,'(6a)') ' redchg> Cannot find atom: ',atnm,
    750      #                        ' for entry: ',cgty,' in library: ',
    751      #                        reslib(1:iendst(reslib))
     750     &                        ' for entry: ',cgty,' in library: ',
     751     &                        reslib(1:iendst(reslib))
    752752              stop
    753753    5       enddo
     
    755755          else
    756756            write (*,'(4a)')
    757      #       ' redchg> must increase MXATH to read data for entry: ',
    758      #        cgty,' in library: ',reslib(1:iendst(reslib))
     757     &       ' redchg> must increase MXATH to read data for entry: ',
     758     &        cgty,' in library: ',reslib(1:iendst(reslib))
    759759            close(lunchg)
    760760            stop
     
    763763        goto 4
    764764    6   write (*,'(4a)')
    765      #   ' redchg> Cannot find entry: ',cgty,' in library: ',
    766      #      reslib(1:iendst(reslib))
     765     &   ' redchg> Cannot find entry: ',cgty,' in library: ',
     766     &      reslib(1:iendst(reslib))
    767767        close(lunchg)
    768768        stop
     
    771771
    772772   10 write (*,'(4a)')
    773      #    ' redchg> Do not have charges for N/C-terminal residue ',
    774      #    res,' modified with group :',sbrs
     773     &    ' redchg> Do not have charges for N/C-terminal residue ',
     774     &    res,' modified with group :',sbrs
    775775      stop
    776776
Note: See TracChangeset for help on using the changeset viewer.