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

  • redvar.f

    r2ebb8b6 rbd2278d  
    1 c**************************************************************
    2 c
    3 c This file contains the subroutines: redvar
    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: redvar
     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
    1313      subroutine redvar
    1414
    15 c ...................................................................
    16 c
    17 c PURPOSE: Read global parameters for molecules from lines
    18 c
    19 c          +--------------------------------------------------+
    20 c          |@ molecule no. : six floats separated by commas   |
    21 c          +--------------------------------------------------+
    22 c
    23 c          NB: 1) if omit field with molecule no. assume: nml=1
    24 c              2) last 3 float are angles in deg.
    25 c
    26 c          Read and interpret file to SET and FIX internal variables
    27 c          by commands:
    28 c
    29 c          +-----------------------------------------+
    30 c          |  molecule : residue : variable : value  |
    31 c          +-----------------------------------------+
    32 c
    33 c        * Lines containing '&' assign FIXED variable(s), they will
    34 c          not be varied during subsequent minimization etc.
    35 c
    36 c        * Empty LINES or lines containing '#' are ignored
    37 c        * Several commands on same line must be separated by ';'
    38 c        * Empty COMMANDS, i.e. ' : : ' are ignored
    39 c        * All spaces are not significant and are therefore ignored
    40 c
    41 c        * A command consists of up to 4 (maxfld) fields, separated
    42 c          by ':'
    43 c
    44 c        - last field     : value for VARIABLE (REAL)
    45 c                           ! should never be empty
    46 c        - 1st before last: name(s) (CHAR) or index(ices) of VARIABLE(S)
    47 c        - 2nd before last: name(s) or index(ices) of RESIDUE(S)
    48 c        - 3rd before last: name or number(ices) of MOLECULE(S)
    49 c
    50 c        * molecules, residues, variables can be identified, either by,
    51 c          INDICES (zones 'n1-n2' possible) or NAMES
    52 c
    53 c        * several identifiers in a field can be separated by ','
    54 c
    55 c        * INDICES: for residues  - refer to numbering within molecule
    56 c                 : for variables - refer to numbering within residue
    57 c        * ZONES:   '-n2' indicates '1-n2'
    58 c                   'n1-' indicates 'n1-(all)'
    59 c        * NAMES or their ends can be indicated by wild-card '*'
    60 c                are case-sensitive
    61 c
    62 c        Example:  phi:-65; psi:-45  >set all phi=-65, all psi=-45
    63 c                  om*: 180 &  >set all omg, omt ... to 180 & fix them
    64 c                  5 : x* : -60  >set all xi-angles of residue 5 to 60
    65 c
    66 c CALLS: setvar,extstr,iendst,ibegst,iopfil,iredin,iredrl
    67 c ......................................................................
     15! ...................................................................
     16!
     17! PURPOSE: Read global parameters for molecules from lines
     18!
     19!          +--------------------------------------------------+
     20!          |@ molecule no. : six floats separated by commas   |
     21!          +--------------------------------------------------+
     22!
     23!          NB: 1) if omit field with molecule no. assume: nml=1
     24!              2) last 3 float are angles in deg.
     25!
     26!          Read and interpret file to SET and FIX internal variables
     27!          by commands:
     28!
     29!          +-----------------------------------------+
     30!          |  molecule : residue : variable : value  |
     31!          +-----------------------------------------+
     32!
     33!        * Lines containing '&' assign FIXED variable(s), they will
     34!          not be varied during subsequent minimization etc.
     35!
     36!        * Empty LINES or lines containing '#' are ignored
     37!        * Several commands on same line must be separated by ';'
     38!        * Empty COMMANDS, i.e. ' : : ' are ignored
     39!        * All spaces are not significant and are therefore ignored
     40!
     41!        * A command consists of up to 4 (maxfld) fields, separated
     42!          by ':'
     43!
     44!        - last field     : value for VARIABLE (REAL)
     45!                           ! should never be empty
     46!        - 1st before last: name(s) (CHAR) or index(ices) of VARIABLE(S)
     47!        - 2nd before last: name(s) or index(ices) of RESIDUE(S)
     48!        - 3rd before last: name or number(ices) of MOLECULE(S)
     49!
     50!        * molecules, residues, variables can be identified, either by,
     51!          INDICES (zones 'n1-n2' possible) or NAMES
     52!
     53!        * several identifiers in a field can be separated by ','
     54!
     55!        * INDICES: for residues  - refer to numbering within molecule
     56!                 : for variables - refer to numbering within residue
     57!        * ZONES:   '-n2' indicates '1-n2'
     58!                   'n1-' indicates 'n1-(all)'
     59!        * NAMES or their ends can be indicated by wild-card '*'
     60!                are case-sensitive
     61!
     62!        Example:  phi:-65; psi:-45  >set all phi=-65, all psi=-45
     63!                  om*: 180 &  >set all omg, omt ... to 180 & fix them
     64!                  5 : x* : -60  >set all xi-angles of residue 5 to 60
     65!
     66! CALLS: setvar,extstr,iendst,ibegst,iopfil,iredin,iredrl
     67! ......................................................................
    6868
    6969
    7070      include 'INCL.H'
    7171
    72 c maxfld: max. # of fields in one command
    73 c maxide: max. # of identifiers in a field
    74 c maxcmd: max. # of commands to be interpreted
    75 c ilrg:   a large integer
     72! maxfld: max. # of fields in one command
     73! maxide: max. # of identifiers in a field
     74! maxcmd: max. # of commands to be interpreted
     75! ilrg:   a large integer
    7676
    7777      parameter (maxfld=4,
    78      #           maxide=30,
    79      #           maxcmd=5000,
    80      #           ilrg=1000000)
     78     &           maxide=30,
     79     &           maxcmd=5000,
     80     &           ilrg=1000000)
    8181
    8282      character spcm,spfd,spcc,sphy,cmt,wdc,sfix,blnk, sglp,
    83      #          line*132,lincmd*132,linfld(maxfld)*132,linide*132,
    84      #          linh*132,strg(6)*17
     83     &          line*132,lincmd*132,linfld(maxfld)*132,linide*132,
     84     &          linh*132,strg(6)*17
    8585      dimension ifdend(maxfld),vlvrx(mxvr),rn(6)
    8686      logical fix,did,exa,forml(mxml),forrs(mxrs),forvr(mxvr),
    87      #        stvr(mxvr)
     87     &        stvr(mxvr)
    8888      data spcm/';'/,spfd/':'/,spcc/','/,sphy/'-'/,cmt/'#'/,wdc/'*'/,
    89      #     sfix/'&'/,blnk/' '/, sglp/'@'/
    90 
    91 
    92 c ___________________________________ Checks
     89     &     sfix/'&'/,blnk/' '/, sglp/'@'/
     90
     91
     92! ___________________________________ Checks
    9393      ntlvr=ivrml1(ntlml)+nvrml(ntlml)-1
    9494      if (ntlvr.eq.0) then
    … …  
    9696        return
    9797      endif
    98 c ___________________________________ Initialize
     98! ___________________________________ Initialize
    9999
    100100      io=iopfil(lunvar,varfil,'old','formatted')
    101101      if (io.eq.0) then
    102102        write (*,'(a,/,a,i3,2a)')
    103      #    ' redvar> ERROR opening file to set variables:',
    104      #    ' LUN=',lunvar,' FILE=',varfil(1:iendst(varfil))
     103     &    ' redvar> ERROR opening file to set variables:',
     104     &    ' LUN=',lunvar,' FILE=',varfil(1:iendst(varfil))
    105105        stop
    106106      elseif (io.eq.-1) then
    107107        return
    108108      endif
    109 c ___________________________________ Initialization
     109! ___________________________________ Initialization
    110110      do i=1,ntlml
    111111        forml(i)=.true.
    … …  
    138138    1 read (lunvar,'(a)',end=2) line
    139139      ile=iendst(line)
    140 c _________________________________ ! ignore empty and commentary lines
     140! _________________________________ ! ignore empty and commentary lines
    141141      if (ile.gt.0.and.index(line(1:ile),cmt).le.0) then
    142142
    143 c _________________________________________ Global variables
     143! _________________________________________ Global variables
    144144        ilb = index(line(1:ile),sglp)+1
    145145        if (ilb.ge.2) then
    … …  
    150150
    151151            if (iredin(lincmd,nml).le.0.or.
    152      #          nml.le.0.or.nml.gt.ntlml) then
     152     &          nml.le.0.or.nml.gt.ntlml) then
    153153              write (*,*) 'redvar> ','Incorrect molecule number >',
    154      #                    lincmd(1:l),'<  Must be in range [1,',
    155      #                    ntlml,'] !'
     154     &                    lincmd(1:l),'<  Must be in range [1,',
     155     &                    ntlml,'] !'
    156156              close(lunvar)
    157157              stop
    … …  
    179179          if (iredrl(linh,rn(6)).le.0) goto 105
    180180
    181 c ---------------------------------------- check global angles
     181! ---------------------------------------- check global angles
    182182          if (  abs(rn(4)).gt.(1.8d2+1d-6)
    183      #     .or. abs(rn(5)).gt.(9d1+1d-6)
    184      #     .or. abs(rn(6)).gt.(1.8d2+1d-6)
    185      #    ) goto 106
     183     &     .or. abs(rn(5)).gt.(9d1+1d-6)
     184     &     .or. abs(rn(6)).gt.(1.8d2+1d-6)
     185     &    ) goto 106
    186186           
    187187          do i = 1,3
    … …  
    221221            endif
    222222
    223 c _________________________________________ Extract Command Fields
     223! _________________________________________ Extract Command Fields
    224224            nfld=0
    225225            icb=1
    … …  
    235235
    236236            enddo
    237 c _______________________________ Interpret Command Fields (except last)
     237! _______________________________ Interpret Command Fields (except last)
    238238            do i=1,nfld-1
    239239              ii=i
    … …  
    255255                enddo
    256256              endif
    257 c __________________________________ Identifiers in field
     257! __________________________________ Identifiers in field
    258258              nide=0
    259259              ifb=1
    … …  
    299299                      if (ifld.eq.3) then        !  Mol.
    300300
    301 c ################### impossible # (inum) of molecule
     301! ################### impossible # (inum) of molecule
    302302
    303303                        if (inum.le.0.or.inum.gt.ntlml) then
    … …  
    313313                            k=inum+nfi-1
    314314
    315 c ################### impossible # of residue (inum) in molecule
     315! ################### impossible # of residue (inum) in molecule
    316316
    317317                            if (k.lt.nfi.or.k.gt.irsml2(j)) then
    … …  
    331331                                l=inum+nfi-1
    332332
    333 c ################### impossible # of variable (inum) in residue
     333! ################### impossible # of variable (inum) in residue
    334334
    335335                                if (l.lt.nfi.or.
    336      #                              l.gt.nfi+nvrrs(k)-1) then
     336     &                              l.gt.nfi+nvrrs(k)-1) then
    337337                                  write (*,*) ' # 3: ',inum
    338338                                  goto 104
    … …  
    364364                            linh(1:ieh1)=nmml(j)(ib:ieh)
    365365                            if (((exa.and.ieh1.eq.id).or.
    366      #                         (.not.exa.and.ieh1.ge.id)).and.
    367      #                         linh(1:id).eq.linide(1:id))
    368      #                         forml(j)=.true.
     366     &                         (.not.exa.and.ieh1.ge.id)).and.
     367     &                         linh(1:id).eq.linide(1:id))
     368     &                         forml(j)=.true.
    369369                          endif
    370370                        enddo       
    … …  
    380380                                linh(1:ieh1)=seq(k)(ib:ieh)
    381381                                if (((exa.and.ieh1.eq.id).or.
    382      #                             (.not.exa.and.ieh1.ge.id))
    383      #                          .and.linh(1:id).eq.linide(1:id))
    384      #                            forrs(k)=.true.
     382     &                             (.not.exa.and.ieh1.ge.id))
     383     &                          .and.linh(1:id).eq.linide(1:id))
     384     &                            forrs(k)=.true.
    385385                              endif
    386386                            enddo
    … …  
    401401                                    linh(1:ieh1)=nmvr(l)(ib:ieh)
    402402                                    if (((exa.and.ieh1.eq.id)
    403      #                         .or.(.not.exa.and.ieh1.ge.id))
    404      #                          .and.linh(1:id).eq.linide(1:id))
    405      #                              forvr(l)=.true.
     403     &                         .or.(.not.exa.and.ieh1.ge.id))
     404     &                          .and.linh(1:id).eq.linide(1:id))
     405     &                              forvr(l)=.true.
    406406                                  endif
    407407                                enddo
    … …  
    416416                  else                                       ! ___ Zone
    417417
    418 c ################### impossible zone '-' (without integer)
     418! ################### impossible zone '-' (without integer)
    419419
    420420                    if (ide.eq.1.and.ihy.eq.ide) then
    … …  
    429429                      linh=linide(1:ihy-1)
    430430
    431 c ################### impossible (to read) integer before '-'
     431! ################### impossible (to read) integer before '-'
    432432
    433433                      if (iredin(linh,ibz).le.0.or.ibz.le.0)
    434      #                  then
     434     &                  then
    435435                        write (*,*) ' # 5 '
    436436                        goto 104
    … …  
    444444                      linh=linide(ihy+1:ide)
    445445
    446 c ################### impossible (to read) integer after '-'
     446! ################### impossible (to read) integer after '-'
    447447
    448448                      if (iredin(linh,iez).le.0.or.iez.le.0.or.
    449      #                  iez.lt.ibz) then
     449     &                  iez.lt.ibz) then
    450450                        write (*,*) ' # 6 '
    451451                        goto 104
    … …  
    502502            enddo  ! ... Fields (excl. value)
    503503
    504 c _____________________________________________________ Execute Command
     504! _____________________________________________________ Execute Command
    505505
    506506            if (iredrl(linfld(nfld),val).gt.izero) then  ! Read Value
    … …  
    517517              enddo
    518518              if (.not.did) write (*,'(3a)')
    519      #          ' redvar> No variables affected by command >',
    520      #          lincmd(1:ice),'<'
     519     &          ' redvar> No variables affected by command >',
     520     &          lincmd(1:ice),'<'
    521521            else
    522522
    … …  
    524524              ll2=iendst(linfld(nfld))
    525525              write (*,*) 'll1,ll2, linfld(nfld): ',ll1,ll2,
    526      #           '>',linfld(nfld)(ll1:ll2),'<'
     526     &           '>',linfld(nfld)(ll1:ll2),'<'
    527527
    528528              goto 102
    … …  
    535535
    536536    2 close(lunvar)
    537 c __________________________ Summary
     537! __________________________ Summary
    538538      iv=0
    539539      do i=1,ntlml
    … …  
    552552
    553553             write (*,'(3a,/,1x,5(a,2x),a)') ' redvar> ',nmml(i)(1:ie),
    554      #                                    ' with global parameters:',
    555      #                              (strg(k)(ibegst(strg(k)):),k=1,6)
     554     &                                    ' with global parameters:',
     555     &                              (strg(k)(ibegst(strg(k)):),k=1,6)
    556556             call setvar(i,vlvrx)
    557557             goto 3
    … …  
    572572                if (fxvr(iv)) then
    573573                  write (*,'(3a,i4,1x,4a,f10.3,a)') ' redvar> ',
    574      #                nmml(i)(1:ie),': residue ',j-jb,seq(j),
    575      #                ': ',nmvr(iv),' set ',vlvrx(iv),'   Fixed'
     574     &                nmml(i)(1:ie),': residue ',j-jb,seq(j),
     575     &                ': ',nmvr(iv),' set ',vlvrx(iv),'   Fixed'
    576576                else
    577577                  write (*,'(3a,i4,1x,4a,f10.3)') ' redvar> ',
    578      #                nmml(i)(1:ie),': residue ',j-jb,seq(j),
    579      #                ': ',nmvr(iv),' set ',vlvrx(iv)
     578     &                nmml(i)(1:ie),': residue ',j-jb,seq(j),
     579     &                ': ',nmvr(iv),' set ',vlvrx(iv)
    580580                endif
    581581                ity=ityvr(iv)
    582582                if (ity.eq.3.or.ity.eq.2)
    583      #            vlvrx(iv)=vlvrx(iv)*cdr             ! angles
     583     &            vlvrx(iv)=vlvrx(iv)*cdr             ! angles
    584584                 
    585585              else
    … …  
    590590          if (did) then
    591591            if (in.gt.0) write (*,'(3a,i5,a)')
    592      #        ' redvar> Molecule ',nmml(i)(1:ie),': ',in,
    593      #        ' variable(s) remain unchanged'
     592     &        ' redvar> Molecule ',nmml(i)(1:ie),': ',in,
     593     &        ' variable(s) remain unchanged'
    594594            call setvar(iml,vlvrx)
    595595          else
    596596            write (*,'(3a)') ' redvar> Molecule ',
    597      #        nmml(i)(1:ie),': No internal variables changed'
     597     &        nmml(i)(1:ie),': No internal variables changed'
    598598          endif
    599599        endif
    … …  
    601601
    602602      return
    603 c ____________________________________________________________ Errors
     603! ____________________________________________________________ Errors
    604604  100 write (*,'(3a)') ' redvar> Cannot interpret command >',
    605      #                 lincmd(1:ice),'<'
     605     &                 lincmd(1:ice),'<'
    606606      close(lunvar)
    607607      stop
    … …  
    610610      stop
    611611  102 write (*,'(3a)') ' redvar> Cannot read value from >',
    612      #                   lincmd(1:ice),'<'
     612     &                   lincmd(1:ice),'<'
    613613      close(lunvar)
    614614      stop
    615615  103 write (*,'(a,i3,3a)') ' redvar> Cannot read >',maxide,
    616      #         ' identifiers from >',linfld(ii)(1:ife),'<'
     616     &         ' identifiers from >',linfld(ii)(1:ife),'<'
    617617      close(lunvar)
    618618      stop
    619619  104 write (*,'(5a)') ' redvar> Error in identifier >',
    620      #            linide(1:ide),'< of command >',lincmd(1:ice),'<'
     620     &            linide(1:ide),'< of command >',lincmd(1:ice),'<'
    621621      close(lunvar)
    622622      stop
    623623  105 write (*,'(a,/,a,/,2a,/)') ' redvar> line with global paramters:',
    624      #                           line(1:ile),' must contain 6 floating',
    625      #                           ' point numbers separated by commas !'
     624     &                           line(1:ile),' must contain 6 floating',
     625     &                           ' point numbers separated by commas !'
    626626      close(lunvar)
    627627      stop
    628628
    629629  106 write (*,'(a,/,a,/,2a,/)') ' redvar> line with global paramters:',
    630      #                           line(1:ile),' angles must be inside ',
    631      #'ranges [-180,180], [-90,90], and [-180,180] Deg., respectively !'
     630     &                           line(1:ile),' angles must be inside ',
     631     &'ranges [-180,180], [-90,90], and [-180,180] Deg., respectively !'
    632632      close(lunvar)
    633633      stop
Note: See TracChangeset for help on using the changeset viewer.