********>Bugfix 57: Author: Bob Duke Date: 12/08/2005 Programs: pmemd Description: This patch is the equivalent of sander bugfix 11. Fix: Apply the following patch to amber8/src/pmemd/src/nextprmtop_section.f90 ------------------------------------------------------------------------------ *** nextprmtop_section.f90 2005-12-08 13:55:48.000000000 -0500 --- nextprmtop_section.f90 2005-12-09 17:52:31.000000000 -0500 *************** *** 1,20 **** ! !******************************************************************************* ! ! ! Module: nextprmtop_section_module ! ! Description:! ! ! !******************************************************************************* ! module nextprmtop_section_module ! contains ! ! !******************************************************************************* ! ! ! Subroutine: nxtsec (NeXT SECtion) ! ! ! Description: ! ! This routine reads data from a new-format PARM file. It ! searches for the section with a %FLAG header of FLAG. It returns --- 1,16 ---- ! !*******************************************************************************! ! Module: nextprmtop_section_module ! ! Description: ! ! ! !******************************************************************************* module nextprmtop_section_module + contains ! !*******************************************************************************! ! Subroutine: nxtsec (NeXT SECtion) ! ! ! Description: ! ! This routine reads data from a new-format PARM file. It ! searches for the section with a %FLAG header of FLAG. It returns *************** *** 56,61 **** --- 52,60 ---- ! Author: David Pearlman ! Date: 09/00 ! + ! Scott Brozell June 2004 + ! Converted loop control to Fortran 90; these changes are g77 compatible. + ! ! The PARM file has the following format. ! ! %VERSION VERSION_STAMP = Vxxxx.yyy DATE = mm:dd:yy hh:mm:ss *************** *** 98,246 **** ! %FLAG cards and store the lines they appear on. That way, on ! subsequent calls we'll know immediately if we should read further ! down the file, rewind, or exit with an error (flag not found). ! ! !******************************************************************************* ! subroutine nxtsec(IUNIT,IOUT,IONERR,FMTOLD,FLAG,FMT,IOK) ! logical first ! save nxtlc1,nxtlc2,nxtlc3,first ! data first/.true./ ! mxnxfl is maximum number of %flag cards that can be specified ! parameter (mxnxfl = 500) ! character(*) fmtold,fmt,flag ! character(80) nxtflg ! character(8) prdat,prtim ! character(255) aa ! common /nxtlc1/inxtfl(2,mxnxfl),iprvrr,numflg,iblock ! common /nxtlc2/rpver ! common /nxtlc3/nxtflg(mxnxfl),prdat,prtim ! ! if (first) then ! ! rewind(iunit) ! ! ! First, see if this is a new format PARM file. That is, if the %VERSION ! ! line exists. If not, then we assume it's an old format PARM file. In ! ! this case, every call to NXTSEC will simply result in an immediate ! ! return. This means all reads from the calling routine will be done ! ! sequentially from the PARM file. Store the version number as a real ! ! in RPVER. Store the date and time strings as character strings in ! ! PRDAT and PRTIM. ! ! do 10 i = 1,9999999 ! read(iunit,11,end=20) aa ! 11 format(a) ! if (aa(1:8).ne.'%VERSION') go to 10 ! ! ipt = index(aa,'VERSION_STAMP') ! if (ipt.le.0) go to 10 ! ! ipt2 = nnbchr(aa,ipt+13,0,0) ! if (aa(ipt2:ipt2).ne.'=') go to 9000 ! ! ipt3 = nnbchr(aa,ipt2+1,0,0) ! if (aa(ipt3:ipt3).ne.'V') go to 9001 ! ! ipt4 = nnbchr(aa,ipt3+1,0,1) ! if (ipt4-1 - (ipt3+1) + 1 .ne.8) go to 9002 ! read(aa(ipt3+1:ipt4-1),'(f8.3)') rpver ! ! ipt5 = index(aa,'date') ! if (ipt5.le.0) then ! prdat = 'xx/xx/xx' ! prtim = 'xx:xx:xx' ! go to 50 ! end if ! ipt6 = nnbchr(aa,ipt5+4,0,0) ! if (aa(ipt6:ipt6).ne.'=') go to 9003 ! ipt7 = nnbchr(aa,ipt6+1,0,0) ! ipt8 = nnbchr(aa,ipt7+1,0,1) ! if (ipt8-1 - ipt7 + 1 .ne. 8) go to 9004 ! prdat = aa(ipt7:ipt8-1) ! ! ipt9 = nnbchr(aa,ipt8+1,0,0) ! ipt10 = nnbchr(aa,ipt9+1,0,1) ! if (ipt10-1 - ipt9 + 1 .ne. 8) go to 9005 ! prtim = aa(ipt9:ipt10-1) ! write(iout,15) rpver,prdat,prtim ! 15 format('| New style PARM file read.',/, & ! '| Version = ',f8.3,' Date = ',a,' Time = ',a,/) ! iprvrr = 0 ! go to 50 ! 10 continue ! Get here if no VERSION flag read. Set IPRVRR = 1 and return. ! On subsequent calls, if IPRVRR = 1, we return immediately. ! 20 iprvrr = 1 ! iok = -1 ! write(iout,'(a,/)') '| Old style PARM file read.' ! fmt = fmtold ! rewind(iunit) ! first = .false. ! return ! %VERSION line successfully read. Now load the flags into NXTFLG(I) ! and the line pointer and lengths of the flags into ! INXTFL(1,I) and INXTFL(2,I), respectively. NUMFLG will be the ! total number of flags read. ! 50 rewind(iunit) ! numflg = 0 ! do i = 1,999999 ! read(iunit,11,end=99) aa ! if (aa(1:5).eq.'%FLAG') then ! numflg = numflg + 1 ! ipt2 = nnbchr(aa,6,0,0) ! if (ipt2.eq.-1) go to 9006 ! ipt3 = nnbchr(aa,ipt2,0,1)-1 ! ! inxtfl(1,numflg) = i ! inxtfl(2,numflg) = ipt3-ipt2+1 ! nxtflg(numflg) = aa(ipt2:ipt3) ! end if ! end do ! 99 rewind(iunit) ! iblock = 0 ! first = .false. end if ! Start search for passed flag name ! ! If this is an old-style PARM file, we can't do the search. Simply ! set IOK = -1, FMT to FMTOLD, and return ! if (iprvrr.eq.1) then ! iok = -1 ! fmt = fmtold ! return end if ! ! lflag = nnbchr(flag,1,0,1)-1 ! if (lflag.eq.-2) lflag = len(flag) ! do i = 1,numflg ! if (lflag.eq.inxtfl(2,i)) then ! if (flag(1:lflag).eq.nxtflg(i)(1:lflag)) then ! il2us = inxtfl(1,i) ! go to 120 ! end if ! end if ! end do ! Get here if flag does not correspond to any stored. Either stop ! or return depending on IONERR flag. ! if (ionerr.eq.0) then ! go to 9007 ! else if (ionerr.eq.1) then ! iok = -2 ! return ! end if ! Flag found. Set file pointer to the first line following the appropriate ! %FLAG line and then search for %FORMAT field. --- 97,268 ---- ! %FLAG cards and store the lines they appear on. That way, on ! subsequent calls we'll know immediately if we should read further ! down the file, rewind, or exit with an error (flag not found). ! ! !******************************************************************************* ! subroutine nxtsec(iunit, iout, ionerr, fmtold, flag, fmt, iok) ! ! implicit none ! ! ! Formal arguments: ! integer :: iunit ! integer :: iout ! integer :: ionerr ! character*(*) :: fmtold,fmt,flag ! integer :: iok ! ! ! Local variables: ! mxnxfl is maximum number of %flag cards that can be specified ! integer, parameter :: mxnxfl = 500 ! integer :: i ! integer :: ipt, ipt2, ipt3, ipt4, ipt5, ipt6, ipt7, ipt8, & ! ipt9, ipt10 ! integer :: lflag ! integer :: il2us ! integer :: ifind ! integer :: mblock ! integer :: ilfo ! ! character*255 :: aa ! character*80, save :: nxtflg(mxnxfl) ! character*8, save :: prdat, prtim ! ! integer, save :: inxtfl(2, mxnxfl), iprvrr, numflg, iblock ! logical, save :: first = .true. ! real, save :: rpver ! ! iok = 0 ! ! if (first) then ! ! rewind(iunit) ! ! ! First, see if this is a new format PARM file. That is, if the %VERSION ! ! line exists. If not, then we assume it's an old format PARM file. In ! ! this case, every call to NXTSEC will simply result in an immediate ! ! return. This means all reads from the calling routine will be done ! ! sequentially from the PARM file. Store the version number as a real ! ! in RPVER. Store the date and time strings as character strings in ! ! PRDAT and PRTIM. ! ! do ! ! read(iunit,11,end=20) aa ! 11 format(a) ! if (aa(1:8).ne.'%VERSION') cycle ! ! ipt = index(aa,'VERSION_STAMP') ! if (ipt.le.0) cycle ! ! ipt2 = nnbchr(aa,ipt+13,0,0) ! if (aa(ipt2:ipt2).ne.'=') go to 9000 ! ! ipt3 = nnbchr(aa,ipt2+1,0,0) ! if (aa(ipt3:ipt3).ne.'V') go to 9001 ! ! ipt4 = nnbchr(aa,ipt3+1,0,1) ! if (ipt4-1 - (ipt3+1) + 1 .ne. 8) go to 9002 ! read(aa(ipt3+1:ipt4-1),'(f8.3)') rpver ! ! ipt5 = index(aa,'DATE') ! if (ipt5.le.0) then ! prdat = 'xx/xx/xx' ! prtim = 'xx:xx:xx' ! go to 50 ! end if ! ipt6 = nnbchr(aa,ipt5+4,0,0) ! if (aa(ipt6:ipt6).ne.'=') go to 9003 ! ipt7 = nnbchr(aa,ipt6+1,0,0) ! ipt8 = nnbchr(aa,ipt7+1,0,1) ! if (ipt8-1 - ipt7 + 1 .ne. 8) go to 9004 ! prdat = aa(ipt7:ipt8-1) ! ! ipt9 = nnbchr(aa,ipt8+1,0,0) ! ipt10 = nnbchr(aa,ipt9+1,0,1) ! if (ipt10-1 - ipt9 + 1 .ne. 8) go to 9005 ! prtim = aa(ipt9:ipt10-1) ! write(iout,15) rpver,prdat,prtim ! 15 format('| New format PARM file being parsed.',/, & ! '| Version = ',F8.3,' Date = ',A,' Time = ',A) ! iprvrr = 0 ! go to 50 ! end do ! Get here if no VERSION flag read. Set IPRVRR = 1 and return. ! On subsequent calls, if IPRVRR = 1, we return immediately. ! 20 iprvrr = 1 ! iok = -1 ! write(iout,21) ! 21 format('| INFO: Old style PARM file read',/) ! fmt = fmtold ! rewind(iunit) ! first = .false. ! return ! %VERSION line successfully read. Now load the flags into NXTFLG(I) ! and the line pointer and lengths of the flags into ! INXTFL(1,I) and INXTFL(2,I), respectively. NUMFLG will be the ! total number of flags read. ! 50 rewind(iunit) ! numflg = 0 ! i = 1 ! do ! read(iunit,11,end=99) aa ! if (aa(1:5).eq.'%FLAG') then ! numflg = numflg + 1 ! ipt2 = nnbchr(aa,6,0,0) ! if (ipt2.eq.-1) go to 9006 ! ipt3 = nnbchr(aa,ipt2,0,1)-1 ! ! inxtfl(1,numflg) = i ! inxtfl(2,numflg) = ipt3-ipt2+1 ! nxtflg(numflg) = aa(ipt2:ipt3) end if + i = i + 1 + end do + 99 rewind(iunit) + iblock = 0 + first = .false. + end if ! Start search for passed flag name ! ! ! If this is an old-style PARM file, we can't do the search. Simply ! set IOK = -1, FMT to FMTOLD, and return ! if (iprvrr .eq. 1) then ! iok = -1 ! fmt = fmtold ! return ! end if ! ! lflag = nnbchr(flag,1,0,1)-1 ! if (lflag.eq.-2) lflag = len(flag) ! do i = 1,numflg ! if (lflag.eq.inxtfl(2,i)) then ! if (flag(1:lflag).eq.nxtflg(i)(1:lflag)) then ! il2us = inxtfl(1,i) ! go to 120 end if ! end if ! end do ! Get here if flag does not correspond to any stored. Either stop ! or return depending on IONERR flag. ! if (ionerr.eq.0) then ! go to 9007 ! else if (ionerr.eq.1) then ! iok = -2 ! return ! end if ! Flag found. Set file pointer to the first line following the appropriate ! %FLAG line and then search for %FORMAT field. *************** *** 250,352 **** ! If this followed the current request, rewind and read forward the ! necessary number of lines. This should speed things up a bit. ! 120 ifind = i ! mblock = iblock ! if (ifind.gt.iblock) then ! do i = 1,999999 ! read(iunit,11,end=9008) aa ! if (aa(1:5).eq.'%FLAG') then ! mblock = mblock + 1 ! if (mblock.eq.ifind) go to 145 ! end if ! end do ! else ! rewind(iunit) ! do i = 1,il2us ! read(iunit,11,end=9008) ! end do end if ! ! 145 do i = 1,9999999 ! read(iunit,11,end=9009) aa ! if (aa(1:7).eq.'%FORMAT') go to 160 ! end do ! First %FORMAT found following appropriate %FLAG. Extract the ! format and return. All non-blank characters following %FORMAT ! comprise the format string (embedded blanks allowed). ! 160 ipt2 = nnbchr(aa,8,0,0) ! if (ipt2.eq.-1) go to 9010 ! do i = len(aa),ipt2,-1 ! if (aa(i:i).ne.' ') go to 170 ! end do ! 170 ipt3 = i ! Format string is in IPT2:IPT3. Make sure passed FMT string is large ! enought to hold this and then return. ! ilfo = ipt3-ipt2+1 ! if (ilfo.gt.len(fmt)) go to 9011 ! fmt = ' ' ! fmt(1:ilfo) = aa(ipt2:ipt3) ! Update IBLOCK pointer and return ! iblock = ifind ! return ! Errors: ! 9000 write(iout,9500) ! 9500 format('ERROR: No = sign after VERSION_STAMP field in PARM') ! stop ! 9001 write(iout,9501) ! 9501 format('ERROR: Version number in PARM does not start with V') ! stop ! 9002 write(iout,9502) ! 9502 format('ERROR: Mal-formed version number in PARM. ', & 'Should be 8 chars') ! stop ! 9003 write(iout,9503) ! 9503 format('ERROR: No = sign after DATE field in PARM') ! stop ! 9004 write(iout,9504) ! 9504 format('ERROR: Mal-formed date string in PARM. ', & 'Should be 8 characters & no embedded spaces.') ! stop ! 9005 write(iout,9505) ! 9505 format('ERROR: Mal-formed time string in PARM. ', & 'Should be 8 characters & no embedded spaces.') ! stop ! 9006 write(iout,9506) ! 9506 format('ERROR: No flag found following a %FLAG line in PARM') ! stop ! 9007 write(iout,9507) flag(1:lflag) ! 9507 format('ERROR: Flag "',a,'" not found in PARM file') ! stop ! 9008 write(iout,9508) flag(1:lflag) ! 9508 format('ERROR: Programming error in routine NXTSEC') ! stop ! 9009 write(iout,9509) flag(1:lflag) ! 9509 format('ERROR: No %FORMAT field found following flag "',a,'"') ! stop ! 9010 write(iout,9510) flag(1:lflag) ! 9510 format('ERROR: No format string found following a %FORMAT ', & ! 'line in PARM',/, 'Corresponding %FLAG is "',a,'"') ! stop ! 9011 write(iout,9511) flag(1:lflag) ! 9511 format('ERROR: Format string for flag "',a,'" too large',/, & ' for FMT call-list parameter') ! stop end subroutine nxtsec ! !******************************************************************************* ! ! ! Function: nnbchr ! ! ! Description: ! ! IOPER = 0: Find next non-blank character ! IOPER = 1: Find next blank character --- 272,387 ---- ! If this followed the current request, rewind and read forward the ! necessary number of lines. This should speed things up a bit. ! 120 & ! ifind = i ! mblock = iblock ! if (ifind .gt. iblock) then ! do ! read(iunit,11,end=9008) aa ! if (aa(1:5) .eq. '%FLAG') then ! mblock = mblock + 1 ! if (mblock .eq. ifind) exit end if ! end do ! else ! rewind(iunit) ! do i = 1,il2us ! read(iunit,11,end=9008) ! end do ! end if ! ! do ! read(iunit,11,end=9009) aa ! if (aa(1:7).eq.'%FORMAT') exit ! end do ! First %FORMAT found following appropriate %FLAG. Extract the ! format and return. All non-blank characters following %FORMAT ! comprise the format string (embedded blanks allowed). ! ipt2 = nnbchr(aa,8,0,0) ! if (ipt2.eq.-1) go to 9010 ! do i = len(aa),ipt2,-1 ! if (aa(i:i).ne.' ') exit ! end do ! ipt3 = i ! Format string is in IPT2:IPT3. Make sure passed FMT string is large ! enought to hold this and then return. ! ilfo = ipt3-ipt2+1 ! if (ilfo.gt.len(fmt)) go to 9011 ! fmt = ' ' ! fmt(1:ilfo) = aa(ipt2:ipt3) ! Update IBLOCK pointer and return ! iblock = ifind ! return ! Errors: ! 9000 write(iout,9500) ! 9500 format('ERROR: No = sign after VERSION_STAMP field in PARM') ! stop ! ! 9001 write(iout,9501) ! 9501 format('ERROR: Version number in PARM does not start with V') ! stop ! ! 9002 write(iout,9502) ! 9502 format('ERROR: Mal-formed version number in PARM. ', & 'Should be 8 chars') ! stop ! ! 9003 write(iout,9503) ! 9503 format('ERROR: No = sign after DATE field in PARM') ! stop ! ! 9004 write(iout,9504) ! 9504 format('ERROR: Mal-formed date string in PARM. ', & 'Should be 8 characters & no embedded spaces.') ! stop ! ! 9005 write(iout,9505) ! 9505 format('ERROR: Mal-formed time string in PARM. ', & 'Should be 8 characters & no embedded spaces.') ! stop ! ! 9006 write(iout,9506) ! 9506 format('ERROR: No flag found following a %FLAG line in PARM') ! stop ! ! 9007 write(iout,9507) flag(1:lflag) ! 9507 format('ERROR: Flag "',A,'" not found in PARM file') ! stop ! ! 9008 write(iout,9508) flag(1:lflag) ! 9508 format('ERROR: Programming error in routine NXTSEC') ! stop ! ! 9009 write(iout,9509) flag(1:lflag) ! 9509 format('ERROR: No %FORMAT field found following flag "',a,'"') ! stop ! ! 9010 write(iout,9510) flag(1:lflag) ! 9510 format('ERROR: No format string found following a %FORMAT ', & ! 'line in PARM',/, & ! 'Corresponding %FLAG is "',a,'"') ! stop ! ! 9011 write(iout,9511) flag(1:lflag) ! 9511 format('ERROR: Format string for flag "',a,'" too large',/, & ' for FMT call-list parameter') ! stop end subroutine nxtsec ! ! !*******************************************************************************! ! Function: nnbchr ! ! ! Description: ! ! IOPER = 0: Find next non-blank character ! IOPER = 1: Find next blank character *************** *** 356,388 **** ! character found (IOPER = 1). !******************************************************************************* ! function nnbchr(aa,ibeg,iend,ioper) ! character(*) aa ! ibg = ibeg ! ien = iend ! if (ibeg.le.0) ibg = 1 ! if (iend.le.0) ien = len(aa) ! ! if (ioper.eq.0) then ! do 10 i = ibg,ien ! if (aa(i:i).ne.' ') then ! nnbchr = i ! return ! end if ! 10 continue ! nnbchr = -1 ! else if (ioper.eq.1) then ! do 20 i = ibg,ien ! if (aa(i:i).eq.' ') then ! nnbchr = i ! return ! end if ! 20 continue ! nnbchr = -1 end if ! return end function nnbchr --- 391,438 ---- ! character found (IOPER = 1). !******************************************************************************* ! function nnbchr(aa, ibeg, iend, ioper) ! implicit none ! ! ! Formal arguments: ! ! character*(*) :: aa ! integer :: ibeg ! integer :: iend ! integer :: ioper ! ! ! Local variables: ! ! integer :: nnbchr ! integer :: i ! integer :: ibg ! integer :: ien ! ! ibg = ibeg ! ien = iend ! if (ibeg .le. 0) ibg = 1 ! if (iend .le. 0) ien = len(aa) ! ! if (ioper .eq. 0) then ! do i = ibg,ien ! if (aa(i:i).ne.' ') then ! nnbchr = i ! return ! end if ! end do ! nnbchr = -1 ! else if (ioper .eq. 1) then ! do i = ibg,ien ! if (aa(i:i) .eq. ' ') then ! nnbchr = i ! return end if + end do + nnbchr = -1 + end if ! return end function nnbchr ------------------------------------------------------------------------------- Temporary workarounds: none