Line data Source code
1 : MODULE m_writeCFOutput
2 :
3 : USE m_types
4 : USE m_juDFT
5 : USE m_constants
6 : USE m_lattHarmsSphHarmsConv
7 : USE m_cfOutput_hdf
8 : USE m_vgen
9 : USE m_intgr
10 : USE m_mpi_bc_tool
11 :
12 : IMPLICIT NONE
13 :
14 : CONTAINS
15 :
16 2 : SUBROUTINE writeCFOutput(fi,stars,hybdat,sphhar,xcpot,EnergyDen,inDen,hub1data,nococonv,enpara,fmpi)
17 :
18 : TYPE(t_fleurinput), INTENT(IN) :: fi
19 : TYPE(t_stars), INTENT(IN) :: stars
20 : TYPE(t_hybdat), INTENT(IN) :: hybdat
21 : TYPE(t_sphhar), INTENT(IN) :: sphhar
22 : CLASS(t_xcpot), INTENT(IN) :: xcpot
23 : TYPE(t_potden), INTENT(IN) :: EnergyDen
24 : TYPE(t_potden), INTENT(IN) :: inDen
25 : TYPE(t_hub1data), INTENT(IN) :: hub1data
26 : TYPE(t_nococonv), INTENT(IN) :: nococonv
27 : TYPE(t_enpara), INTENT(IN) :: enpara
28 : TYPE(t_mpi), INTENT(IN) :: fmpi
29 :
30 : INTEGER, PARAMETER :: lcf = 3
31 : #ifdef CPP_HDF
32 : INTEGER(HID_T) :: cfFileID
33 : #endif
34 :
35 : INTEGER :: iType,l,m,lm,io_error,iGrid,ispin
36 : REAL :: n_0Norm
37 : COMPLEX, ALLOCATABLE :: vlm(:,:,:)
38 2 : REAL, ALLOCATABLE :: f(:,:,:),g(:,:,:),flo(:,:,:)
39 2 : REAL :: n_0(fi%atoms%jmtd)
40 :
41 : !Dummy variables to avoid accidental changes to them in vgen
42 2 : TYPE(t_results) :: results_dummy
43 8 : TYPE(t_nococonv) :: nococonv_dummy
44 2 : TYPE(t_atoms) :: atoms_dummy
45 :
46 : !Modified densities and potentials for crystalfield
47 2 : TYPE(t_potden) :: inDenCF
48 2 : TYPE(t_potden) :: vCF,vCoul,vx,vxc,exc
49 :
50 2 : CALL timestart("Crystal Field Output")
51 :
52 300038 : ALLOCATE(vlm(fi%atoms%jmtd,fi%atoms%lmaxd*(fi%atoms%lmaxd+2)+1,fi%input%jspins),source=cmplx_0)
53 :
54 : !POTDEN_TYPE_CRYSTALFIELD excludes the external potential in the coulomb potential
55 2 : CALL vCF%init(stars, fi%atoms, sphhar, fi%vacuum, fi%noco, fi%input%jspins, POTDEN_TYPE_POTTOT)
56 2 : CALL vCoul%init(stars, fi%atoms, sphhar, fi%vacuum, fi%noco, fi%input%jspins, POTDEN_TYPE_CRYSTALFIELD)
57 2 : CALL vx%init(stars, fi%atoms, sphhar, fi%vacuum, fi%noco, fi%input%jspins, POTDEN_TYPE_POTCOUL)
58 2 : CALL vxc%init(stars, fi%atoms, sphhar, fi%vacuum, fi%noco, fi%input%jspins, POTDEN_TYPE_POTTOT)
59 2 : CALL exc%init(stars, fi%atoms, sphhar, fi%vacuum, fi%noco, fi%input%jspins, POTDEN_TYPE_POTTOT)
60 :
61 2 : CALL results_dummy%init(fi%input,fi%atoms,fi%kpts,fi%noco)
62 :
63 33364 : ALLOCATE (f(fi%atoms%jmtd,2,0:fi%atoms%lmaxd),source=0.0)
64 33362 : ALLOCATE (g(fi%atoms%jmtd,2,0:fi%atoms%lmaxd),source=0.0)
65 7420 : ALLOCATE (flo(fi%atoms%jmtd,2,fi%atoms%nlod),source=0.0)
66 :
67 : #ifdef CPP_HDF
68 2 : IF(fmpi%irank==0) CALL opencfFile(cfFileID, fi%atoms, fi%cell, l_create = .TRUE.)
69 : #endif
70 12 : DO iType = 1, fi%atoms%ntype
71 :
72 10 : IF(fi%atoms%l_outputCFcdn(iType)) THEN
73 1852 : n_0 = 0.0
74 6 : DO ispin = 1, fi%input%jspins
75 3706 : n_0(:) = n_0(:) + hub1data%cdn_atomic(:,lcf,iType,ispin)
76 : ENDDO
77 2 : CALL intgr3(n_0,fi%atoms%rmsh(:,iType),fi%atoms%dx(iType),fi%atoms%jri(iType),n_0Norm)
78 1852 : n_0 = n_0/n_0Norm
79 :
80 2 : IF(fmpi%irank==0) THEN
81 : #ifdef CPP_HDF
82 1 : CALL writeCFcdn(cfFileID, fi%atoms, iType, n_0)
83 : #else
84 : !Stupid text output
85 : OPEN(unit=29,file='n4f.'//int2str(iType)//'.dat',status='replace',&
86 : action='write',iostat=io_error)
87 : IF(io_error/=0) CALL juDFT_error("IO error", calledby="writeCFOutput")
88 : DO iGrid = 1, fi%atoms%jri(iType)
89 : WRITE(29,'(2e20.8)') fi%atoms%rmsh(iGrid,iType), n_0(iGrid)
90 : ENDDO
91 : CLOSE(unit=29,iostat=io_error)
92 : IF(io_error/=0) CALL juDFT_error("IO error", calledby="writeCFOutput")
93 : #endif
94 : ENDIF
95 :
96 : ENDIF
97 :
98 12 : IF(fi%atoms%l_outputCFpot(iType)) THEN
99 : !Run vgen again to obtain the right potential (without external and 4f)
100 2 : inDenCF = inDen
101 12 : atoms_dummy = fi%atoms
102 :
103 2 : IF(fi%atoms%l_outputCFcdn(iType).AND.fi%atoms%l_outputCFremove4f(iType)) THEN
104 : !Remove atomic 4f density before vgen
105 6 : DO ispin = 1, fi%input%jspins
106 3706 : inDenCF%mt(:,0,iType,ispin) = inDenCF%mt(:,0,iType,ispin) - hub1data%cdn_atomic(:,lcf,iType,ispin)
107 : ENDDO
108 : !Remove the same amount of protons from the core to keep everything charge neutral for vgen
109 2 : atoms_dummy%zatom(iType) = atoms_dummy%zatom(iType) - n_0Norm*sfp_const*atoms_dummy%neq(iType)
110 : ENDIF
111 :
112 2 : nococonv_dummy = nococonv
113 : CALL vgen(hybdat, fi%field, fi%input, xcpot, atoms_dummy, sphhar, stars, fi%vacuum, fi%sym, &
114 : fi%juphon, fi%cell, fi%sliceplot, fmpi, results_dummy, fi%noco, nococonv_dummy,&
115 2 : EnergyDen, inDenCF, vCF, vx, vCoul, vxc, exc)
116 :
117 :
118 2 : IF(fmpi%irank==0) THEN
119 : ! sigma
120 : !Decompose potential into V(r)
121 : ! lm
122 150015 : vlm = cmplx_0
123 3 : DO ispin = 1, fi%input%jspins
124 3 : CALL lattHarmsRepToSphHarms(fi%sym, fi%atoms, sphhar, iType, vCF%mt(:,0:,iType,ispin), vlm(:,:,ispin))
125 : ENDDO
126 :
127 : !Missing: only write out relevant components
128 : #ifdef CPP_HDF
129 1 : CALL writeCFpot(cfFileID, fi%atoms, fi%input, iType, vlm)
130 : #else
131 : !Stupid text output
132 : DO l = 2, 6, 2
133 : DO m = -l, l
134 : lm = l*(l+1) + m + 1
135 : OPEN(unit=29,file='V_'//int2str(l)//int2str(m)//'.'//int2str(iType)//'.dat',status='replace',&
136 : action='write',iostat=io_error)
137 : IF(io_error/=0) CALL juDFT_error("IO error", calledby="writeCFOutput")
138 : DO iGrid = 1, fi%atoms%jri(iType)
139 : WRITE(29,'(5e20.8)') fi%atoms%rmsh(iGrid,iType), vlm(iGrid,lm,1), vlm(iGrid,lm,fi%input%jspins)
140 : ENDDO
141 : CLOSE(unit=29,iostat=io_error)
142 : IF(io_error/=0) CALL juDFT_error("IO error", calledby="writeCFOutput")
143 : ENDDO
144 : ENDDO
145 : #endif
146 : ENDIF
147 : ENDIF
148 :
149 : ENDDO
150 :
151 : #ifdef CPP_HDF
152 2 : IF(fmpi%irank==0) CALL closecfFile(cfFileID)
153 : #endif
154 2 : CALL timestop("Crystal Field Output")
155 :
156 12 : END SUBROUTINE writeCFOutput
157 :
158 : END MODULE m_writeCFOutput
|
