1c$Id$ 2c*********************************************************************** 3c 4c subroutine hamwght 5c 6c Construct new Hamiltonian from weighted average of Hamiltonians 7c constructed in previous iterations. Used in conjunction with the 8c scferrv andd diis routines. 9c 10c H = w(n)*H(n) + w(n-1)*H(n-1) + w(n-2)*H(n-2) + . . . 11c 12c 13c*********************************************************************** 14c 15 subroutine diis_hamwgt_so(wght,mxhist,nhist,nbf,icall, 16 & g_fock,g_diis,g_tmp) 17 implicit none 18c 19 integer mxhist 20 integer nbf 21 integer g_fock(2) 22 integer g_diis(2) 23 integer g_tmp(2) 24 double precision wght(mxhist+1) 25c 26 Integer nhist, icall 27c 28#include "mafdecls.fh" 29c 30 integer ii,istep,jj 31 double precision anum 32 double precision xwght 33 integer irow,j 34c 35 irow(j) = mod(j-1,mxhist)+1 36 ii=irow(icall) 37 istep=(ii-1)*nbf 38 call ga_sync 39c 40 call ga_copy_patch('N', 41 * g_fock(1),1,nbf,1,nbf, 42 * g_diis(1),1,nbf,istep+1,istep+nbf) 43 call ga_copy_patch('N', 44 * g_fock(2),1,nbf,1,nbf, 45 * g_diis(2),1,nbf,istep+1,istep+nbf) 46c 47 if (nhist.eq.1) then 48 return 49 endif 50c 51c Construct new Hamiltonian from weighted sum of previous Hamiltonians. 52c 53 do jj = 1,nhist 54 xwght = wght(nhist-jj+2) 55 ii=irow(icall-jj+1) 56 istep=(ii-1)*nbf 57 anum=1.d0 58 if(jj.eq.1) anum=0.d0 59c write(*,*)"jj=", jj, xwght 60c call ga_print_patch(g_diis(1),1,nbf,istep+1,istep+nbf,1) 61 call ga_dadd_patch( 62 * xwght,g_diis(1),1,nbf,istep+1,istep+nbf, 63 * anum,g_fock(1),1,nbf,1,nbf, 64 * g_tmp(1),1,nbf,1,nbf) 65 call ga_copy(g_tmp(1),g_fock(1)) 66 call ga_dadd_patch( 67 * xwght,g_diis(2),1,nbf,istep+1,istep+nbf, 68 * anum,g_fock(2),1,nbf,1,nbf, 69 * g_tmp(2),1,nbf,1,nbf) 70 call ga_copy(g_tmp(2),g_fock(2)) 71 enddo 72 return 73 end 74 75 76 77 78