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