1      subroutine tce_create_t2(d_t2,l_t2_offset,k_t2_offset,size_t2,
2     &                         irrep,title,
3     &                         d_t1,k_t1_offset,size_t1,
4     &                         d_f1,k_f1_offset,size_1e,
5     &                         d_v2,k_v2_offset,size_2e,
6     &                         ref,needt1,ioalg,model)
7c
8c $Id$
9c
10c Written by Jeff Hammond, January 2008.
11c
12      implicit none
13#include "mafdecls.fh"
14#include "tcgmsg.fh"
15#include "global.fh"
16#include "bas.fh"
17#include "geom.fh"
18c#include "rtdb.fh"
19#include "util.fh"
20#include "msgids.fh"
21#include "stdio.fh"
22#include "errquit.fh"
23c#include "tce.fh"
24c#include "tce_main.fh"
25c#include "tce_prop.fh"
26c#include "tce_ints.fh"
27c#include "tce_amps.fh"
28c#include "tce_diis.fh"
29      logical needt1
30      integer ioalg
31      integer d_t1             ! SF handle for t1 amplitudes
32      integer l_t1_offset      ! Offset for t1 file
33      integer k_t1_offset      ! Offset for t1 file
34      integer size_t1          ! File size in doubles
35      integer d_t2             ! SF handle for t2 amplitudes
36      integer l_t2_offset      ! Offset for t2 file
37      integer k_t2_offset      ! Offset for t2 file
38      integer size_t2          ! File size in doubles
39      integer d_t3             ! SF handle for t3 amplitudes
40      integer l_t3_offset      ! Offset for t3 file
41      integer k_t3_offset      ! Offset for t3 file
42      integer size_t3          ! File size in doubles
43      integer d_t4             ! SF handle for t4 amplitudes
44      integer l_t4_offset      ! Offset for t4 file
45      integer k_t4_offset      ! Offset for t4 file
46      integer size_t4          ! File size in doubles
47      integer d_f1             ! SF handle for MO 1e integrals
48      integer l_f1_offset      ! Offset for 1e integral file
49      integer k_f1_offset      ! Offset for 1e integral file
50      integer size_1e          ! File size in doubles
51      integer d_v2             ! SF handle for MO 2e integrals
52      integer l_v2_offset      ! Offset for 2e integral file
53      integer k_v2_offset      ! Offset for 2e integral file
54      integer size_2e          ! File size in doubles
55      logical nodezero         ! True if node 0
56      double precision cpu     ! CPU sec counter
57      double precision wall    ! WALL sec counter
58      double precision ref     ! Ground state energy
59      double precision corr    ! Correlation energy
60      integer irrep
61      character*8 title
62      character*10 model
63      character*255 filename
64c
65      nodezero=(ga_nodeid().eq.0)
66      if (nodezero) write(LuOut,*) '============================='
67c
68      cpu = - util_cpusec()
69      call tce_filename(title,filename)
70      call tce_t2_offset_new(l_t2_offset,k_t2_offset,size_t2,irrep)
71#if defined(DEBUG_PRINT)
72        if(nodezero) write(LuOut,*) 'l_t2_offset = ',l_t2_offset
73#endif
74c ------------
75c      if(nodezero) then
76c       write(LuOut,*)'T2-number-of-boxes',int_mb(k_t2_offset)
77c       call util_flush(LuOut)
78c      end if
79c -------------
80      call createfile(filename,d_t2,size_t2)
81c     if(nodezero) then
82c       write(LuOut,*)'before tce_guess_t2'
83c       call util_flush(LuOut)
84c     end if
85      call tce_guess_t2(d_v2,k_v2_offset,d_t2,k_t2_offset)
86      call reconcilefile(d_t2,size_t2)
87c     if(nodezero) then
88c       write(LuOut,*)'after tce_guess_t2'
89c       call util_flush(LuOut)
90c     end if
91c starts for t1 amplitudes t1(in the second order of MBPT)
92c (only if ga option is used)
93ccccc      if(needt1.and.(model.eq.'ccsd')) then
94      if(needt1) then ! fix problem with CCSDT?
95        if(ioalg.eq.2) then
96          call t1mp2(d_f1,d_t1,d_t2,d_v2,k_f1_offset,k_t1_offset,
97     &    k_t2_offset,k_v2_offset)
98          call reconcilefile(d_t1,size_t1)
99          call tce_guess_t1(d_t1,k_t1_offset)
100          call reconcilefile(d_t1,size_t1)
101        end if
102      end if
103c -----
104      if (util_print('mbpt2',print_debug)) then
105        call tce_mbpt2(d_v2,k_v2_offset,d_t2,k_t2_offset,corr)
106        if (nodezero) then
107          write(LuOut,9030) corr
108          write(LuOut,9040) ref + corr
109        endif
110      endif
111      cpu = cpu + util_cpusec()
112      if (nodezero.and.util_print(title,print_default)) then
113c        write(LuOut,*)
114        write(LuOut,9000) title,size_t2
115        write(LuOut,9010) title,filename(1:120)
116#if defined(DEBUG_PRINT)
117        write(LuOut,9090) title,d_t2
118#endif
119c       write(LuOut,9020) cpu
120        call util_flush(LuOut)
121      endif
122c
123      return
124 9000 format(1x,A,' file size   = ',i16)
125 9010 format(1x,A,' file name   = ',A)
126 9020 format(1x,'Cpu & wall time / sec',2f15.1)
127 9030 format(/,1x,'MBPT(2) correlation energy / hartree = ',f25.15)
128 9040 format(1x,'MBPT(2) total energy / hartree       = ',f25.15)
129 9090 format(1x,A,' file handle = ',i10)
130      end
131