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