1      Subroutine read_vect(rho, vect1, nq, ipol, isp)
2      implicit none
3      integer n, nq, ipol, isp
4      double precision rho(nq,ipol*(ipol+1)/2), vect1(nq)
5      do n = 1,nq
6        if (isp.eq.1) then
7          vect1(n) = rho(n,2)
8        else
9          vect1(n) = rho(n,3)
10        end if
11      end do
12      return
13      end
14
15      Subroutine read_delrho(delrho, delrho_sig, nq, ipol, isp)
16      implicit none
17      integer n, nq, ipol, isp
18      double precision delrho(nq,3,ipol), delrho_sig(nq,3)
19      do n = 1,nq
20        delrho_sig(n,1) = delrho(n,1,isp)
21        delrho_sig(n,2) = delrho(n,2,isp)
22        delrho_sig(n,3) = delrho(n,3,isp)
23      end do
24      return
25      end
26
27      Subroutine part_rho_rel(tol_rho, nq, Amat, Cmat, rho, vect1,
28     &                        ipol, occup_i, del_rho, delrho_sig,
29     &                        isp, aux_ik)
30      implicit none
31      integer n, nq, ipol, isp, aux_ik
32      double precision tol_rho, occup_i, compx, compy, compz,
33     &                 Amat(nq,ipol), vect1(nq), Cmat(nq,3,ipol),
34     &                 rho(nq,ipol*(ipol+1)/2),
35     &                 del_rho(nq,3,ipol), delrho_sig(nq,3),
36     &                 relation, rhosig
37      do n = 1,nq
38        rhosig = vect1(n)
39        if (rhosig.gt.tol_rho) then
40          relation = occup_i*rho(n,2)/rhosig
41          compx = occup_i*del_rho(n,1,1)/rhosig -
42     &                     rho(n,2)*delrho_sig(n,1)/(rhosig*rhosig)
43          compy = occup_i*del_rho(n,2,1)/rhosig -
44     &                     rho(n,2)*delrho_sig(n,2)/(rhosig*rhosig)
45          compz = occup_i*del_rho(n,3,1)/rhosig -
46     &                     rho(n,2)*delrho_sig(n,3)/(rhosig*rhosig)
47        else
48          if (aux_ik.eq.1) then
49            relation = 1.0d00
50          else
51            relation = 0.d00
52          end if
53          compx = 0.0d00
54          compy = 0.0d00
55          compz = 0.0d00
56        end if
57        compx = compx*Cmat(n,1,1)
58        compy = compy*Cmat(n,2,1)
59        compz = compz*Cmat(n,3,1)
60        Amat(n,1) = Amat(n,1)*relation + compx + compy + compz
61        Amat(n,2) = Amat(n,2)*relation
62        Cmat(n,1,1) = Cmat(n,1,1)*relation
63        Cmat(n,2,1) = Cmat(n,2,1)*relation
64        Cmat(n,3,1) = Cmat(n,3,1)*relation
65        Cmat(n,1,2) = 0.0d00
66        Cmat(n,2,2) = 0.0d00
67        Cmat(n,3,2) = 0.0d00
68      end do
69      return
70      end
71
72      Subroutine total_Amat( nq, ipol, Amat, Amat_coul, qwght)
73      implicit none
74      integer n, ipol, nq
75      double precision Amat(nq,ipol), Amat_coul(nq), qwght(nq)
76      do n = 1,nq
77        Amat(n,1) = Amat(n,1) - Amat_coul(n)*qwght(n)
78        Amat(n,2) = qwght(n)
79      end do
80      return
81      end
82c $Id$
83