********>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