1 SUBROUTINE READF1(ARG,IGROUP,IDIM) 2C THIS ROUTINE READS "GENGEOM" FILE 3 IMPLICIT REAL*8 (A-H,O-Z) 4 include 'param.inc' 5 CHARACTER*(*) ARG 6 CHARACTER*20 ARGM(12),CARG 7 REAL*8 X(NAC),Y(NAC),Z(NAC),DVEC(3,3),IDVEC(3,3), 8 1 TMPVEC(3,3),XC(NAC,4),YC(NAC,4),ZC(NAC,4),fv(NAC,3) 9 INTEGER NAT(NAC) !I THINK NAC ATOMS PER CELL IS MORE THAN ENOUGH 10 CHARACTER*256 LINE 11 LOGICAL notfound, Lprimvec 12 13 COMMON/MULTAT/ X,Y,Z,NAT,DVEC,NATR 14 COMMON/FV/ FV,NFV 15 COMMON/IVEC/ IDVEC 16 COMMON/BOHRR/ BOHR,IMODE3 17 COMMON/KEYWORD/ notfound, Lprimvec 18 19 include 'mode.inc' 20 PARAMETER (NARGM=12) 21 22 DATA ARGM/'DIM-GROUP','MOLECULE','POLYMER','SLAB','CRYSTAL', 23 $ 'PRIMVEC','CONVVEC','PRIMCOORD', 24 * 'CONVCOORD','RECIP-PRIMVEC','RECIP-CONVVEC','SYMMOP'/ 25 26 notfound = .false. 27 IND=999 28 29C ********* 30 REWIND 11 31C ********* 32 33 LARG=INDEX(ARG,' ')-1 34 IF(LARG.EQ.-1)LARG=LEN(ARG) 35 36 DO I=1,NARGM 37 CARG=ARGM(I) 38 LCARG=INDEX(CARG,' ')-1 39c print *,'carg=',carg(1:5),'|' 40 IF(CARG(1:LCARG).EQ.ARG(1:LARG)) THEN 41 IND=I 42 GOTO 1 43 ENDIF 44 ENDDO 45c ********************************************************** 46 WRITE(6,*) 'READF1> KEYWORD ', ARG, ' NOT KNOWN!!! <STOP>' 47 STOP 48c ********************************************************** 49 50 51c is desired keyword present in the file 52 1 CONTINUE 53 54c DEBUG_BEGIN 55c READ(UNIT=11,FMT=*,END=99) CARG 56 READ(UNIT=11,FMT='(a20)',END=99) CARG 57 i = string_length(carg) 58c DEBUG_END 59 60 LCARG=INDEX(CARG,' ')-1 61c print *,'|',carg(1:lcarg),'|' 62 IF(CARG(1:LCARG).NE.ARG(1:LARG)) GOTO 1 63 64 GOTO(5,6,7,8,9,10,15,20,25,35,45,999) IND 65 66 99 continue 67c **************************** 68c this is nasty, but necessary 69c **************************** 70 if ( arg(1:7) .eq. 'CONVVEC' ) then 71 WRITE(12,'(1x,a)') 'CONVVEC' 72 WRITE(12,'(3(1x,f15.10)/3(1x,f15.10)/3(1x,f15.10))') 73 1 ((DVEC(J,I),I=1,3),J=1,3) 74 endif 75 notfound=.true. 76 999 RETURN 77 78C READ DIMENSION & GROUP NUMBER 79 5 CONTINUE 80 READ(11,*) IDIM,IGROUP 81 WRITE(12,'(1x,a)') 'DIM-GROUP' 82 WRITE(12,*) IDIM,IGROUP 83 RETURN 84 85C keyword MOLECULE 86 6 CONTINUE 87 IDIM=0 88 IGROUP=1 89 RETURN 90 91C keyword POLYMER 92 7 CONTINUE 93c WRITE(12,'(1x,a)') 'POLYMER' 94 IDIM=1 95 IGROUP=1 96 WRITE(12,'(1x,a)') 'DIM-GROUP' 97 WRITE(12,*) IDIM,IGROUP 98 RETURN 99 100C keyword SLAB 101 8 CONTINUE 102c WRITE(12,'(1x,a)') 'SLAB' 103 IDIM=2 104 IGROUP=1 105 WRITE(12,'(1x,a)') 'DIM-GROUP' 106 WRITE(12,*) IDIM,IGROUP 107 RETURN 108 109C keyword CRYSTAL 110 9 CONTINUE 111c WRITE(12,'(1x,a)') 'CRYSTAL' 112 IDIM=3 113 IGROUP=1 114 WRITE(12,'(1x,a)') 'DIM-GROUP' 115 WRITE(12,*) IDIM,IGROUP 116 RETURN 117 118 10 CONTINUE 119 WRITE(12,'(1x,a)') 'PRIMVEC' 120 GOTO 16 121 15 CONTINUE 122 WRITE(12,'(1x,a)') 'CONVVEC' 123 16 CONTINUE 124C READ CELL VECTORS 125 READ(11,*) ((DVEC(J,I),I=1,3),J=1,3) 126 IF(IMODE3.EQ.M3_BOHR)THEN !convert from borh to angstroms 127 DO I=1,3 128 DO J=1,3 129 DVEC(J,I) = BOHR * DVEC(J,I) 130 ENDDO 131 ENDDO 132 ENDIF 133c make the VECTORS consistent with dimenison 134 call DIMIFY_VEC(DVEC,IDIM) 135 136 WRITE(12,'(3(1x,f15.10)/3(1x,f15.10)/3(1x,f15.10))') 137 1 ((DVEC(J,I),I=1,3),J=1,3) 138C *** sometimes we will need inverse matrix of DVEC *** 139 call InvertSqMat123(dvec,idvec,3) 140 RETURN 141 142 20 CONTINUE 143 WRITE(12,'(1x,a)') 'PRIMCOORD' 144 READ(11,*) NATR,NCELL 145 WRITE(12,*) NATR,NCELL 146c print *,'natr=',natr,'; ncell=',ncell 147 DO I=1,NATR 148C ALL NAT(I,*) ARE THE SAME -> SO NAT(I) 149 777 continue 150 read(11,'(a)') line 151c print *,'line=',line,'|' 152 nf=iCountFields(line) 153 if (nf.lt.1) goto 777 154 NFV=nf-4 155 read(line,*) NAT(I),X(I),Y(I),Z(I), (fv(i,j), j=1,NFV) 156 157 IF(IMODE3.EQ.M3_BOHR) THEN 158 X(I) = X(I) * BOHR 159 Y(I) = Y(I) * BOHR 160 Z(I) = Z(I) * BOHR 161 ENDIF 162 WRITE(12,'(i3,3x,6(f15.10,2x))') NAT(I),X(I),Y(I),Z(I), 163 $ (fv(i,j), j=1,NFV) 164 ENDDO 165 RETURN 166 167 25 CONTINUE 168 169c ******** 170c CONVCOOR 171c ******** 172 if (.not.Lprimvec) WRITE(12,'(1x,a)') 'PRIMCOORD' 173C READ COORDINATES 174 READ(11,*) NATR,NCELL 175 if (.not.Lprimvec) WRITE(12,*) NATR, ' 1' 176c print *,'natr=',natr,'; ncell=',ncell 177 DO I=1,NATR 178 DO J=1,NCELL 179C ALL NAT(I,*) ARE THE SAME -> SO NAT(I) 180 READ(11,*) NAT(I),XC(I,J),YC(I,J),ZC(I,J) 181 IF(IMODE3.EQ.M3_BOHR) THEN 182 XC(I,J) = XC(I,J) * BOHR 183 YC(I,J) = YC(I,J) * BOHR 184 ZC(I,J) = ZC(I,J) * BOHR 185 ENDIF 186 if (.not.Lprimvec) WRITE(12,'(i3,3x,3(f15.10,2x))') 187 $ NAT(I),XC(I,J),YC(I,J),ZC(I,J) 188 ENDDO 189 if(.not.Lprimvec) then 190 x(i) = xc(i,1) 191 y(i) = yc(i,1) 192 z(i) = zc(i,1) 193 endif 194 ENDDO 195 RETURN 196 197 35 CONTINUE 198 WRITE(12,'(1x,a)') 'RECIP-PRIMVEC' 199 GOTO 46 200 45 CONTINUE 201 WRITE(12,'(1x,a)') 'RECIP-CONVVEC' 202 46 CONTINUE 203C READ RECIPROCAL VECTORS: they are written in normal form, 204C but should be read in TRANSPOSE form; take care 205 READ(11,*) ((IDVEC(J,I),J=1,3),I=1,3) 206 IF(IMODE3.EQ.M3_BOHR)THEN !convert from borh to angstroms 207 DO I=1,3 208 DO J=1,3 209 IDVEC(J,I) = BOHR * IDVEC(J,I) 210 ENDDO 211 ENDDO 212 ENDIF 213 WRITE(12,'(3(1x,f15.10)/3(1x,f15.10)/3(1x,f15.10))') 214 $ ((IDVEC(J,I),J=1,3),I=1,3) 215 RETURN 216C *** sometimes we will need inverse matrix of DVEC *** 217 218 END 219