1 subroutine ccsdtq_left(d_f1,d_lr1,d_lr2,d_lr3,d_lr4, 2 1 d_t1,d_t2,d_t3,d_t4, 3 1 d_v2,d_lambda1,d_lambda2,d_lambda3,d_lambda4, 4 1 k_f1_offset, 5 1 k_l1_offset,k_l2_offset,k_l3_offset,k_l4_offset, 6 1 k_t1_offset,k_t2_offset,k_t3_offset,k_t4_offset, 7 1 k_v2_offset,size_l1,size_l2,size_l3,size_l4, 8 1 iter,nodezero,residual) 9 implicit none 10#include "global.fh" 11#include "mafdecls.fh" 12#include "util.fh" 13#include "errquit.fh" 14#include "stdio.fh" 15#include "tce.fh" 16#include "tce_main.fh" 17#include "tce_diis.fh" 18c 19 integer d_f1,k_f1_offset 20 integer d_v2,k_v2_offset 21c 22 integer d_lr1,d_lr2,d_lr3,d_lr4 23c 24 integer d_t1,k_t1_offset 25 integer d_t2,k_t2_offset 26 integer d_t3,k_t3_offset 27 integer d_t4,k_t4_offset 28c 29 integer d_lambda1,k_l1_offset 30 integer d_lambda2,k_l2_offset 31 integer d_lambda3,k_l3_offset 32 integer d_lambda4,k_l4_offset 33c 34 integer size_l1,size_l2,size_l3,size_l4 35 character*255 filename 36 double precision cpu, wall 37 logical nodezero 38c integer iter,dummy 39 integer dummy 40 double precision r1, r2, r3,r4,residual 41 double precision ddotfile 42 external ddotfile 43c 44 call tce_diis_init() 45 do iter=1,maxiter 46 cpu=-util_cpusec() 47 wall=-util_wallsec() 48 if (nodezero.and.(iter.eq.1)) 49 1 write(LuOut,9400) "CCSDTQ Lambda" 50 call tce_filename('lr1',filename) 51 call createfile(filename,d_lr1,size_l1) 52 call ccsdtq_lambda1(d_f1,d_lr1,d_t1,d_t2,d_t3,d_t4,d_v2, 53 1 d_lambda1,d_lambda2,d_lambda3,d_lambda4,k_f1_offset, 54 2 k_l1_offset,k_t1_offset,k_t2_offset,k_t3_offset, 55 3 k_t4_offset,k_v2_offset,k_l1_offset,k_l2_offset, 56 4 k_l3_offset,k_l4_offset) 57 call reconcilefile(d_lr1,size_l1) 58 call tce_filename('lr2',filename) 59 call createfile(filename,d_lr2,size_l2) 60 call ccsdtq_lambda2(d_f1,d_lr2,d_t1,d_t2,d_t3,d_t4,d_v2, 61 1 d_lambda1,d_lambda2,d_lambda3,d_lambda4,k_f1_offset, 62 2 k_l2_offset,k_t1_offset,k_t2_offset,k_t3_offset, 63 3 k_t4_offset,k_v2_offset,k_l1_offset,k_l2_offset, 64 4 k_l3_offset,k_l4_offset) 65 call reconcilefile(d_lr2,size_l2) 66 call tce_filename('lr3',filename) 67 call createfile(filename,d_lr3,size_l3) 68 call ccsdtq_lambda3(d_f1,d_lr3,d_t1,d_t2,d_t3,d_v2, 69 1 d_lambda1,d_lambda2,d_lambda3,d_lambda4,k_f1_offset, 70 2 k_l3_offset,k_t1_offset,k_t2_offset,k_t3_offset, 71 3 k_v2_offset,k_l1_offset,k_l2_offset, 72 4 k_l3_offset,k_l4_offset) 73 call reconcilefile(d_lr3,size_l3) 74 call tce_filename('lr4',filename) 75 call createfile(filename,d_lr4,size_l4) 76 call ccsdtq_lambda4(d_f1,d_lr4,d_t1,d_t2,d_v2, 77 1 d_lambda2,d_lambda3,d_lambda4,k_f1_offset, 78 2 k_l4_offset,k_t1_offset,k_t2_offset, 79 3 k_v2_offset,k_l2_offset,k_l3_offset,k_l4_offset) 80 call reconcilefile(d_lr4,size_l4) 81 r1 = ddotfile(d_lr1,d_lr1,size_l1) 82 r2 = ddotfile(d_lr2,d_lr2,size_l2) 83 r3 = ddotfile(d_lr3,d_lr3,size_l3) 84 r4 = ddotfile(d_lr4,d_lr4,size_l4) 85 residual = max(r1,r2,r3,r4) 86 cpu=cpu+util_cpusec() 87 wall=wall+util_wallsec() 88 if (nodezero) write(LuOut,9420) iter,residual,cpu,wall 89 if (residual .lt. thresh) then 90 if (nodezero) then 91 write(LuOut,9410) 92 endif 93 call deletefile(d_lr4) 94 call deletefile(d_lr3) 95 call deletefile(d_lr2) 96 call deletefile(d_lr1) 97 call tce_diis_tidy() 98 goto 2000 99 endif 100 call tce_diis(.true.,iter,.true.,.true.,.true.,.true., 101 1 d_lr1,d_lambda1,k_l1_offset,size_l1, 102 2 d_lr2,d_lambda2,k_l2_offset,size_l2, 103 3 d_lr3,d_lambda3,k_l3_offset,size_l3, 104 4 d_lr4,d_lambda4,k_l4_offset,size_l4) 105 call deletefile(d_lr4) 106 call deletefile(d_lr3) 107 call deletefile(d_lr2) 108 call deletefile(d_lr1) 109 if (nodezero) call util_flush(LuOut) 110 enddo 111 call errquit('ccsdtq_left: maxiter exceeded',iter,CALC_ERR) 112 2000 continue 113 9400 format(/,1x,A,' iterations',/, 114 1 1x,'--------------------------------------',/ 115 2 1x,'Iter Residuum Cpu Wall',/ 116 3 1x,'--------------------------------------') 117 9410 format( 118 1 1x,'--------------------------------------',/ 119 2 1x,'Iterations converged') 120 9420 format(1x,i4,f18.13,2f8.1) 121 end 122 123c $Id$ 124