Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 : MODULE m_fleur_init
7 : #ifdef CPP_MPI
8 : use mpi
9 : #endif
10 : IMPLICIT NONE
11 : CONTAINS
12 14080 : SUBROUTINE fleur_init(fmpi, fi, sphhar, stars, nococonv, forcetheo, enpara, xcpot, results, wann, hybdat, mpdata, filename_add)
13 : USE m_types
14 : USE m_test_performance
15 : use m_store_load_hybrid
16 : USE m_fleurinput_read_xml
17 : USE m_fleurinput_mpi_bc
18 : USE m_types_mpinp
19 : USE m_judft
20 : USE m_juDFT_init
21 : USE m_init_wannier_defaults
22 : USE m_dwigner
23 : USE m_ylm
24 : !USE m_InitParallelProcesses
25 : USE m_xmlOutput
26 : USE m_constants
27 : USE m_writeOutParameters
28 : USE m_setupMPI
29 : USE m_cdn_io
30 : USE m_fleur_info
31 : USE m_mixing_history
32 : USE m_checks
33 : USE m_writeOutHeader
34 : !USE m_fleur_init_old
35 : USE m_types_xcpot_inbuild
36 : USE m_make_stars
37 : USE m_make_sphhar
38 : USE m_convn
39 : USE m_efield
40 : USE m_fleurinput_postprocess
41 : USE m_make_forcetheo
42 : USE m_lapwdim
43 : use m_make_xcpot
44 : USE m_gaunt, ONLY: gaunt_init
45 : #ifdef CPP_HDF
46 : USE m_hdf_tools
47 : #endif
48 : IMPLICIT NONE
49 : ! Types, these variables contain a lot of data!
50 :
51 : TYPE(t_mpi), INTENT(INOUT):: fmpi
52 : type(t_fleurinput), intent(out) :: fi
53 : TYPE(t_sphhar), INTENT(OUT):: sphhar
54 : TYPE(t_stars), INTENT(OUT):: stars
55 : TYPE(t_enpara), INTENT(OUT):: enpara
56 : CLASS(t_xcpot), ALLOCATABLE, INTENT(OUT):: xcpot
57 : TYPE(t_results), INTENT(OUT):: results
58 : TYPE(t_wann), INTENT(OUT):: wann
59 : CLASS(t_forcetheo), ALLOCATABLE, INTENT(OUT)::forcetheo
60 : TYPE(t_nococonv), INTENT(OUT) :: nococonv
61 : type(t_hybdat), intent(out) :: hybdat
62 : type(t_mpdata), intent(out):: mpdata
63 :
64 : CHARACTER(len=100), OPTIONAL, INTENT(IN) :: filename_add
65 :
66 160 : TYPE(t_enparaXML)::enparaXML
67 160 : TYPE(t_forcetheo_data)::forcetheo_data
68 :
69 160 : TYPE(t_kpts), ALLOCATABLE :: kptsArray(:)
70 : INTEGER, ALLOCATABLE :: xmlElectronStates(:, :)
71 : INTEGER, ALLOCATABLE :: atomTypeSpecies(:)
72 : INTEGER, ALLOCATABLE :: speciesRepAtomType(:)
73 : REAL, ALLOCATABLE :: xmlCoreOccs(:, :, :)
74 : LOGICAL, ALLOCATABLE :: xmlPrintCoreStates(:, :)
75 : ! .. Local Scalars ..
76 : INTEGER :: i, n, l, m1, m2, isym, iisym, numSpecies, pc, iAtom, iType, minneigd, outxmlFileID
77 : INTEGER :: nbasfcn
78 : COMPLEX :: cdum
79 : CHARACTER(len=4) :: namex
80 : CHARACTER(len=12) :: relcor, tempNumberString
81 : CHARACTER(LEN=20) :: filename, tempFilename
82 : CHARACTER(len=100) :: filename_add_loc
83 : CHARACTER(LEN=40) :: kptsSelection(3)
84 : CHARACTER(LEN=300) :: line
85 : REAL :: a1(3), a2(3), a3(3)
86 : REAL :: dtild, phi_add
87 : LOGICAL :: l_found, l_kpts, l_exist, l_krla, l_timeReversalCheck
88 :
89 : #ifdef CPP_MPI
90 : INTEGER ierr(3)
91 160 : CALL MPI_COMM_RANK(fmpi%mpi_comm, fmpi%irank, ierr(1))
92 160 : CALL MPI_COMM_SIZE(fmpi%mpi_comm, fmpi%isize, ierr(1))
93 : #else
94 : fmpi%irank = 0; fmpi%isize = 1; fmpi%mpi_comm = 1
95 : #endif
96 160 : CALL check_command_line(fmpi)
97 : #ifdef CPP_HDF
98 160 : CALL hdf_init()
99 : #endif
100 160 : IF (fmpi%irank .EQ. 0) THEN
101 80 : filename_add_loc = ""
102 80 : IF (PRESENT(filename_add)) filename_add_loc = filename_add
103 80 : INQUIRE(file=TRIM(filename_add_loc)//"out.xml", exist=l_exist)
104 80 : IF (l_exist) THEN
105 80 : tempFilename = "outHistError.xml"
106 96 : DO i = 1, 999
107 96 : WRITE (tempFilename,'(a,i3.3,a)') 'out-', i, '.xml'
108 96 : INQUIRE(file=TRIM(ADJUSTL(tempFilename)), exist=l_found)
109 96 : IF (.NOT.l_found) EXIT
110 : END DO
111 80 : IF(.NOT.l_found) THEN
112 80 : WRITE(line,'(2a)') 'mv out.xml ', TRIM(ADJUSTL(tempFilename))
113 80 : CALL system(TRIM(ADJUSTL(line)))
114 : !WRITE (*,*) 'Moving old out.xml to ', TRIM(ADJUSTL(tempFilename)), '.'
115 : ELSE
116 0 : CALL juDFT_warn("No free out-???.xml file places for storing old out.xml files!")
117 : END IF
118 : END IF
119 80 : CALL startFleur_XMLOutput(filename_add_loc)
120 80 : outxmlFileID = getXMLOutputUnitNumber()
121 80 : IF (judft_was_argument("-info")) THEN
122 0 : CLOSE (oUnit)
123 0 : OPEN (oUnit, status='SCRATCH')
124 : ELSE
125 80 : inquire (file="out.history", exist=l_exist)
126 80 : inquire (file="out", exist=l_found)
127 80 : if (l_exist .and. l_found) THEN
128 0 : open (666, file="out.history", access="append", status="old")
129 0 : open (667, file="out", status="old")
130 : do
131 0 : read (667, '(a)', end=999) line
132 0 : write (666, '(a)') line
133 : end do
134 0 : 999 close (667)
135 0 : close (666)
136 : end if
137 80 : IF (.NOT. judft_was_argument("-no_out")) &
138 80 : OPEN (oUnit, file='out', form='formatted', status='unknown')
139 : END IF
140 80 : CALL writeOutHeader()
141 : !this should be removed, it deletes output of old inf file
142 80 : OPEN (16, status='SCRATCH')
143 : END IF
144 :
145 160 : ALLOCATE (t_xcpot_inbuild::xcpot)
146 : !Only PE==0 reads the fi%input and does basic postprocessing
147 160 : IF (fmpi%irank .EQ. 0) THEN
148 : CALL fleurinput_read_xml(outxmlFileID, filename_add_loc, cell=fi%cell, sym=fi%sym, atoms=fi%atoms, input=fi%input, noco=fi%noco, vacuum=fi%vacuum, field=fi%field, &
149 : sliceplot=fi%sliceplot, banddos=fi%banddos, mpinp=fi%mpinp, hybinp=fi%hybinp, coreSpecInput=fi%coreSpecInput, &
150 : wann=wann, xcpot=xcpot, forcetheo_data=forcetheo_data, kpts=fi%kpts, kptsSelection=kptsSelection, kptsArray=kptsArray, &
151 80 : enparaXML=enparaXML, gfinp=fi%gfinp, hub1inp=fi%hub1inp, juPhon=fi%juPhon)
152 : CALL fleurinput_postprocess(fi%cell, fi%sym, fi%atoms, fi%input, fi%noco, fi%vacuum, &
153 80 : fi%banddos, fi%hybinp, Xcpot, fi%kpts, fi%gfinp)
154 : END IF
155 : !Distribute fi%input to all PE
156 : CALL fleurinput_mpi_bc(fi%cell, fi%sym, fi%atoms, fi%input, fi%noco, fi%vacuum, fi%field, &
157 : fi%sliceplot, fi%banddos, fi%mpinp, fi%hybinp, fi%coreSpecInput, Wann, &
158 160 : Xcpot, Forcetheo_data, fi%kpts, Enparaxml, fi%gfinp, fi%hub1inp, fmpi%Mpi_comm, fi%juPhon)
159 : !Remaining init is done using all PE
160 160 : call make_xcpot(fmpi, xcpot, fi%atoms, fi%input)
161 160 : CALL nococonv%init(fi%noco)
162 160 : CALL nococonv%init_ss(fi%noco, fi%atoms)
163 : !CALL ylmnorm_init(MAX(fi%atoms%lmaxd, 2*fi%hybinp%lexp))
164 160 : CALL gaunt_init(fi%atoms%lmaxd + 1)
165 160 : CALL enpara%init_enpara(fi%atoms, fi%input%jspins, fi%input%film, enparaXML)
166 160 : CALL make_sphhar(fmpi%irank == 0, fi%atoms, sphhar, fi%sym, fi%cell)
167 : ! Store structure data (has to be performed before calling make_stars)
168 160 : CALL storeStructureIfNew(fi%input, stars, fi%atoms, fi%cell, fi%vacuum, fi%sym, fmpi, sphhar, fi%noco)
169 160 : CALL make_stars(stars, fi%sym, fi%atoms, fi%vacuum, sphhar, fi%input, fi%cell, fi%noco, fmpi)
170 160 : CALL make_forcetheo(forcetheo_data, fi%cell, fi%sym, fi%atoms, forcetheo)
171 160 : CALL lapw_dim(fi%kpts, fi%cell, fi%input, fi%noco, nococonv, forcetheo, fi%atoms, nbasfcn, fi%juPhon)
172 160 : CALL fi%input%init(fi%noco, fi%hybinp%l_hybrid,fi%sym%invs,fi%atoms%n_denmat,fi%atoms%n_hia,lapw_dim_nbasfcn)
173 160 : CALL fi%hybinp%init(fi%atoms, fi%cell, fi%input, fi%sym, xcpot)
174 160 : l_timeReversalCheck = .FALSE.
175 160 : IF(.NOT.fi%banddos%band.AND..NOT.fi%banddos%dos) THEN
176 150 : IF(fi%noco%l_soc.OR.fi%noco%l_ss) l_timeReversalCheck = .TRUE.
177 : END IF
178 166 : CALL fi%kpts%init(fi%sym, fi%input%film, fi%hybinp%l_hybrid .or. fi%input%l_rdmft, l_timeReversalCheck)
179 194 : CALL fi%kpts%initTetra(fi%input, fi%cell, fi%sym, fi%noco%l_soc .OR. fi%noco%l_ss)
180 160 : IF (fmpi%irank == 0) CALL fi%gfinp%init(fi%atoms, fi%sym, fi%noco, fi%cell, fi%input)
181 160 : CALL fi%gfinp%mpi_bc(fmpi%mpi_comm) !THis has to be rebroadcasted because there could be new gf elements after init_gfinp
182 160 : CALL convn(fmpi%irank == 0, fi%atoms, stars)
183 160 : IF (fmpi%irank == 0) CALL e_field(fi%atoms, stars, fi%sym, fi%vacuum, fi%cell, fi%input, fi%field%efield)
184 160 : IF (fmpi%isize > 1) CALL fi%field%mpi_bc(fmpi%mpi_comm, 0)
185 :
186 : !At some point this should be enabled for fi%noco as well
187 160 : IF (.NOT. fi%noco%l_noco) &
188 108 : CALL transform_by_moving_atoms(fmpi, stars,fi%atoms, fi%vacuum, fi%cell, fi%sym, sphhar, fi%input, fi%noco, nococonv)
189 :
190 : !
191 : !--> determine more dimensions
192 : !
193 :
194 160 : IF (fmpi%irank .EQ. 0) THEN
195 : CALL writeOutParameters(fmpi, fi%input, fi%sym, stars, fi%atoms, fi%vacuum, fi%kpts, &
196 : fi%hybinp, fi%cell, fi%banddos, fi%sliceplot, xcpot, &
197 80 : fi%noco, enpara, sphhar)
198 80 : CALL fleur_info(fi%kpts)
199 80 : CALL deleteDensities()
200 : END IF
201 :
202 : !Finalize the fmpi setup
203 160 : CALL setupMPI(fi%kpts%nkpt, fi%input%neig, nbasfcn, fmpi)
204 :
205 : !Collect some usage info
206 160 : CALL add_usage_data("A-Types", fi%atoms%ntype)
207 160 : CALL add_usage_data("fi%atoms", fi%atoms%nat)
208 160 : CALL add_usage_data("Real", fi%input%l_real)
209 160 : CALL add_usage_data("Spins", fi%input%jspins)
210 160 : CALL add_usage_data("Noco", fi%noco%l_noco)
211 160 : CALL add_usage_data("SOC", fi%noco%l_soc)
212 160 : CALL add_usage_data("SpinSpiral", fi%noco%l_ss)
213 160 : CALL add_usage_data("PlaneWaves", lapw_dim_nvd)
214 160 : CALL add_usage_data("LOs", fi%atoms%nlotot)
215 160 : CALL add_usage_data("nkpt", fi%kpts%nkpt)
216 :
217 : #ifdef CPP_GPU
218 : CALL add_usage_data("gpu_per_node", 1)
219 : #else
220 160 : CALL add_usage_data("gpu_per_node", 0)
221 : #endif
222 :
223 160 : CALL results%init(fi%input, fi%atoms, fi%kpts, fi%noco)
224 :
225 160 : IF (fmpi%irank .EQ. 0) THEN
226 80 : IF (fi%input%gw .NE. 0) CALL mixing_history_reset(fmpi)
227 80 : CALL setStartingDensity(fi%noco%l_noco)
228 : END IF
229 :
230 160 : if(fi%hybinp%l_hybrid) call load_hybrid_data(fi, fmpi, hybdat, mpdata)
231 :
232 : !new check mode will only run the init-part of FLEUR
233 160 : IF (judft_was_argument("-check")) THEN
234 0 : call test_performance()
235 0 : CALL judft_end("Check-mode done", fmpi%irank)
236 : endif
237 : #ifdef CPP_MPI
238 242 : CALL MPI_BARRIER(fmpi%mpi_comm, ierr(1))
239 : #endif
240 : CONTAINS
241 : SUBROUTINE init_wannier()
242 : ! Initializations for Wannier functions (start)
243 : IF (fmpi%irank .EQ. 0) THEN
244 : wann%l_gwf = wann%l_ms .OR. wann%l_sgwf .OR. wann%l_socgwf
245 :
246 : IF (wann%l_gwf) THEN
247 : WRITE (*, *) 'running HDWF-extension of FLEUR code'
248 : WRITE (*, *) 'with l_sgwf =', wann%l_sgwf, ' and l_socgwf =', wann%l_socgwf
249 :
250 : IF (wann%l_socgwf .AND. .NOT. fi%noco%l_soc) THEN
251 : CALL juDFT_error("set l_soc=T if l_socgwf=T", calledby="fleur_init")
252 : END IF
253 :
254 : IF ((wann%l_ms .OR. wann%l_sgwf) .AND. .NOT. (fi%noco%l_noco .AND. fi%noco%l_ss)) THEN
255 : CALL juDFT_error("set l_noco=l_ss=T for l_sgwf.or.l_ms", calledby="fleur_init")
256 : END IF
257 :
258 : IF ((wann%l_ms .OR. wann%l_sgwf) .AND. wann%l_socgwf) THEN
259 : CALL juDFT_error("(l_ms.or.l_sgwf).and.l_socgwf", calledby="fleur_init")
260 : END IF
261 :
262 : INQUIRE (FILE=wann%param_file, EXIST=l_exist)
263 : IF (.NOT. l_exist) THEN
264 : CALL juDFT_error("where is param_file"//TRIM(wann%param_file)//"?", calledby="fleur_init")
265 : END IF
266 : OPEN (113, file=wann%param_file, status='old')
267 : READ (113, *) wann%nparampts, wann%scale_param
268 : CLOSE (113)
269 : ELSE
270 : wann%nparampts = 1
271 : wann%scale_param = 1.0
272 : END IF
273 : END IF
274 :
275 : ALLOCATE (wann%param_vec(3, wann%nparampts))
276 : ALLOCATE (wann%param_alpha(fi%atoms%ntype, wann%nparampts))
277 :
278 : IF (fmpi%irank .EQ. 0) THEN
279 : IF (wann%l_gwf) THEN
280 : OPEN (113, file=wann%param_file, status='old')
281 : READ (113, *)!header
282 : WRITE (oUnit, *) 'parameter points for HDWFs generation:'
283 : IF (wann%l_sgwf .OR. wann%l_ms) THEN
284 : WRITE (oUnit, *) ' q1 ', ' q2 ', ' q3'
285 : ELSE IF (wann%l_socgwf) THEN
286 : WRITE (oUnit, *) ' -- ', ' phi ', ' theta'
287 : END IF
288 :
289 : DO pc = 1, wann%nparampts
290 : READ (113, '(3(f14.10,1x))') wann%param_vec(1, pc), wann%param_vec(2, pc), wann%param_vec(3, pc)
291 : wann%param_vec(:, pc) = wann%param_vec(:, pc)/wann%scale_param
292 : WRITE (oUnit, '(3(f14.10,1x))') wann%param_vec(1, pc), wann%param_vec(2, pc), wann%param_vec(3, pc)
293 : IF (wann%l_sgwf .OR. wann%l_ms) THEN
294 : iAtom = 1
295 : DO iType = 1, fi%atoms%ntype
296 : phi_add = tpi_const*(wann%param_vec(1, pc)*fi%atoms%taual(1, iAtom) + &
297 : wann%param_vec(2, pc)*fi%atoms%taual(2, iAtom) + &
298 : wann%param_vec(3, pc)*fi%atoms%taual(3, iAtom))
299 : wann%param_alpha(iType, pc) = nococonv%alph(iType) + phi_add
300 : iAtom = iAtom + fi%atoms%neq(iType)
301 : END DO
302 : END IF
303 : END DO
304 :
305 : IF (ANY(wann%param_vec(1, :) .NE. wann%param_vec(1, 1))) wann%l_dim(1) = .TRUE.
306 : IF (ANY(wann%param_vec(2, :) .NE. wann%param_vec(2, 1))) wann%l_dim(2) = .TRUE.
307 : IF (ANY(wann%param_vec(3, :) .NE. wann%param_vec(3, 1))) wann%l_dim(3) = .TRUE.
308 :
309 : CLOSE (113)
310 :
311 : IF (wann%l_dim(1) .AND. wann%l_socgwf) THEN
312 : CALL juDFT_error("do not specify 1st component if l_socgwf", calledby="fleur_init")
313 : END IF
314 : END IF!(wann%l_gwf)
315 : END IF!(fmpi%irank.EQ.0)
316 :
317 : #ifdef CPP_MPI
318 : CALL MPI_BCAST(wann%param_vec, 3*wann%nparampts, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr(1))
319 : CALL MPI_BCAST(wann%param_alpha, fi%atoms%ntype*wann%nparampts, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr(1))
320 : CALL MPI_BCAST(wann%l_dim, 3, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr(1))
321 : #endif
322 :
323 : ! Initializations for Wannier functions (end)
324 : END SUBROUTINE init_wannier
325 : END SUBROUTINE fleur_init
326 : END MODULE m_fleur_init
|
