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