[CPMD-list] bug in fileopen-patch???
Elske Leenders
eleenders at science.uva.nl
Wed Jun 1 14:13:17 CEST 2005
Dear CPMD-people,
As I experienced problems opening TRAJECTORY and ENERGIES files (pc-
cluster, PC-PGI-MPI, AMD Athlon(TM) XP 2400+), I upgraded from CPMD
3.9.1 to 3.9.2 and included the recent patch (from Axel, May 28th, 2005)
immediately.
This helped in opening the files, but caused a new problem: the
TRAJECTORY files were overwritten in stead of appended, which is pretty
useless if you need trajectories :-). I noticed that in fileopen.F, only
the files opened with FLAG=3 had POSITION='APPEND'. But in printp.F, all
trajectory (and similar) files were opened using FLAG=2: CALL FILEOPEN
(4,FNTRJ,2).
I noticed that in the unpatched 3.9.2-code, no flags are used in the
subroutine FILEOPEN. When I changed the flags involving trajectory and
movie files in printp.F (patched) from 2 to 3 (see attachment),
everything seemed to work fine.
Did I do the correct thing or am I missing something here?
Elske Leenders
--
E.J.M. Leenders, MSc.
Van 't Hoff Institute for Molecular Sciences
Faculty of Science
Universiteit van Amsterdam
Nieuwe Achtergracht 166
1018 WV AMSTERDAM
The Netherlands
tel. +31 - 20 - 525 6492
fax. +31 - 20 - 525 5604
e-mail: eleenders at science.uva.nl
url: http://www.science.uva.nl/~eleender
-------------- next part --------------
C ==================================================================
SUBROUTINE PRINTP(TAUR,TAUP,VELP)
C ==--------------------------------------------------------------==
IMPLICIT NONE
INCLUDE 'system.h'
INCLUDE 'ions.inc'
INCLUDE 'cnst.inc'
INCLUDE 'movi.inc'
INCLUDE 'cotr.inc'
INCLUDE 'ropt.inc'
INCLUDE 'metr.inc'
INCLUDE 'strs.inc'
INCLUDE 'rmas.inc'
INCLUDE 'prcp.inc'
INCLUDE 'ddip.inc'
INCLUDE 'clas.inc'
INCLUDE 'store.inc'
INCLUDE 'adat.inc'
INCLUDE 'cnst_dyn.inc' ! cmb
C Arguments
REAL*8 TAUR(3,NAX,NSX),TAUP(3,NAX,NSX),VELP(3,NAX,NSX)
C Variables
INTEGER ITYP ! cmb
REAL*8 FACT,CONST,OUT(3,3),FVAL,CVAL ! cmb
LOGICAL FEXIST
CHARACTER*100 FNMOVIE,FNTRJ,FCNTR,FNSTRESS,FNCELL,FNDIPO
CHARACTER*100 FNSTRECL,FNTRX
CHARACTER*10 F1,F2,F3,F4,F5,F6,F7,F8
DATA F1,F2,F3,F4,F5,F6,F7,F8
* /'MOVIE ','TRAJECTORY','CONSTRAINT','STRESS ',
* 'CELL ','DIPOLE ','STRECL ','TRAJEC.xyz'/
INTEGER IA,IC,IE,IS,IZ0,IT0,I,J,K,L,
& IF1,IF2,IF3,IF4,IF5,IF6,IF7,IF8,AA,AN
DATA IF1,IF2,IF3,IF4,IF5,IF6,IF7,IF8 /8*0/
SAVE IF1,IF2,IF3,IF4,IF5,IF6,IF7,IF8
C ==--------------------------------------------------------------==
C == OPEN THE TRAJECTORY AND MOVIE FILES ==
C ==--------------------------------------------------------------==
FNTRX=FPATH(IAPATH:IEPATH)//F8
FNSTRECL=FPATH(IAPATH:IEPATH)//F7
FNDIPO=FPATH(IAPATH:IEPATH)//F6
FNCELL=FPATH(IAPATH:IEPATH)//F5
FNSTRESS=FPATH(IAPATH:IEPATH)//F4
FCNTR=FPATH(IAPATH:IEPATH)//F3
FNTRJ=FPATH(IAPATH:IEPATH)//F2
FNMOVIE=FPATH(IAPATH:IEPATH)//F1
IF(RPRINT) THEN
IF(IF2.EQ.0) THEN
INQUIRE(FILE=FNTRJ,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNTRJ,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNTRJ(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(4,FNTRJ,2)
C Zie hieronder voor toelichting
C EL 1 juni 2005
CALL FILEOPEN(4,FNTRJ,3)
WRITE(4,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(4,FNTRJ,1)
ENDIF
IF2=1
ELSE
C CALL FILEOPEN(4,FNTRJ,2)
C Met flag=2 wordt trajectory niet geappend, maar overschreven
C Zie fileopen.F
C Aangepast EL, 1 juni 2005
C Hieronder wordt het ook steeds aangepast voor de rest van de files.
CALL FILEOPEN(4,FNTRJ,3)
ENDIF
IF(IF3.EQ.0) THEN
IF(MCNSTR.GT.0.OR.MRESTR.GT.0) THEN
INQUIRE(FILE=FCNTR,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FCNTR,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FCNTR(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(31,FCNTR,2)
CALL FILEOPEN(31,FCNTR,3)
WRITE(31,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(31,FCNTR,1)
ENDIF
ENDIF
IF3=1
ELSE
C IF(MCNSTR.GT.0.OR.MRESTR.GT.0) CALL FILEOPEN(31,FCNTR,2)
IF(MCNSTR.GT.0.OR.MRESTR.GT.0) CALL FILEOPEN(31,FCNTR,3)
ENDIF
IF(IF5.EQ.0) THEN
IF(TPRCP) THEN
INQUIRE(FILE=FNCELL,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNCELL,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNCELL(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(32,FNCELL,2)
CALL FILEOPEN(32,FNCELL,3)
WRITE(32,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(32,FNCELL,1)
ENDIF
ENDIF
IF5=1
ELSE
C IF(TPRCP) CALL FILEOPEN(32,FNCELL,2)
IF(TPRCP) CALL FILEOPEN(32,FNCELL,3)
ENDIF
ENDIF
IF(TXYZ) THEN
IF(XTOUT) THEN
IF(IF8.EQ.0) THEN
INQUIRE(FILE=FNTRX,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNTRX,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNTRX(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(8,FNTRX,2)
CALL FILEOPEN(8,FNTRX,3)
ELSE
CALL FILEOPEN(8,FNTRX,1)
ENDIF
IF8=1
ELSE
C CALL FILEOPEN(8,FNTRX,2)
CALL FILEOPEN(8,FNTRX,3)
ENDIF
ENDIF
ENDIF
IF(MOVIE) THEN
IF(IF1.EQ.0) THEN
INQUIRE(FILE=FNMOVIE,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNMOVIE,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNMOVIE(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(11,FNMOVIE,2)
CALL FILEOPEN(11,FNMOVIE,3)
WRITE(11,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(11,FNMOVIE,1)
ENDIF
IF1=1
ELSE
C CALL FILEOPEN(11,FNMOVIE,2)
CALL FILEOPEN(11,FNMOVIE,3)
ENDIF
ENDIF
IF(CALSTE) THEN
IF(MOD(INFI-1,NPRES).EQ.0) THEN
IF(IF4.EQ.0) THEN
INQUIRE(FILE=FNSTRESS,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNSTRESS,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNSTRESS(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(33,FNSTRESS,2)
CALL FILEOPEN(33,FNSTRESS,3)
WRITE(33,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(33,FNSTRESS,1)
ENDIF
IF4=1
ELSE
C CALL FILEOPEN(33,FNSTRESS,2)
CALL FILEOPEN(33,FNSTRESS,3)
ENDIF
ENDIF
ENDIF
IF(CALSTC) THEN
IF(IF7.EQ.0) THEN
INQUIRE(FILE=FNSTRECL,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNSTRECL,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNSTRECL(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(55,FNSTRECL,2)
CALL FILEOPEN(55,FNSTRECL,3)
WRITE(55,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(55,FNSTRECL,1)
ENDIF
IF7=1
ELSE
C CALL FILEOPEN(55,FNSTRECL,2)
CALL FILEOPEN(55,FNSTRECL,3)
ENDIF
ENDIF
IF(CALDIP) THEN
IF(IF6.EQ.0) THEN
INQUIRE(FILE=FNDIPO,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNDIPO,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNDIPO(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(34,FNDIPO,2)
CALL FILEOPEN(34,FNDIPO,3)
WRITE(34,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(34,FNDIPO,1)
ENDIF
IF6=1
ELSE
C CALL FILEOPEN(34,FNDIPO,2)
CALL FILEOPEN(34,FNDIPO,3)
ENDIF
ENDIF
C..Store ionic coordinates and velocities for statistics
IF(RPRINT) THEN
IF(TSAMPL) THEN
L=0
DO K=1,NSP
DO J=1,NA(K)
L=L+1
IF (L.GE.MINWRITEATOM.AND.L.LE.MAXWRITEATOM) THEN
IF (.NOT.TRAJSMALL .OR. L.LE.TRAJSMALLN) THEN
IF (TWRITEBINTRAJECTORY) THEn
WRITE(4)
* NFI,(TAUP(I,J,K),I=1,3),(VELP(I,J,K),I=1,3)
ELSE
WRITE(4,'(I7,6(2X,F22.14))')
* NFI,(TAUP(I,J,K),I=1,3),(VELP(I,J,K),I=1,3)
END IF
ENDIF
END IF
ENDDO
ENDDO
ELSE
L=0
DO K=1,NSP
DO J=1,NA(K)
L=L+1
IF (L.GE.MINWRITEATOM.AND.L.LE.MAXWRITEATOM) THEN
IF (.NOT.TRAJSMALL .OR. L.LE.TRAJSMALLN) THEN
IF (TWRITEBINTRAJECTORY) THEn
WRITE(4)
* NFI,(TAUP(I,J,K),I=1,3),(VELP(I,J,K),I=1,3)
ELSE
WRITE(4,'(I7,6(2X,F22.14))')
* NFI,(TAUP(I,J,K),I=1,3),(VELP(I,J,K),I=1,3)
END IF
ENDIF
END IF
ENDDO
ENDDO
ENDIF
CLOSE(4)
IF(MCNSTR.GT.0.OR.MRESTR.GT.0) THEN
DO J=1,MCNSTR
FVAL=FV(J)
ITYP=NTCNST(1,J)
IF(ITYP.EQ.2.OR.ITYP.EQ.3.OR.ITYP.EQ.5) CALL RADDEG(FVAL,1)
WRITE(31,'(I7,2X,I4,5X,2(1PE20.10))') NFI,J,XLAGR(J),FVAL
ENDDO
DO J=1,MRESTR
FVAL=RESV(J)
CVAL=RESVAL(J)
ITYP=NTREST(1,J)
IF(ITYP.EQ.2.OR.ITYP.EQ.3.OR.ITYP.EQ.5) CALL RADDEG(FVAL,1)
IF(ITYP.EQ.2.OR.ITYP.EQ.3.OR.ITYP.EQ.5) CALL RADDEG(CVAL,1)
FVAL=FVAL-CVAL
WRITE(31,'(I7,2X,I4,5X,2(1PE20.10)," R")') NFI,J,CVAL,FVAL
ENDDO
CLOSE(31)
ENDIF
IF(TPRCP) THEN
WRITE(32,*) ' CELL PARAMETERS at Step:', NFI
DO I=1,3
WRITE(32,'(3(1X,F14.6),8X,3(1X,F12.6))')
* (HT(I,J),J=1,3),(HTVEL(I,J),J=1,3)
ENDDO
CLOSE(32)
ENDIF
ENDIF
C..Write xyz file output
IF(TXYZ) THEN
AA=0
DO K=1,NSP
AA=AA+NA(K)
ENDDO
WRITE(8,*) AA
WRITE(8,*) NFI
DO K=1,NSP
DO J=1,NA(K)
AN=IATYP(K)
WRITE(8,'(A2,3(2X,F12.6))') EL(AN),
* (TAUP(I,J,K)*0.529177249d0,I=1,3)
ENDDO
ENDDO
CLOSE(8)
ENDIF
C..Write Movie File
IF(MOVIE)THEN
DO IS=1,NSP
IZ0=IMTYP(IS)
DO IA=1,NA(IS)
IF(IATYP(IS).EQ.4) THEN
C..Change Be -> Na ; problem with movie
IT0=11
WRITE(11,'(3(2X,F12.4),2I4)')
* (TAUP(K,IA,IS)/FBOHR,K=1,3),IT0,IZ0
ELSE
WRITE(11,'(3(2X,F12.4),2I4)')
* (TAUP(K,IA,IS)/FBOHR,K=1,3),IATYP(IS),IZ0
ENDIF
ENDDO
ENDDO
CLOSE(11)
ENDIF
C..Write Stress tensor
IF(CALSTE .AND. MOD(INFI-1,NPRES).EQ.0) THEN
CALL DCOPY(9,PAIU,1,OUT,1)
DO IS=1,NSP
FACT=PMA(IS)
DO IA=1,NA(IS)
DO K=1,3
DO L=1,3
OUT(K,L)=OUT(K,L)+FACT*VELP(K,IA,IS)*VELP(L,IA,IS)
ENDDO
ENDDO
ENDDO
ENDDO
C We give th true total stress tensor. (T.D.)
C DO I=1,3
C OUT(I,I)=OUT(I,I)+DRUCK*OMEGA
C ENDDO
WRITE(33,*) ' TOTAL STRESS TENSOR (kB): Step:', NFI
DO I=1,3
WRITE(33,'(5X,3(F20.8))') ((OUT(I,J)/OMEGA)*AU_KB,J=1,3)
ENDDO
CLOSE(33)
ENDIF
c WRITE CLASSICAL STRESS TENSOR
c we add the ideal gas contribution of the classical particles
IF(CALSTC) THEN
DO IC=1,NCLTYP
IF(IS_QM(IC).EQ.0) THEN
c classical particle
CONST=CLMAS(IC)*SCMASS
DO IA=NCRANG(1,IC),NCRANG(2,IC)
DO K=1,3
DO L=1,3
CLASPRES(K,L)=CLASPRES(K,L)+CONST*CLASV(K,IA)*CLASV(L,IA)
ENDDO
ENDDO
ENDDO
ENDIF
ENDDO
WRITE(55,*) 'CLASSICAL STRESS TENSOR (kB): Step:', NFI
c WRITE(57,*) 'CLASSICAL STRESS TENSOR (kB): Step:', NFI
DO I=1,3
WRITE(55,'(5X,3(F20.8))') ((claspres(I,J)/CLOMEGA)*AU_KB,J=1,3)
c WRITE(57,'(5X,3(F20.8))') ((claspres(I,J)/CLOMEGA)*AU_KB,J=1,3)
ENDDO
CLOSE(55)
ENDIF
C..Write Dipole Moments
IF(CALDIP) THEN
WRITE(34,'(I7,6(2X,1PE16.6E2))')NFI,(PDIPOLE(I),I=1,3),
* (PDIPOLT(I),I=1,3)
CLOSE(34)
ENDIF
C ==--------------------------------------------------------------==
RETURN
END
C ==================================================================
C ==================================================================
SUBROUTINE PRINTP2(TAUR,TAUP,VELP,FION)
C ==--------------------------------------------------------------==
IMPLICIT NONE
INCLUDE 'system.h'
INCLUDE 'ions.inc'
INCLUDE 'cnst.inc'
INCLUDE 'movi.inc'
INCLUDE 'cotr.inc'
INCLUDE 'ropt.inc'
INCLUDE 'metr.inc'
INCLUDE 'strs.inc'
INCLUDE 'rmas.inc'
INCLUDE 'prcp.inc'
INCLUDE 'ddip.inc'
INCLUDE 'clas.inc'
INCLUDE 'store.inc'
INCLUDE 'adat.inc'
INCLUDE 'cnst_dyn.inc' ! cmb
C Arguments
REAL*8 TAUR(3,NAX,NSX),TAUP(3,NAX,NSX),VELP(3,NAX,NSX)
REAL*8 FION(3,NAX,NSX)
C Variables
INTEGER ITYP ! cmb
REAL*8 FACT,CONST,OUT(3,3),FVAL,CVAL ! cmb
LOGICAL FEXIST
CHARACTER*100 FNMOVIE,FNTRJ,FCNTR,FNSTRESS,FNCELL,FNDIPO
CHARACTER*100 FNSTRECL,FNTRX
CHARACTER*11 F2
DATA F2
* /'FTRAJECTORY'/
INTEGER IA,IC,IE,IS,IZ0,IT0,I,J,K,L,
& IF2,AA,AN
DATA IF2 /1*0/
SAVE IF2
C ==--------------------------------------------------------------==
C == OPEN THE TRAJECTORY AND MOVIE FILES ==
C ==--------------------------------------------------------------==
FNTRJ=FPATH(IAPATH:IEPATH)//F2
IF(RPRINT) THEN
IF(IF2.EQ.0) THEN
INQUIRE(FILE=FNTRJ,EXIST=FEXIST)
IF(FEXIST) THEN
CALL XSTRING(FNTRJ,IA,IE)
WRITE(6,'(A,A,A)') ' FILE ',FNTRJ(IA:IE),
* ' EXISTS, NEW DATA WILL BE APPENDED'
C CALL FILEOPEN(4,FNTRJ,2)
CALL FILEOPEN(4,FNTRJ,3)
WRITE(4,'(A)') ' <<<<<< NEW DATA >>>>>>'
ELSE
CALL FILEOPEN(4,FNTRJ,1)
ENDIF
IF2=1
ELSE
C CALL FILEOPEN(4,FNTRJ,2)
CALL FILEOPEN(4,FNTRJ,3)
ENDIF
ENDIF
C..Store ionic coordinates and velocities for statistics
IF(RPRINT) THEN
IF(TSAMPL) THEN
L=0
DO K=1,NSP
DO J=1,NA(K)
L=L+1
IF (L.GE.MINWRITEATOM.AND.L.LE.MAXWRITEATOM) THEN
IF (.NOT.TRAJSMALL .OR. L.LE.TRAJSMALLN) THEN
IF (TWRITEBINTRAJECTORY) THEn
WRITE(4)
& NFI,
& TAUP(1,J,K),TAUP(2,J,K),TAUP(3,J,K),
& VELP(1,J,K),VELP(2,J,K),VELP(3,J,K),
& FION(1,J,K),FION(2,J,K),FION(3,J,K)
ELSE
WRITE(4,'(I7,9(2X,F22.14))')
& NFI,
& TAUP(1,J,K),TAUP(2,J,K),TAUP(3,J,K),
& VELP(1,J,K),VELP(2,J,K),VELP(3,J,K),
& FION(1,J,K),FION(2,J,K),FION(3,J,K)
END IF
END IF
ENDIF
ENDDO
ENDDO
ELSE
L=0
DO K=1,NSP
DO J=1,NA(K)
L=L+1
IF (L.GE.MINWRITEATOM.AND.L.LE.MAXWRITEATOM) THEN
IF (.NOT.TRAJSMALL .OR. L.LE.TRAJSMALLN) THEN
IF (TWRITEBINTRAJECTORY) THEn
WRITE(4)
& NFI,
& TAUP(1,J,K),TAUP(2,J,K),TAUP(3,J,K),
& VELP(1,J,K),VELP(2,J,K),VELP(3,J,K),
& FION(1,J,K),FION(2,J,K),FION(3,J,K)
ELSE
WRITE(4,'(I7,9(2X,F22.14))')
& NFI,
& TAUP(1,J,K),TAUP(2,J,K),TAUP(3,J,K),
& VELP(1,J,K),VELP(2,J,K),VELP(3,J,K),
& FION(1,J,K),FION(2,J,K),FION(3,J,K)
END IF
END IF
ENDIF
ENDDO
ENDDO
ENDIF
CLOSE(4)
ENDIF
C ==--------------------------------------------------------------==
RETURN
END
C ==================================================================
More information about the CPMD-list
mailing list