Line data Source code
1 : MODULE m_greensfCalcScalarProducts
2 :
3 : USE m_types
4 : USE m_constants
5 : USE m_juDFT
6 : USE m_genMTBasis
7 :
8 : IMPLICIT NONE
9 :
10 : CONTAINS
11 :
12 122 : SUBROUTINE greensfCalcScalarProducts(gfinp,atoms,input,enpara,noco,sphhar,vTot,fmpi,hub1data,scalarProducts,greensFunctions,fout,gout,floout)
13 : !-----------------------------------------------------------
14 : ! Calculate the needed radial functions and scalar products
15 : !-----------------------------------------------------------
16 : TYPE(t_gfinp), INTENT(IN) :: gfinp
17 : TYPE(t_atoms), INTENT(IN) :: atoms
18 : TYPE(t_input), INTENT(IN) :: input
19 : TYPE(t_mpi), INTENT(IN) :: fmpi
20 : TYPE(t_potden), INTENT(IN) :: vTot
21 : TYPE(t_enpara), INTENT(IN) :: enpara
22 : TYPE(t_noco), INTENT(IN) :: noco
23 : TYPE(t_sphhar), INTENT(IN) :: sphhar
24 : TYPE(t_hub1data), OPTIONAL,INTENT(IN) :: hub1data
25 :
26 : TYPE(t_scalarGF), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: scalarProducts(:)
27 : TYPE(t_greensf), OPTIONAL, INTENT(INOUT) :: greensFunctions(:)
28 : REAL, OPTIONAL, ALLOCATABLE :: fout(:,:,:,:,:),gout(:,:,:,:,:), floout(:,:,:,:,:)
29 :
30 : INTEGER i_gf,l,lp,atomType,atomTypep,jspin,i,indUnique,ispin
31 : LOGICAL l_sphavg
32 :
33 122 : REAL, ALLOCATABLE :: f(:,:,:,:,:),g(:,:,:,:,:), flo(:,:,:,:,:)
34 :
35 122 : TYPE(t_usdus) :: usdus
36 122 : TYPE(t_denCoeffsOffDiag) :: denCoeffsOffDiag
37 122 : TYPE(t_scalarGF), ALLOCATABLE :: scalarGF(:)
38 :
39 122 : IF(.NOT.PRESENT(scalarProducts).AND..NOT.PRESENT(greensFunctions)) THEN
40 0 : CALL juDFT_error('Either list of scalarGF or greensf have to be provided', calledby='greensfCalcScalarProducts')
41 : ENDIF
42 :
43 122 : CALL timestart("Green's Function: Radial Functions")
44 4844304 : ALLOCATE (f(atoms%jmtd,2,0:atoms%lmaxd,input%jspins,atoms%nType),source=0.0)
45 4844182 : ALLOCATE (g(atoms%jmtd,2,0:atoms%lmaxd,input%jspins,atoms%nType),source=0.0)
46 1033212 : ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,input%jspins,atoms%nType),source=0.0)
47 :
48 : ! Initializations
49 122 : CALL usdus%init(atoms,input%jspins)
50 122 : CALL denCoeffsOffDiag%init(atoms,noco,sphhar,.FALSE.,.FALSE.)
51 :
52 3412 : ALLOCATE(scalarGF(gfinp%n))
53 : !Generate the scalar products we need
54 3168 : DO i_gf = 1, gfinp%n
55 3046 : l = gfinp%elem(i_gf)%l
56 3046 : lp = gfinp%elem(i_gf)%lp
57 3046 : atomType = gfinp%elem(i_gf)%atomType
58 3046 : atomTypep = gfinp%elem(i_gf)%atomTypep
59 3046 : CALL scalarGF(i_gf)%init(atoms,input)
60 :
61 3046 : IF(.NOT.gfinp%isUnique(i_gf)) THEN
62 2274 : indUnique = gfinp%getuniqueElement(i_gf)
63 2274 : scalarGF(i_gf) = scalarGF(indUnique)
64 2274 : CYCLE
65 : ENDIF
66 2316 : DO jspin = 1, input%jspins
67 : CALL genMTBasis(atoms,enpara,vTot,fmpi,atomType,jspin,usdus,&
68 : f(:,:,:,jspin,atomType),g(:,:,:,jspin,atomType),flo(:,:,:,jspin,atomType),&
69 1544 : hub1data=hub1data,l_writeArg=.FALSE.)
70 2316 : IF(atomType/=atomTypep) THEN
71 : CALL genMTBasis(atoms,enpara,vTot,fmpi,atomTypep,jspin,usdus,&
72 : f(:,:,:,jspin,atomTypep),g(:,:,:,jspin,atomTypep),flo(:,:,:,jspin,atomTypep),&
73 384 : hub1data=hub1data,l_writeArg=.FALSE.)
74 : ENDIF
75 : ENDDO
76 894 : IF(gfinp%elem(i_gf)%isOffDiag()) THEN
77 : CALL scalarGF(i_gf)%addOffdScalarProduct(l,lp,atomType,atomTypep,gfinp%elem(i_gf)%isIntersite(),&
78 594 : gfinp%l_mperp,atoms,input,f,g,flo)
79 : ELSE
80 534 : DO ispin = 1, input%jspins
81 356 : scalarGF(i_gf)%uun(ispin,ispin) = 1.0
82 356 : scalarGF(i_gf)%dun(ispin,ispin) = 0.0
83 356 : scalarGF(i_gf)%udn(ispin,ispin) = 0.0
84 356 : scalarGF(i_gf)%ddn(ispin,ispin) = usdus%ddn(l,atomType,ispin)
85 :
86 1140 : scalarGF(i_gf)%uulon(:,ispin,ispin) = usdus%uulon(:,atomType,ispin)
87 1140 : scalarGF(i_gf)%uloun(:,ispin,ispin) = usdus%uulon(:,atomType,ispin)
88 1140 : scalarGF(i_gf)%dulon(:,ispin,ispin) = usdus%dulon(:,atomType,ispin)
89 1140 : scalarGF(i_gf)%ulodn(:,ispin,ispin) = usdus%dulon(:,atomType,ispin)
90 :
91 3150 : scalarGF(i_gf)%uloulopn(:,:,ispin,ispin) = usdus%uloulopn(:,:,atomType,ispin)
92 :
93 : ENDDO
94 178 : IF(gfinp%l_mperp) THEN
95 : CALL denCoeffsOffDiag%addRadFunScalarProducts(atoms,f(:,:,:,:,atomType),g(:,:,:,:,atomType),&
96 16 : flo(:,:,:,:,atomType),atomType)
97 16 : IF(atomType/=atomTypep) THEN
98 : CALL denCoeffsOffDiag%addRadFunScalarProducts(atoms,f(:,:,:,:,atomTypep),g(:,:,:,:,atomTypep),&
99 0 : flo(:,:,:,:,atomTypep),atomTypep)
100 : ENDIF
101 16 : scalarGF(i_gf)%uun(1,2) = denCoeffsOffDiag%uu21n(l,atomType)
102 16 : scalarGF(i_gf)%uun(2,1) = denCoeffsOffDiag%uu21n(l,atomType)
103 16 : scalarGF(i_gf)%dun(1,2) = denCoeffsOffDiag%du21n(l,atomType)
104 16 : scalarGF(i_gf)%dun(2,1) = denCoeffsOffDiag%du21n(l,atomType)
105 16 : scalarGF(i_gf)%udn(1,2) = denCoeffsOffDiag%ud21n(l,atomType)
106 16 : scalarGF(i_gf)%udn(2,1) = denCoeffsOffDiag%ud21n(l,atomType)
107 16 : scalarGF(i_gf)%ddn(1,2) = denCoeffsOffDiag%dd21n(l,atomType)
108 16 : scalarGF(i_gf)%ddn(2,1) = denCoeffsOffDiag%dd21n(l,atomType)
109 :
110 48 : scalarGF(i_gf)%uulon(:,1,2) = denCoeffsOffDiag%uulo21n(:,atomType)
111 48 : scalarGF(i_gf)%uulon(:,2,1) = denCoeffsOffDiag%uulo21n(:,atomType)
112 48 : scalarGF(i_gf)%uloun(:,1,2) = denCoeffsOffDiag%ulou21n(:,atomType)
113 48 : scalarGF(i_gf)%uloun(:,2,1) = denCoeffsOffDiag%ulou21n(:,atomType)
114 48 : scalarGF(i_gf)%dulon(:,1,2) = denCoeffsOffDiag%dulo21n(:,atomType)
115 48 : scalarGF(i_gf)%dulon(:,2,1) = denCoeffsOffDiag%dulo21n(:,atomType)
116 48 : scalarGF(i_gf)%ulodn(:,1,2) = denCoeffsOffDiag%ulod21n(:,atomType)
117 48 : scalarGF(i_gf)%ulodn(:,2,1) = denCoeffsOffDiag%ulod21n(:,atomType)
118 :
119 112 : scalarGF(i_gf)%uloulopn(:,:,1,2) = denCoeffsOffDiag%uloulop21n(:,:,atomType)
120 112 : scalarGF(i_gf)%uloulopn(:,:,2,1) = denCoeffsOffDiag%uloulop21n(:,:,atomType)
121 : ENDIF
122 : ENDIF
123 : ENDDO
124 :
125 122 : IF(PRESENT(greensFunctions)) THEN
126 1060 : DO i_gf = 1, gfinp%n
127 1060 : greensFunctions(i_gf)%scalarProducts = scalarGF(i_gf)
128 : ENDDO
129 : ENDIF
130 122 : IF(PRESENT(scalarProducts)) THEN
131 122 : CALL move_alloc(scalarGF, scalarProducts)
132 : ENDIF
133 :
134 122 : IF(PRESENT(fout)) CALL move_alloc(f,fout)
135 122 : IF(PRESENT(gout)) CALL move_alloc(g,gout)
136 122 : IF(PRESENT(floout)) CALL move_alloc(flo,floout)
137 :
138 122 : CALL timestop("Green's Function: Radial Functions")
139 :
140 122 : END SUBROUTINE greensfCalcScalarProducts
141 : END MODULE m_greensfCalcScalarProducts
|
