1      subroutine geogau(formax,forrms,dismax,disrms,epoints,isav)
2      implicit double precision (a-h,o-z)
3      common /rdwr/   iun1,iun2,iun3,iun4,iun5
4      common /geocnv/ fmaxt,frmst,dmaxt,drmst,fgmin,fgmax,dgmin,dgmax,
5     &                enmax,enmin,ngeoms,nepnts,igcvav,ifmxav,ifrmav,
6     &                idmxav,idrmav,ieav,ifrav,mxpnt
7      common /gauori/ nzm,nso,nio,nzo,ioropt,ifor,
8     &                ixyz98,iopr,isymm,irc,imp2,icntp,itd
9      common /gauver/ ivers
10      character*137 line,str
11      character*25 sirc
12      common /curlin/ line
13      integer getlin
14      dimension formax(*),forrms(*),dismax(*),disrms(*),epoints(*)
15      dimension isav(*)
16
17      sirc = 'Item               Value'
18      nis = 24
19      if (irc.eq.2) then
20         sirc = '  Delta-x Convergence'
21         nis = 22
22      endif
23
24      call rewfil
25      isemi = 0
26      ioni = 0
27      call searchd(line,'ONIOM: generating','calculation of energy',
28     &             istat)
29      if (istat.ne.0) then
30         if (icdex(line,'ONIOM:').ne.0) then
31            ioni = 1
32         elseif (icdex(line,'External').ne.0) then
33            isemi = 1
34         elseif (icdex(line,'second derivatives').eq.0) then
35            if (icdex(line,'AM1').ne.0) isemi = 1
36            if (icdex(line,'MNDO').ne.0) isemi = 1
37            if (icdex(line,'MINDO3').ne.0) isemi = 1
38            if (icdex(line,'PM3').ne.0) isemi = 1
39            if (icdex(line,'CNDO').ne.0) isemi = 1
40            if (icdex(line,'INDO').ne.0) isemi = 1
41            if (icdex(line,'AMBER').ne.0) isemi = 1
42            if (icdex(line,'UFF').ne.0) isemi = 1
43            if (icdex(line,'Dreiding').ne.0) isemi = 1
44            if (icdex(line,'MM2').ne.0) isemi = 1
45            if (icdex(line,'MM3').ne.0) isemi = 1
46
47         endif
48      endif
49      call rewfil
50
51      igcvav = 1
52      ifmxav = 1
53      ifrmav = 1
54      idmxav = 1
55      idrmav = 1
56      ieav = 1
57
58
59      nepnts = 0
60      ngeoms = 0
61      igeoms = 0
62      do i=1,mxpnt
63         if (isemi.eq.1) then
64            call srclit(line,' Energy=',istat)
65         elseif (ioni.eq.1) then
66            call search(line,'ONIOM: extrapolated energy =',istat)
67         elseif (icntp.eq.1) then
68            call search(line,'Counterpoise: corrected energy =',istat)
69         elseif (imp2.eq.1) then
70            call searchd(line,'EUMP2 =','E(RMP2)=',istat)
71         elseif (itd.eq.1) then
72            call search(line,'E(TD-HF/TD-KS)',istat)
73         else
74            call searchd(line,'SCF Done:','MCSCF converged',istat)
75         endif
76         if (istat.eq.0) goto 100
77
7810       if (nepnts.eq.mxpnt) then
79            call inferr('exceeded MAXPNT !',1)
80            return
81         endif
82
83         etmp = 0.0d0
84         if (irc.eq.0) nepnts = nepnts + 1
85
86         imcscf = 0
87         if (icdex(line,'MCSCF').ne.0) then
88             imcscf = 1
89c             call scback(line,'... DO AN EXTRA-',istat)
90             call scback(line,'... Do an extra-',istat)
91             call bckfil
92             if (ivers.lt.2009) then
93                call bckfil
94             endif
95             call nxtlin(line,jstat)
96             i1 = index(line,'E=')
97             if (i1.gt.0) i1 = i1 + 1
98         elseif (icdex(line,'MP2').ne.0) then
99             it1 = icdex(line,'EUMP2 =')
100             if (it1.ne.0) i1 = it1 + 6
101             it1 = icdex(line,'E(RMP2)=')
102             if (it1.ne.0) i1 = it1 + 9
103         else
104             i1 = index(line,'=')
105         endif
106         if (i1.gt.0) then
107             if (irc.gt.0) then
108                etmp = reada(line,i1+1,len(line))
109             else
110                epoints(nepnts) = reada(line,i1+1,len(line))
111             endif
112         endif
113
114         if (imcscf.eq.1) then
115             call search(line,'MCSCF converged',istat)
116             call searchd(line,
117     &           'MCSCF converged',sirc(1:nis),istat)
118         else
119             if (isemi.eq.1) then
120                call searchd(line,
121     &           'Energy=',sirc(1:nis),istat)
122             elseif (ioni.eq.1) then
123                call searchd(line,
124     &           'ONIOM: extrapolated energy =',sirc(1:nis),istat)
125             elseif (icntp.eq.1) then
126                call searchd(line,'Counterpoise: corrected energy',
127     &           sirc(1:nis),istat)
128             elseif (imp2.eq.1) then
129                call searcht(line,'EUMP2 =','E(RMP2)=',
130     &           sirc(1:nis),istat)
131             elseif (itd.eq.1) then
132                call searchd(line,'E(TD-HF/TD-KS)',
133     &           sirc(1:nis),istat)
134             else
135                call searcht(line,
136     &           'SCF Done:',sirc(1:nis),
137     &           'Corrected End Point Energy ',istat)
138             endif
139         endif
140         if (istat.eq.0) goto 100
141
142         if (icdex(line,'Corrected').ne.0) then
143
144             i1 = index(line,'=')
145             etmp = reada(line,i1+1,len(line))
146             nepnts = nepnts + 1
147             igeoms = igeoms + 1
148             epoints(nepnts) = etmp
149             isav(nepnts) = 0
150
151         else if (icdex(line,'Item').ne.0) then
152
153
154c            read(iun2,'(26x,f8.6,5x,f8.6)',end=100,err=100) tmp1,fmaxt
155            icv1 = 0
156            icv2 = 0
157            icv3 = 0
158            icv4 = 0
159            if (getlin(0).eq.1) then
160                if (icdex(line,'YES').ne.0) icv1 = 1
161                ktype = nxtwrd(str,nstr,itype,rtype)
162                if (ktype.ne.1) goto 100
163                ktype = nxtwrd(str,nstr,itype,rtype)
164                if (ktype.ne.1) goto 100
165                ktype = nxtwrd(str,nstr,itype,rtype)
166                if (ktype.eq.1) tmp1 = 0.0d0
167                if (ktype.eq.3) tmp1 = rtype
168                ktype = nxtwrd(str,nstr,itype,rtype)
169                if (ktype.eq.1) fmaxt = 0.0d0
170                if (ktype.eq.3) fmaxt = rtype
171            else
172                goto 100
173            endif
174
175c            read(iun2,'(26x,f8.6,5x,f8.6)',end=100,err=100) tmp2,frmst
176            if (getlin(0).eq.1) then
177                if (icdex(line,'YES').ne.0) icv2 = 1
178                ktype = nxtwrd(str,nstr,itype,rtype)
179                if (ktype.ne.1) goto 100
180                ktype = nxtwrd(str,nstr,itype,rtype)
181                if (ktype.ne.1) goto 100
182                ktype = nxtwrd(str,nstr,itype,rtype)
183                if (ktype.eq.1) tmp2 = 0.0d0
184                if (ktype.eq.3) tmp2 = rtype
185                ktype = nxtwrd(str,nstr,itype,rtype)
186                if (ktype.eq.1) frmst = 0.0d0
187                if (ktype.eq.3) frmst = rtype
188            else
189                goto 100
190            endif
191
192c            read(iun2,'(26x,f8.6,5x,f8.6)',end=100,err=100) tmp3,dmaxt
193            if (getlin(0).eq.1) then
194                if (icdex(line,'YES').ne.0) icv3 = 1
195                ktype = nxtwrd(str,nstr,itype,rtype)
196                if (ktype.ne.1) goto 100
197                ktype = nxtwrd(str,nstr,itype,rtype)
198                if (ktype.ne.1) goto 100
199                ktype = nxtwrd(str,nstr,itype,rtype)
200                if (ktype.eq.1) tmp3 = 0.0d0
201                if (ktype.eq.3) tmp3 = rtype
202                ktype = nxtwrd(str,nstr,itype,rtype)
203                if (ktype.eq.1) dmaxt = 0.0d0
204                if (ktype.eq.3) dmaxt = rtype
205            else
206                goto 100
207            endif
208
209c            read(iun2,'(26x,f8.6,5x,f8.6)',end=100,err=100) tmp4,drmst
210            if (getlin(0).eq.1) then
211                if (icdex(line,'YES').ne.0) icv4 = 1
212                ktype = nxtwrd(str,nstr,itype,rtype)
213                if (ktype.ne.1) goto 100
214                ktype = nxtwrd(str,nstr,itype,rtype)
215                if (ktype.ne.1) goto 100
216                ktype = nxtwrd(str,nstr,itype,rtype)
217                if (ktype.eq.1) tmp4 = 0.0d0
218                if (ktype.eq.3) tmp4 = rtype
219                ktype = nxtwrd(str,nstr,itype,rtype)
220                if (ktype.eq.1) drmst = 0.0d0
221                if (ktype.eq.3) drmst = rtype
222            else
223                goto 100
224            endif
225
226            icv = icv1 + icv2 + icv3 + icv4
227            if (irc.eq.1) then
228                if (icv.ne.4) then
229                   goto 10
230                else
231                   nepnts = nepnts + 1
232                   epoints(nepnts) = etmp
233                endif
234            endif
235
236            igeoms = igeoms + 1
237            isav(nepnts) = 1
238            formax(nepnts) = tmp1
239            forrms(nepnts) = tmp2
240            dismax(nepnts) = tmp3
241            disrms(nepnts) = tmp4
242
243         else if (icdex(line,'Delta-x').ne.0) then
244
245            if (icdex(line,' NOT met').ne.0) goto 10
246            nepnts = nepnts + 1
247            igeoms = igeoms + 1
248            epoints(nepnts) = etmp
249            isav(nepnts) = 0
250
251         else
252
253            isav(nepnts) = 0
254            goto 10
255
256         endif
257
258      end do
259
260100   continue
261
262      if (igeoms.eq.0.or.igeoms.eq.1) then
263         ngeoms = igeoms
264         igcvav = 0
265         ifmxav = 0
266         ifrmav = 0
267         idmxav = 0
268         idrmav = 0
269         ieav = 0
270      else
271         ngeoms = nepnts
272      endif
273
274      return
275      end
276