********>Bugfix 11:
Author: Scott Brozell (reported by Joanna Trylska)
Date: 06/08/2004
Programs: addles, anal, ambpdb, new2oldparm, nmode, pbsa, sander
Description: new format prmtop files, which were introduced in Amber 7,
with more than 999999 lines are not correctly
read because of inconsistent loop limits.
The failures are of the form:
ERROR: Flag "xxxx" not found in PARM file
Fix: Apply the following patch to $AMBERHOME/src/lib/nxtsec.f
------------------------------------------------------------------------------
*** nxtsec.f 13 Mar 2004 00:27:01 -0000 7.12
--- nxtsec.f 9 Jun 2004 05:36:33 -0000
***************
*** 42,47 ****
--- 42,50 ----
c Author: David Pearlman
c Date: 09/00
c
+ c Scott Brozell June 2004
+ c Converted loop control to Fortran 90; these changes are g77 compatible.
+ c
c The PARM file has the following format.
c
c %VERSION VERSION_STAMP = Vxxxx.yyy DATE = mm:dd:yy hh:mm:ss
***************
*** 84,107 ****
c %FLAG cards and store the lines they appear on. That way, on
c subsequent calls we'll know immediately if we should read further
c down the file, rewind, or exit with an error (flag not found).
! c
! LOGICAL FIRST
! SAVE NXTLC1,NXTLC2,NXTLC3,FIRST
DATA FIRST/.TRUE./
c
c MXNXFL is maximum number of %FLAG cards that can be specified
c
PARAMETER (MXNXFL = 500)
! c
! CHARACTER*(*) FMTOLD,FMT,FLAG
! c
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
! c
IOK = 0
IF (FIRST) THEN
c
--- 87,140 ----
c %FLAG cards and store the lines they appear on. That way, on
c subsequent calls we'll know immediately if we should read further
c down the file, rewind, or exit with an error (flag not found).
!
! implicit none
! integer IUNIT
! integer IOUT
! integer IONERR
! character*(*) FMTOLD,FMT,FLAG
! integer IOK
!
! integer NNBCHR
!
! logical FIRST
! SAVE FIRST
DATA FIRST/.TRUE./
c
c MXNXFL is maximum number of %FLAG cards that can be specified
c
+ integer MXNXFL
PARAMETER (MXNXFL = 500)
!
CHARACTER*80 NXTFLG
CHARACTER*8 PRDAT,PRTIM
CHARACTER*255 AA
+ integer IBLOCK
+ integer INXTFL
+ integer IPRVRR
+ integer NUMFLG
+ real RPVER
COMMON /NXTLC1/INXTFL(2,MXNXFL),IPRVRR,NUMFLG,IBLOCK
COMMON /NXTLC2/RPVER
COMMON /NXTLC3/NXTFLG(MXNXFL),PRDAT,PRTIM
!
! integer I
! integer IPT
! integer IPT2
! integer IPT3
! integer IPT4
! integer IPT5
! integer IPT6
! integer IPT7
! integer IPT8
! integer IPT9
! integer IPT10
! integer LFLAG
! integer IL2US
! integer IFIND
! integer MBLOCK
! integer ILFO
!
IOK = 0
IF (FIRST) THEN
c
***************
*** 115,127 ****
c in RPVER. Store the date and time strings as character strings in
c PRDAT and PRTIM.
c
! DO 10 I = 1,9999999
READ(IUNIT,11,END=20) AA
11 FORMAT(A)
! IF (AA(1:8).NE.'%VERSION') GO TO 10
c
IPT = INDEX(AA,'VERSION_STAMP')
! IF (IPT.LE.0) GO TO 10
c
IPT2 = NNBCHR(AA,IPT+13,0,0)
IF (AA(IPT2:IPT2).NE.'=') GO TO 9000
--- 148,160 ----
c in RPVER. Store the date and time strings as character strings in
c PRDAT and PRTIM.
c
! do
READ(IUNIT,11,END=20) AA
11 FORMAT(A)
! IF (AA(1:8).NE.'%VERSION') cycle
c
IPT = INDEX(AA,'VERSION_STAMP')
! IF (IPT.LE.0) cycle
c
IPT2 = NNBCHR(AA,IPT+13,0,0)
IF (AA(IPT2:IPT2).NE.'=') GO TO 9000
***************
*** 155,161 ****
* '| Version = ',F8.3,' Date = ',A,' Time = ',A)
IPRVRR = 0
GO TO 50
! 10 CONTINUE
c
c Get here if no VERSION flag read. Set IPRVRR = 1 and return.
c On subsequent calls, if IPRVRR = 1, we return immediately.
--- 188,194 ----
* '| Version = ',F8.3,' Date = ',A,' Time = ',A)
IPRVRR = 0
GO TO 50
! end do
c
c Get here if no VERSION flag read. Set IPRVRR = 1 and return.
c On subsequent calls, if IPRVRR = 1, we return immediately.
***************
*** 176,182 ****
c
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
--- 209,216 ----
c
50 REWIND(IUNIT)
NUMFLG = 0
! I = 1
! do
READ(IUNIT,11,END=99) AA
IF (AA(1:5).EQ.'%FLAG') THEN
NUMFLG = NUMFLG + 1
***************
*** 188,194 ****
INXTFL(2,NUMFLG) = IPT3-IPT2+1
NXTFLG(NUMFLG) = AA(IPT2:IPT3)
END IF
! END DO
99 REWIND(IUNIT)
IBLOCK = 0
FIRST = .FALSE.
--- 222,229 ----
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.
***************
*** 237,249 ****
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
--- 272,284 ----
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
***************
*** 251,271 ****
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
c
c First %FORMAT found following appropriate %FLAG. Extract the
c format and return. All non-blank characters following %FORMAT
c comprise the format string (embedded blanks allowed).
c
! 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
c
c Format string is in IPT2:IPT3. Make sure passed FMT string is large
c enought to hold this and then return.
--- 286,306 ----
END DO
END IF
! DO
READ(IUNIT,11,END=9009) AA
! IF (AA(1:7).EQ.'%FORMAT') exit
END DO
c
c First %FORMAT found following appropriate %FLAG. Extract the
c format and return. All non-blank characters following %FORMAT
c comprise the format string (embedded blanks allowed).
c
! 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
c
c Format string is in IPT2:IPT3. Make sure passed FMT string is large
c enought to hold this and then return.
***************
*** 336,362 ****
c if no non-blank character found (IOPER = 0) or no blank
c character found (IOPER = 1).
c
! CHARACTER*(*) AA
IBG = IBEG
IEN = IEND
IF (IBEG.LE.0) IBG = 1
IF (IEND.LE.0) IEN = LEN(AA)
c
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
c
--- 371,407 ----
c if no non-blank character found (IOPER = 0) or no blank
c character found (IOPER = 1).
c
! implicit none
! integer NNBCHR
! character*(*) AA
! integer IBEG
! integer IEND
! integer IOPER
!
! integer I
! integer IBG
! integer IEN
!
IBG = IBEG
IEN = IEND
IF (IBEG.LE.0) IBG = 1
IF (IEND.LE.0) IEN = LEN(AA)
c
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
c
------------------------------------------------------------------------------
Temporary workarounds: reformat the contents of new format prmtop files
to reduce their line count. Or use old format
prmtop files via the LEaP command:
set default oldPrmtopFormat on