Changeset bd2278d for mklist.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

  • mklist.f

    r2ebb8b6 rbd2278d  
    1 c **************************************************************
    2 c
    3 c This file contains the subroutines: mklist,quench
    4 c
    5 c Copyright 2003-2005  Frank Eisenmenger, U.H.E. Hansmann,
    6 c                      Shura Hayryan, Chin-Ku
    7 c Copyright 2007       Frank Eisenmenger, U.H.E. Hansmann,
    8 c                      Jan H. Meinke, Sandipan Mohanty
    9 c
    10 c **************************************************************
     1! **************************************************************
     2!
     3! This file contains the subroutines: mklist,quench
     4!
     5! Copyright 2003-2005  Frank Eisenmenger, U.H.E. Hansmann,
     6!                      Shura Hayryan, Chin-Ku
     7! Copyright 2007       Frank Eisenmenger, U.H.E. Hansmann,
     8!                      Jan H. Meinke, Sandipan Mohanty
     9!
     10! **************************************************************
    1111
    1212      subroutine mklist(nml)
    1313
    14 c ......................................................................
    15 c PURPOSE: Compile interaction lists ('1-4' according to Scheraga)
    16 c
    17 c CALLS: quench
    18 c ......................................................................
    19 c TODO: Calculate van-der-Waals regions over all molecules.
     14! ......................................................................
     15! PURPOSE: Compile interaction lists ('1-4' according to Scheraga)
     16!
     17! CALLS: quench
     18! ......................................................................
     19! TODO: Calculate van-der-Waals regions over all molecules.
    2020      include 'INCL.H'
    2121
    2222      parameter (mxh=50,         ! max. # of atom regions
    23      #           mx2=50)
     23     &           mx2=50)
    2424
    2525      logical ovlp,quench
    2626
    2727      dimension l1st1(mxh),l1st2(mxh),l2nd1(mxh),l2nd2(mxh)
    28      #         ,l1i(mxbd),l2i(mx2)
    29 
    30 c _______________________ indices of 1st vdw-region/14-partner for 'nml'
     28     &         ,l1i(mxbd),l2i(mx2)
     29
     30! _______________________ indices of 1st vdw-region/14-partner for 'nml'
    3131      if (nml.eq.1) then
    3232        ivwml1(1)=1
    … …  
    4040      if (ntlms.eq.0) then
    4141        write (*,'(a,i4)')
    42      #           ' mklist> No mov. sets defined in molecule #',nml
     42     &           ' mklist> No mov. sets defined in molecule #',nml
    4343        nvwml(nml)=0
    4444        n14ml(nml)=0
    … …  
    4848      nvw=ivwml1(nml)-1     ! # of vdw-regions we have so far
    4949      n14=i14ml1(nml)-1     ! # of 14-partners      -"-
    50 c First atom in molecule
     50! First atom in molecule
    5151      ifiat=iatrs1(irsml1(nml))
    52 c Last atom in molecule
     52! Last atom in molecule
    5353      ilaat=iatrs2(irsml2(nml))
    54 c First variable in molecule
     54! First variable in molecule
    5555      ifivr=ivrml1(nml)
    56 c Last variable in molecule
     56! Last variable in molecule
    5757      ilavr=ifivr+nvrml(nml)-1
    58 c ____________________________ initialize: 1st vdw-region & 14-partner per atom
     58! ____________________________ initialize: 1st vdw-region & 14-partner per atom
    5959      do i=ifiat,ilaat
    6060        ivwat1(i)=0         !!!  for some atoms ...
    … …  
    7474        if ((i2s-i1s+1).gt.0) then
    7575
    76 c ____________ exclude mov.sets of var. 'iv' from 1ST list of interact.partn.
     76! ____________ exclude mov.sets of var. 'iv' from 1ST list of interact.partn.
    7777          do is=i1s,i2s
    7878            ovlp=quench(latms1(is),latms2(is),n1st,mxh,l1st1,l1st2)
    7979          enddo
    80 c _______________________________ intitialize 2ND list with current 1ST list
     80! _______________________________ intitialize 2ND list with current 1ST list
    8181          do i=1,n1st
    8282            l2nd1(i)=l1st1(i)
    … …  
    8484          enddo
    8585          n2nd=n1st
    86 c _________________________________ exclude 'ib' of var. 'iv' from 2ND list
     86! _________________________________ exclude 'ib' of var. 'iv' from 2ND list
    8787          ib=iowat(iatvr(iv))
    8888          ovlp=quench(ib,ib,n2nd,mxh,l2nd1,l2nd2)
    … …  
    9494            ovlp=quench(iob,iob,n2nd,mxh,l2nd1,l2nd2) ! & in 2ND list
    9595
    96 c _____ atoms branching from 'iob': into GENERAL list of 1-4 partners
     96! _____ atoms branching from 'iob': into GENERAL list of 1-4 partners
    9797            do i=1,nbdat(iob)
    9898              ibd=ibdat(i,iob)
    9999              if (ibd.ne.ib.and.iowat(ibd).eq.iob.and.
    100      #            quench(ibd,ibd,n2nd,mxh,l2nd1,l2nd2) ) then
     100     &            quench(ibd,ibd,n2nd,mxh,l2nd1,l2nd2) ) then
    101101                n2i=n2i+1
    102102                if (n2i.gt.mx2) then
    103103                  write (*,'(a,i3,2a)')  ' mklist> Molecule # ',nml,
    104      #                ': too many atoms bound to ',nmat(iob)
     104     &                ': too many atoms bound to ',nmat(iob)
    105105                  stop
    106106                endif
    … …  
    108108              endif
    109109            enddo  ! ... branches of 'iob'
    110 c ____________________________ check for further '1-4' partners
    111 c                              connected to branches 'l2i'
     110! ____________________________ check for further '1-4' partners
     111!                              connected to branches 'l2i'
    112112            do i=1,n2i
    113113              ia=l2i(i)
    … …  
    116116                do j=latms1(im),latms2(im)
    117117                  if (ia.ne.j.and.
    118      #                quench(j,j,n2nd,mxh,l2nd1,l2nd2) ) then
     118     &                quench(j,j,n2nd,mxh,l2nd1,l2nd2) ) then
    119119                    n2i=n2i+1
    120120                    if (n2i.gt.mx2) then
    121121                      write (*,'(a,i3,a)')  ' mklist> Molecule # '
    122      #                         ,nml,': too many atoms in list L2I'
     122     &                         ,nml,': too many atoms in list L2I'
    123123                      stop
    124124                    endif
    … …  
    129129            enddo
    130130
    131 c ____ If 'iow(iob)' exists and in 2ND list: into GENERAL list of 1-4 partners
     131! ____ If 'iow(iob)' exists and in 2ND list: into GENERAL list of 1-4 partners
    132132            ioiob=iowat(iob)    !  existence of iow( iow(base) )
    133133            if (ioiob.gt.0) then
    … …  
    136136                if (n2i.gt.mx2) then
    137137                  write (*,'(a,i3,2a)')  ' mklist> Molecule # '
    138      #             ,nml,': too many atoms bound to ',nmat(iob)
     138     &             ,nml,': too many atoms bound to ',nmat(iob)
    139139                  stop
    140140                endif
    … …  
    150150          endif
    151151
    152 c ______ Atoms bound to 'ib' & in 2ND list(=are NOT in m.s of 'iv'):
    153 c                    exclude from 2ND list & put in list 'l1i'
     152! ______ Atoms bound to 'ib' & in 2ND list(=are NOT in m.s of 'iv'):
     153!                    exclude from 2ND list & put in list 'l1i'
    154154          n1i=0
    155155          do i=1,nbdat(ib)
    156156            ibd=ibdat(i,ib)
    157157            if (iowat(ibd).eq.ib.and.
    158      #        quench(ibd,ibd,n2nd,mxh,l2nd1,l2nd2) ) then
     158     &        quench(ibd,ibd,n2nd,mxh,l2nd1,l2nd2) ) then
    159159              n1i=n1i+1
    160160              if (n1i.gt.mxbd) then
    161161                write (*,'(a,i3,2a)')  ' mklist> Molecule # ',nml,
    162      #             ': too many atoms bound to ',nmat(ib)
     162     &             ': too many atoms bound to ',nmat(ib)
    163163                stop
    164164              endif
    165165              l1i(n1i)=ibd
    166 c _______ add atoms branching from 'l1i'-atoms to GENERAL list 1-4 partners
     166! _______ add atoms branching from 'l1i'-atoms to GENERAL list 1-4 partners
    167167              do j=1,nbdat(ibd)
    168168                jbd=ibdat(j,ibd)
    169169                if (iowat(jbd).eq.ibd.and.
    170      #              quench(jbd,jbd,n2nd,mxh,l2nd1,l2nd2) ) then
     170     &              quench(jbd,jbd,n2nd,mxh,l2nd1,l2nd2) ) then
    171171                  n2i=n2i+1
    172172                  if (n2i.gt.mx2) then
    173173                    write (*,'(a,i3,2a)')  ' mklist> Molecule # ',nml,
    174      #              ': too many atoms bound to branches of ',nmat(ib)
     174     &              ': too many atoms bound to branches of ',nmat(ib)
    175175                    stop
    176176                  endif
    … …  
    180180            endif
    181181          enddo
    182 c _____________________________ check for further '1-4' partners
    183 c                               belonging to moving set of base 'ib'
     182! _____________________________ check for further '1-4' partners
     183!                               belonging to moving set of base 'ib'
    184184          im=ixmsat(ib)
    185185          if (im.gt.0) then
    … …  
    189189                if (n2i.gt.mx2) then
    190190                  write (*,'(a,i3,a)')  ' mklist> Molecule # ',nml,
    191      #            ': too many atoms n list L2I '
     191     &            ': too many atoms n list L2I '
    192192                  stop
    193193                endif
    … …  
    199199          do is=i1s,i2s
    200200            do i=latms1(is),latms2(is)  ! ============= atoms in m.s of 'iv'
    201 c ________________________________________ Current 2ND list -> VdW-interact.
     201! ________________________________________ Current 2ND list -> VdW-interact.
    202202              if ((nvw+n2nd).gt.mxvw) then
    203203                write (*,'(a,i4,a,i5)') ' mklist> Molecule # ',nml,
    204      #            ': Number of vdw-domains > ',mxvw
     204     &            ': Number of vdw-domains > ',mxvw
    205205                stop
    206206              endif
    … …  
    213213                lvwat2(nvw)=l2nd2(j)
    214214              enddo  ! ... vdW-domains
    215 c _________________________________________ General list of 1-4 partners
     215! _________________________________________ General list of 1-4 partners
    216216              if ((n14+n2i).gt.mx14) goto 1
    217217              i14at1(i)=n14+1
    … …  
    221221                l14at(n14)=l2i(j)
    222222              enddo
    223 c __________________________________ Special cases of 1-4 interactions
    224 c                                    (list l1i, atoms iob,ib)
     223! __________________________________ Special cases of 1-4 interactions
     224!                                    (list l1i, atoms iob,ib)
    225225              iow=iowat(i)
    226226              if (iow.ne.ib) then
    … …  
    253253      nvwml(nml)=nvw-ivwml1(nml)+1
    254254      n14ml(nml)=n14-i14ml1(nml)+1
    255 c _________________________________ some cleaning up
     255! _________________________________ some cleaning up
    256256      do i=ifiat,ilaat
    257257        if (ivwat1(i).le.0) then
    … …  
    265265      enddo
    266266
    267 c ____________________________________________ Summary
    268 c      do i=ifiat,ilaat
    269 c        write (*,'(3a,i5,a)') ' ######## atom ',nmat(i),'(',i,')'
    270 c        iv1=ivwat1(i)
    271 c        iv2=ivwat2(i)
    272 c        if (iv1.le.iv2) then
    273 c          write(*,'(a)') ' ---> vdW :'
    274 c          do j=iv1,iv2
    275 c            write (*,'(i5,a,i5)') lvwat1(j),'-',lvwat2(j)
    276 c          enddo
    277 c        endif
    278 c        i41=i14at1(i)
    279 c        i42=i14at2(i)
    280 c        if (i41.le.i42) then
    281 c          write(*,'(a)') ' ---> 1-4 :'
    282 c          write(*,'(10i5)') (l14at(j),j=i41,i42)
    283 c        endif
    284 c      enddo
     267! ____________________________________________ Summary
     268!      do i=ifiat,ilaat
     269!        write (*,'(3a,i5,a)') ' ######## atom ',nmat(i),'(',i,')'
     270!        iv1=ivwat1(i)
     271!        iv2=ivwat2(i)
     272!        if (iv1.le.iv2) then
     273!          write(*,'(a)') ' ---> vdW :'
     274!          do j=iv1,iv2
     275!            write (*,'(i5,a,i5)') lvwat1(j),'-',lvwat2(j)
     276!          enddo
     277!        endif
     278!        i41=i14at1(i)
     279!        i42=i14at2(i)
     280!        if (i41.le.i42) then
     281!          write(*,'(a)') ' ---> 1-4 :'
     282!          write(*,'(10i5)') (l14at(j),j=i41,i42)
     283!        endif
     284!      enddo
    285285
    286286      return
    287287
    288288    1 write (*,'(a,i4,a,i5)') ' mklist> Molecule # ',nml,
    289      #                     ': Number of 1-4 interactions > ',mx14
     289     &                     ': Number of 1-4 interactions > ',mx14
    290290      stop
    291291      end
    292 c *********************************************
     292! *********************************************
    293293      logical function quench(i1,i2,n,mx,l1,l2)
    294294
    295 c ....................................................
    296 c PURPOSE:  Correct size/number (n) of index ranges
    297 c           given by lists 'l1' & 'l2' in order to
    298 c           EXCLUDE overlaps with range 'i1-i2'
    299 c
    300 c           quench = true, if any overlap was obtained
    301 c
    302 c CALLS: none
    303 c
    304 c ....................................................
     295! ....................................................
     296! PURPOSE:  Correct size/number (n) of index ranges
     297!           given by lists 'l1' & 'l2' in order to
     298!           EXCLUDE overlaps with range 'i1-i2'
     299!
     300!           quench = true, if any overlap was obtained
     301!
     302! CALLS: none
     303!
     304! ....................................................
    305305
    306306      implicit integer*4 (i-n)
Note: See TracChangeset for help on using the changeset viewer.