*******> bugfix.16 Author: James Caldwell Date: Feb. 13, 1998 Program: roar Severity: Won't compile on Dec Alphas. Problem: Dec compilers capture "//" as a compiler directive when enclosed in parentheses. Temporary workarounds: none Fix: Make the following changes via "patch" -------------------------------------------------------------- *** /pak5/amber5/src/roar/mop7mm/iter.F Thu Oct 09 10:15:21 1997 --- iter.F Fri Feb 13 12:52:36 1998 *************** *** 298,304 **** SCFCRT=READA(KEYWRD,I) WRITE(iout,'('' SCF CRITERION ='',G14.4)')SCFCRT IF(SCFCRT.LT.1.D-12) ! 1 WRITE(iout,'(//2X,'' THERE IS A RISK OF INFINITE LOOPING WITH'', 2'' THE SCFCRT LESS THAN 1.D-12'')') ELSE IF(DEBUG)WRITE(iout,'('' SCF CRITERION ='',G14.4)')SCFCRT --- 298,304 ---- SCFCRT=READA(KEYWRD,I) WRITE(iout,'('' SCF CRITERION ='',G14.4)')SCFCRT IF(SCFCRT.LT.1.D-12) ! 1 WRITE(iout,'(/2X,'' THERE IS A RISK OF INFINITE LOOPING WITH'', 2'' THE SCFCRT LESS THAN 1.D-12'')') ELSE IF(DEBUG)WRITE(iout,'('' SCF CRITERION ='',G14.4)')SCFCRT *************** *** 350,356 **** WRITE(iout,'('' SELCON, PLTEST'',3G16.7)')SELCON, PLTEST ENDIF IF(PRT1EL) THEN ! WRITE(iout,'(//10X,''ONE-ELECTRON MATRIX AT ENTRANCE '', . ''TO ITER'')') CALL VECPRT(H,NORBS) ENDIF --- 350,356 ---- WRITE(iout,'('' SELCON, PLTEST'',3G16.7)')SELCON, PLTEST ENDIF IF(PRT1EL) THEN ! WRITE(iout,'(/10X,''ONE-ELECTRON MATRIX AT ENTRANCE '', . ''TO ITER'')') CALL VECPRT(H,NORBS) ENDIF *************** *** 381,389 **** * SWITCH ON ALL CONVERGERS * * * ************************************************************************ ! WRITE(iout,'(//,'' ALL CONVERGERS ARE NOW FORCED ON'',/ ! 1 '' SHIFT=10, PULAY ON, CAMP-KING ON'',/ ! 2 '' AND ITERATION COUNTER RESET'',//)') ALLCON=.TRUE. BSHIFT=4.44D0 IREDY=-4 --- 381,389 ---- * SWITCH ON ALL CONVERGERS * * * ************************************************************************ ! WRITE(iout,'(/,'' ALL CONVERGERS ARE NOW FORCED ON'',/, ! 1 '' SHIFT=10, PULAY ON, CAMP-KING ON'',/, ! 2 '' AND ITERATION COUNTER RESET'',/)') ALLCON=.TRUE. BSHIFT=4.44D0 IREDY=-4 *************** *** 537,546 **** GOTO 380 ENDIF IF(MINPRT)WRITE (6,230) ! 230 FORMAT (//10X,'"""""""""""""UNABLE TO ACHIEVE SELF-CONSISTENCE' ! 1,/) WRITE (6,240) DIFF,PL ! 240 FORMAT (//,10X,'DELTAE= ',E12.4,5X,'DELTAP= ',E12.4,///) IFLEPO=9 IITER=2 c CALL WRITMO(TIME0,ESCF) --- 537,545 ---- GOTO 380 ENDIF IF(MINPRT)WRITE (6,230) ! 230 FORMAT (/10X,'"""""""""UNABLE TO ACHIEVE SELF-CONSISTENCE',/) WRITE (6,240) DIFF,PL ! 240 FORMAT (/,10X,'DELTAE= ',E12.4,5X,'DELTAP= ',E12.4,/) IFLEPO=9 IITER=2 c CALL WRITMO(TIME0,ESCF) *************** *** 721,727 **** IF(PRTVEC) THEN J=1 IF(UHF)J=2 ! WRITE(iout,'(//10X,A, 1'' EIGENVECTORS AND EIGENVALUES ON ITERATION'',I3)') 2 ABPRT(J),NITER CALL MATOUT(C,EIGS,NORBS,NORBS,NORBS) --- 720,726 ---- IF(PRTVEC) THEN J=1 IF(UHF)J=2 ! WRITE(iout,'(/10X,A, 1'' EIGENVECTORS AND EIGENVALUES ON ITERATION'',I3)') 2 ABPRT(J),NITER CALL MATOUT(C,EIGS,NORBS,NORBS,NORBS) *************** *** 801,807 **** IF(KILLIT.EQ.1) RETURN ENDIF IF(PRTVEC) THEN ! WRITE(iout,'(//10X,A,'' EIGENVECTORS AND EIGENVALUES ON '', 1''ITERATION'',I3)')ABPRT(3),NITER CALL MATOUT(CBETA,EIGB,NORBS,NORBS,NORBS) ELSE --- 800,806 ---- IF(KILLIT.EQ.1) RETURN ENDIF IF(PRTVEC) THEN ! WRITE(iout,'(/10X,A,'' EIGENVECTORS AND EIGENVALUES ON '', 1''ITERATION'',I3)')ABPRT(3),NITER CALL MATOUT(CBETA,EIGB,NORBS,NORBS,NORBS) ELSE *** /pak5/amber5/src/roar/mop7mm/lapack.F Thu Oct 09 10:15:23 1997 --- lapack.F Fri Feb 13 13:06:31 1998 *************** *** 1597,1603 **** * FEBRUARY 29, 1992 * * .. SCALAR ARGUMENTS .. ! CHARACTER DIAG, UPLO INTEGER INFO, LDA, N * .. * .. ARRAY ARGUMENTS .. --- 1597,1603 ---- * FEBRUARY 29, 1992 * * .. SCALAR ARGUMENTS .. ! CHARACTER DIAG, UPLO , ctemp INTEGER INFO, LDA, N * .. * .. ARRAY ARGUMENTS .. *************** *** 1712,1718 **** * * DETERMINE THE BLOCK SIZE FOR THIS ENVIRONMENT. * ! NB = ILAENV( 1, 'DTRTRI', UPLO // DIAG, N, -1, -1, -1 ) IF( NB.LE.1 .OR. NB.GE.N ) THEN * * USE UNBLOCKED CODE --- 1712,1719 ---- * * DETERMINE THE BLOCK SIZE FOR THIS ENVIRONMENT. * ! ctemp = uplo//diag ! NB = ILAENV( 1, 'DTRTRI', ctemp, N, -1, -1, -1 ) IF( NB.LE.1 .OR. NB.GE.N ) THEN * * USE UNBLOCKED CODE *** /pak5/amber5/src/roar/mop7mm/matout.F Thu Oct 09 10:15:23 1997 --- matout.F Fri Feb 13 13:07:28 1998 *************** *** 71,77 **** IF (NR.GT.25) WRITE (6,140) GO TO 60 C ! 100 FORMAT (////,3X,9H ROOT NO.,I5,9I12) 110 FORMAT (/8X,10F12.5) 120 FORMAT (2H ) 130 FORMAT (2(1X,A2),I4,F10.5,10F12.5) --- 71,77 ---- IF (NR.GT.25) WRITE (6,140) GO TO 60 C ! 100 FORMAT (/,3X,9H ROOT NO.,I5,9I12) 110 FORMAT (/8X,10F12.5) 120 FORMAT (2H ) 130 FORMAT (2(1X,A2),I4,F10.5,10F12.5) *** /pak5/amber5/src/roar/mop7mm/mpsetup.F Thu Oct 09 10:15:24 1997 --- mpsetup.F Fri Feb 13 13:08:15 1998 *************** *** 52,59 **** c write(6,*)'leaving mpsetup' if(.not.do_scf)then write(6,997) ! 997 format(//15x,'<<<<< QM SYSTEM TREATED AS DUMMY SOLUTE >>>>>', ! . /15x,'<<<< NO QM SCF CALCULATION WILL BE DONE >>>>>'//) endif RETURN END --- 52,59 ---- c write(6,*)'leaving mpsetup' if(.not.do_scf)then write(6,997) ! 997 format(/15x,'<<<<< QM SYSTEM TREATED AS DUMMY SOLUTE >>>>>', ! . /15x,'<<<< NO QM SCF CALCULATION WILL BE DONE >>>>>'/) endif RETURN END *** /pak5/amber5/src/roar/mop7mm/pmfconstr.F Thu Oct 09 10:15:25 1997 --- pmfconstr.F Fri Feb 13 13:09:26 1998 *************** *** 77,83 **** C ECHO INFORMATION TO USER. C WRITE(6,220) ('*',I=1,80),NPLANE ! 220 FORMAT(//80A1//' PLANE CONSTRAINT DATA FROM FILE plane.dat:', . /' NUMBER OF PLANES =',I3/) IPOINT = 1 DO 400 I=1,NPLANE --- 77,83 ---- C ECHO INFORMATION TO USER. C WRITE(6,220) ('*',I=1,80),NPLANE ! 220 FORMAT(/80A1/' PLANE CONSTRAINT DATA FROM FILE plane.dat:', . /' NUMBER OF PLANES =',I3/) IPOINT = 1 DO 400 I=1,NPLANE *************** *** 106,112 **** 380 CONTINUE 400 CONTINUE WRITE(6,420) ('*',I=1,80) ! 420 FORMAT(/80A1//) GO TO 1000 500 WRITE(6,520) 520 FORMAT(/' ERROR READING PLANE DATA FROM plane.dat, SUBROUTINE', --- 106,112 ---- 380 CONTINUE 400 CONTINUE WRITE(6,420) ('*',I=1,80) ! 420 FORMAT(/,80A1,/) GO TO 1000 500 WRITE(6,520) 520 FORMAT(/' ERROR READING PLANE DATA FROM plane.dat, SUBROUTINE', *************** *** 264,270 **** C ECHO INFORMATION TO USER. C WRITE(6,120) ('*',I=1,80),NSYM ! 120 FORMAT(//80A1//' BOND SYMMETRY DATA FROM FILE symbnd.dat:', . /' NUMBER OF SYMMETRY SETS =',I3/) IPOINT = 1 DO 300 I=1,NSYM --- 264,270 ---- C ECHO INFORMATION TO USER. C WRITE(6,120) ('*',I=1,80),NSYM ! 120 FORMAT(/,80A1,/' BOND SYMMETRY DATA FROM FILE symbnd.dat:', . /' NUMBER OF SYMMETRY SETS =',I3/) IPOINT = 1 DO 300 I=1,NSYM *************** *** 279,285 **** 280 CONTINUE 300 CONTINUE WRITE(6,320) ('*',I=1,80) ! 320 FORMAT(/80A1//) GO TO 1000 500 WRITE(6,520) 520 FORMAT(/' ERROR READING BOND SYMMETRY DATA FROM symbnd.dat, ', --- 279,285 ---- 280 CONTINUE 300 CONTINUE WRITE(6,320) ('*',I=1,80) ! 320 FORMAT(/80A1,/) GO TO 1000 500 WRITE(6,520) 520 FORMAT(/' ERROR READING BOND SYMMETRY DATA FROM symbnd.dat, ', *************** *** 880,887 **** C 200 WRITE(6,*) ('*',I=1,80),NCUT 220 FORMAT(/80A1/) ! c220 FORMAT(//80A1//' USER-DEFINED NONBONDED CUTOFFS FROM FILE ', ! c . 'cutoff.dat:'/' NUMBER OF CUTOFF RECORDS =',I4// c . 5X,'RESIDUE',5X,'CUTOFF'/) DO 300 I=1,NCUT WRITE(6,240) ICUT(I),RCUT(I) --- 880,887 ---- C 200 WRITE(6,*) ('*',I=1,80),NCUT 220 FORMAT(/80A1/) ! c220 FORMAT(/,80A1,/' USER-DEFINED NONBONDED CUTOFFS FROM FILE ', ! c . 'cutoff.dat:'/' NUMBER OF CUTOFF RECORDS =',I4,/ c . 5X,'RESIDUE',5X,'CUTOFF'/) DO 300 I=1,NCUT WRITE(6,240) ICUT(I),RCUT(I) *** /pak5/amber5/src/roar/mop7mm/qmconstr.F Thu Oct 09 10:15:25 1997 --- qmconstr.F Fri Feb 13 13:10:18 1998 *************** *** 276,282 **** C NOW ECHO WHAT THE USER HAS SPECIFIED. C WRITE(6,520) ('*',I=1,80),NCNSTR ! 520 FORMAT(//80A1//' QM CONSTRAINT DATA FROM FILE constraint.dat:', . /' NUMBER OF CONSTRAINT RECORDS =',I4/) IF(MVONE.EQ.1)THEN WRITE(6,600) --- 276,282 ---- C NOW ECHO WHAT THE USER HAS SPECIFIED. C WRITE(6,520) ('*',I=1,80),NCNSTR ! 520 FORMAT(/,80A1,/' QM CONSTRAINT DATA FROM FILE constraint.dat:', . /' NUMBER OF CONSTRAINT RECORDS =',I4/) IF(MVONE.EQ.1)THEN WRITE(6,600) *************** *** 296,306 **** 800 CONTINUE IF(MVONE.EQ.1)THEN WRITE(6,820) ! 820 FORMAT(//' CONSTRAINTS WILL BE ENFORCED BY MOVING ONLY THE', . ' FIRST ATOM IN EACH'/' INTERNAL COORDINATE LIST'/) ENDIF WRITE(6,840) ('*',I=1,80) ! 840 FORMAT(/80A1//) 1000 RETURN END C --- 296,306 ---- 800 CONTINUE IF(MVONE.EQ.1)THEN WRITE(6,820) ! 820 FORMAT(/,' CONSTRAINTS WILL BE ENFORCED BY MOVING ONLY THE', . ' FIRST ATOM IN EACH'/' INTERNAL COORDINATE LIST'/) ENDIF WRITE(6,840) ('*',I=1,80) ! 840 FORMAT(/80A1,/) 1000 RETURN END C *************** *** 379,386 **** C ECHO THE RIGID GEOMETRY TO THE USER. C 1000 WRITE(6,1020) ! 1020 FORMAT(//'QUANTUM SYSTEM GEOMETRY WILL BE RIGID FOR THE ', ! . 'CALCULATION:'//' ATOM',11X,'BOND',9X,'ANGLE',9X, . 'DIHEDRAL',7X,'IA',3X,'IB',3X,'IC'/) ICNSTR = 1 DO 1100 I=1,NQUANT-1 --- 379,386 ---- C ECHO THE RIGID GEOMETRY TO THE USER. C 1000 WRITE(6,1020) ! 1020 FORMAT(/,'QUANTUM SYSTEM GEOMETRY WILL BE RIGID FOR THE ', ! . 'CALCULATION:',/' ATOM',11X,'BOND',9X,'ANGLE',9X, . 'DIHEDRAL',7X,'IA',3X,'IB',3X,'IC'/) ICNSTR = 1 DO 1100 I=1,NQUANT-1 *************** *** 1300,1306 **** C 30 IF(NCYCLE.EQ.MAXCYC)THEN WRITE(6,40) MAXCYC ! 40 FORMAT(//'***MATRIX NOT DIAGONALIZED AFTER ',I5,' CYCLES***'//) IERROR = 1 GO TO 500 ENDIF --- 1300,1306 ---- C 30 IF(NCYCLE.EQ.MAXCYC)THEN WRITE(6,40) MAXCYC ! 40 FORMAT(/,'***MATRIX NOT DIAGONALIZED AFTER ',I5,' CYCLES***',/) IERROR = 1 GO TO 500 ENDIF *** /pak5/amber5/src/roar/mop7mm/refer.F Thu Oct 09 10:15:26 1997 --- refer.F Fri Feb 13 13:13:22 1998 *************** *** 64,68 **** C STOP KILLIT=1 RETURN ! 40 FORMAT(/////10X,A,4(/10X,A)) END --- 64,68 ---- C STOP KILLIT=1 RETURN ! 40 FORMAT(/10X,A,4(/10X,A)) END