1      logical function tce_ccsdt_driver(title,ref,corr,thresh,maxiter,
2     &        d_t1,k_t1_offset,size_t1,d_t2,k_t2_offset,size_t2,
3     &        d_t3,k_t3_offset,size_t3,d_f1,k_f1_offset,
4     &        d_v2,k_v2_offset,diis_t3)
5c
6c $Id$
7c
8c Main routine for many-electron theory calculations.
9c Some of the subroutines have been generated by
10c operator/tensor contraction engines.
11c
12c Written by Jeff Hammond, January 2008.
13c
14      implicit none
15#include "mafdecls.fh"
16#include "tcgmsg.fh"
17#include "global.fh"
18#include "bas.fh"
19#include "geom.fh"
20#include "sym.fh"
21#include "util.fh"
22#include "msgids.fh"
23#include "stdio.fh"
24#include "sf.fh"
25#include "inp.fh"
26#include "errquit.fh"
27c#include "tce.fh"
28c#include "tce_main.fh"
29c#include "tce_prop.fh"
30c#include "tce_ints.fh"
31c#include "tce_amps.fh"
32c#include "tce_diis.fh"
33c
34c     CI, CC, & MBPT
35c
36      integer iter,maxiter
37      logical nodezero         ! True if node 0
38      logical recompf          ! True if recompute Fock
39      double precision cpu     ! CPU sec counter
40      double precision wall    ! WALL sec counter
41      integer irrep
42      integer irrep_g
43      integer d_e              ! SF handle for e file
44      integer l_e_offset       ! Offset for e file
45      integer k_e_offset       ! Offset for e file
46      integer size_e           ! File size in doubles
47      integer d_f1             ! SF handle for MO 1e integrals
48      integer k_f1_offset      ! Offset for 1e integral file
49      integer size_1e          ! File size in doubles
50      integer d_v2             ! SF handle for MO 2e integrals
51      integer k_v2_offset      ! Offset for 2e integral file
52      integer size_2e          ! File size in doubles
53      integer d_t1             ! SF handle for t1 amplitudes
54      integer k_t1_offset      ! Offset for t1 file
55      integer size_t1          ! File size in doubles
56      integer d_t2             ! SF handle for t2 amplitudes
57      integer k_t2_offset      ! Offset for t2 file
58      integer size_t2          ! File size in doubles
59      integer d_t3             ! SF handle for t2 amplitudes
60      integer k_t3_offset      ! Offset for t2 file
61      integer size_t3          ! File size in doubles
62      logical diis_t3
63      integer d_r1             ! SF handle for r1 amplitudes
64      integer d_r2             ! SF handle for r2 amplitudes
65      integer d_r3             ! SF handle for t2 amplitudes
66      double precision ref     ! Ground state energy
67      double precision corr    ! Correlation energy
68      double precision r1,r2,r3
69      double precision residual! Largest residual
70      double precision thresh
71      integer dummy            ! Dummy argument for DIIS
72      character*255 filename
73      character*20 title
74      character*4 irrepname
75      nodezero=(ga_nodeid().eq.0)
76      call tce_e_offset(l_e_offset,k_e_offset,size_e)
77#if defined(DEBUG_PRINT)
78        if(nodezero) write(LuOut,*) 'l_e_offset = ',l_e_offset
79#endif
80c -------------
81c CCSD    right
82c -------------
83      call tce_diis_init()
84      do iter=1,maxiter
85          cpu=-util_cpusec()
86          wall=-util_wallsec()
87          if (nodezero.and.(iter.eq.1)) write(LuOut,9050) title
88          call tce_filename('e',filename)
89          call createfile(filename,d_e,size_e)
90c          print*,'ccsdt_e'
91          call ccsdt_e(d_f1,d_e,d_t1,d_t2,d_v2,
92     1                 k_f1_offset,k_e_offset,
93     2                 k_t1_offset,k_t2_offset,k_v2_offset)
94          call reconcilefile(d_e,size_e)
95          call tce_filename('r1',filename)
96          call createfile(filename,d_r1,size_t1)
97c          print*,'ccsdt_t1'
98          call ccsdt_t1(d_f1,d_r1,d_t1,d_t2,d_t3,d_v2,
99     1                  k_f1_offset,k_t1_offset,k_t1_offset,
100     2                  k_t2_offset,k_t3_offset,k_v2_offset)
101          call reconcilefile(d_r1,size_t1)
102          call tce_filename('r2',filename)
103          call createfile(filename,d_r2,size_t2)
104c          print*,'ccsdt_t2'
105          call ccsdt_t2(d_f1,d_r2,d_t1,d_t2,d_t3,d_v2,
106     1                  k_f1_offset,k_t2_offset,k_t1_offset,
107     2                  k_t2_offset,k_t3_offset,k_v2_offset)
108          call reconcilefile(d_r2,size_t2)
109          call tce_filename('r3',filename)
110          call createfile(filename,d_r3,size_t3)
111c          print*,'ccsdt_t3'
112          call ccsdt_t3(d_f1,d_r3,d_t1,d_t2,d_t3,d_v2,
113     1                  k_f1_offset,k_t3_offset,k_t1_offset,
114     2                  k_t2_offset,k_t3_offset,k_v2_offset)
115          call reconcilefile(d_r3,size_t3)
116          call tce_residual_t1(d_r1,k_t1_offset,r1)
117          call tce_residual_t2(d_r2,k_t2_offset,r2)
118          call tce_residual_t3(d_r3,k_t3_offset,r3)
119          residual = max(r1,r2,r3)
120          call get_block(d_e,corr,1,0)
121          cpu=cpu+util_cpusec()
122          wall=wall+util_wallsec()
123          if (nodezero) write(LuOut,9100) iter,residual,corr,cpu,wall
124          if (residual .lt. thresh) then
125            if (nodezero) then
126              write(LuOut,9060)
127              write(LuOut,9070) "CCSDT",corr
128              write(LuOut,9080) "CCSDT",ref + corr
129            endif
130            call deletefile(d_r3)
131            call deletefile(d_r2)
132            call deletefile(d_r1)
133            call deletefile(d_e)
134            call tce_diis_tidy()
135            if (.not.ma_pop_stack(l_e_offset))
136     1        call errquit("tce_ccsdt_driver: MA problem",
137     2                     l_e_offset,MA_ERR)
138            tce_ccsdt_driver=.true.
139            return
140          endif
141          call tce_diis(.false.,iter,.true.,.true.,diis_t3,.false.,
142     1                  d_r1,d_t1,k_t1_offset,size_t1,
143     2                  d_r2,d_t2,k_t2_offset,size_t2,
144     3                  d_r3,d_t3,k_t3_offset,size_t3,
145     4                  dummy,dummy,dummy,dummy)
146          call deletefile(d_r3)
147          call deletefile(d_r2)
148          call deletefile(d_r1)
149          call deletefile(d_e)
150          if (nodezero) call util_flush(LuOut)
151      enddo
152      call tce_diis_tidy()
153      if (.not.ma_pop_stack(l_e_offset))
154     1     call errquit("tce_ccsdt_driver: MA problem",
155     2                  l_e_offset,MA_ERR)
156      tce_ccsdt_driver=.false.
157      return
158c
159c     ======
160c     Format
161c     ======
162c
163 9000 format(1x,A,' file size   = ',i16)
164 9010 format(1x,A,' file name   = ',A)
165 9090 format(1x,A,' file handle = ',i10)
166 9020 format(1x,'Cpu & wall time / sec',2f15.1)
167 9480 format(1x,'Cpu & wall time / sec for ',A,2f15.1)
168 9050 format(/,1x,A,' iterations',/,
169     1  1x,'--------------------------------------------------------',/
170     2  1x,'Iter          Residuum       Correlation     Cpu    Wall',/
171     3  1x,'--------------------------------------------------------')
172 9060 format(
173     1  1x,'--------------------------------------------------------',/
174     2  1x,'Iterations converged')
175 9070 format(1x,A,' correlation energy / hartree = ',f25.15)
176 9080 format(1x,A,' total energy / hartree       = ',f25.15)
177 9100 format(1x,i4,2f18.13,2f8.1)
178 9120 format(1x,A)
179 9250 format(1x,'Ground-state symmetry is ',A4)
180 9210 format(/,1x,'Iteration ',i3,' using ',i4,' trial vectors')
181 9230 format(1x,f17.13,f18.13,f11.5,2f8.1)
182 9240 format(1x,
183     1'--------------------------------------------------------------'
184     2,/,1x,'Iterations converged')
185 9310 format(1x,A,' ground state energy / hartree  =',f25.15)
186 9420 format(1x,i4,f18.13,2f8.1)
187 9440 format(1x,A3,' axis ( ',A4,'symmetry)')
188      end
189