fleur_init.F90 23 KB
Newer Older
1 2 3 4 5
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
6 7 8
      MODULE m_fleur_init
      IMPLICIT NONE
      CONTAINS
9
        SUBROUTINE fleur_init(mpi,&
10
             input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
11
             sliceplot,banddos,obsolete,enpara,xcpot,results,kpts,hybrid,&
12
             oneD,coreSpecInput,wann,l_opti)
13
          USE m_types
14
          USE m_judft
15
          USE m_juDFT_init
16
          USE m_init_wannier_defaults
17
          USE m_rinpXML
Daniel Wortmann's avatar
Daniel Wortmann committed
18
          USE m_postprocessInput
19 20 21 22
          USE m_gen_map
          USE m_dwigner
          USE m_gen_bz
          USE m_ylm
23
          USE m_InitParallelProcesses
24
          USE m_checkInputParams
25
          USE m_xmlOutput
26
          USE m_constants
27
          USE m_winpXML
28
          USE m_writeOutParameters
Daniel Wortmann's avatar
Daniel Wortmann committed
29
          USE m_setupMPI
30
          USE m_cdn_io
31
          USE m_fleur_info
32
          USE m_mixing_history
33
          USE m_checks
34
          USE m_prpqfftmap
35
          USE m_writeOutHeader
36
          USE m_fleur_init_old
37
          USE m_types_xcpot_inbuild
38
          USE m_mpi_bc_xcpot
39
          USE m_wann_read_inp
Matthias Redies's avatar
Matthias Redies committed
40 41
          use m_gaunt, only: gaunt_init

42 43
#ifdef CPP_MPI
          USE m_mpi_bc_all,  ONLY : mpi_bc_all
44
#ifndef CPP_OLDINTEL
45
          USE m_mpi_dist_forcetheorem
Daniel Wortmann's avatar
Daniel Wortmann committed
46
#endif
47
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
48 49
#ifdef CPP_HDF
          USE m_hdf_tools
50 51 52 53 54
#endif
          IMPLICIT NONE
          !     Types, these variables contain a lot of data!
          TYPE(t_mpi)    ,INTENT(INOUT):: mpi
          TYPE(t_input)    ,INTENT(OUT):: input
55
          TYPE(t_field),    INTENT(OUT) :: field
Daniel Wortmann's avatar
Daniel Wortmann committed
56
          TYPE(t_dimension),INTENT(OUT):: DIMENSION
57 58 59 60 61 62 63 64 65
          TYPE(t_atoms)    ,INTENT(OUT):: atoms
          TYPE(t_sphhar)   ,INTENT(OUT):: sphhar
          TYPE(t_cell)     ,INTENT(OUT):: cell
          TYPE(t_stars)    ,INTENT(OUT):: stars
          TYPE(t_sym)      ,INTENT(OUT):: sym
          TYPE(t_noco)     ,INTENT(OUT):: noco
          TYPE(t_vacuum)   ,INTENT(OUT):: vacuum
          TYPE(t_sliceplot),INTENT(OUT):: sliceplot
          TYPE(t_banddos)  ,INTENT(OUT):: banddos
Matthias Redies's avatar
Matthias Redies committed
66
          TYPE(t_obsolete) ,INTENT(OUT):: obsolete
67
          TYPE(t_enpara)   ,INTENT(OUT):: enpara
68
          CLASS(t_xcpot),ALLOCATABLE,INTENT(OUT):: xcpot
69 70 71 72
          TYPE(t_results)  ,INTENT(OUT):: results
          TYPE(t_kpts)     ,INTENT(OUT):: kpts
          TYPE(t_hybrid)   ,INTENT(OUT):: hybrid
          TYPE(t_oneD)     ,INTENT(OUT):: oneD
73
          TYPE(t_coreSpecInput),INTENT(OUT) :: coreSpecInput
74
          TYPE(t_wann)     ,INTENT(OUT):: wann
75
          CLASS(t_forcetheo),ALLOCATABLE,INTENT(OUT)::forcetheo
76
          LOGICAL,          INTENT(OUT):: l_opti
77

78

79 80 81 82 83 84
          INTEGER, ALLOCATABLE          :: xmlElectronStates(:,:)
          INTEGER, ALLOCATABLE          :: atomTypeSpecies(:)
          INTEGER, ALLOCATABLE          :: speciesRepAtomType(:)
          REAL, ALLOCATABLE             :: xmlCoreOccs(:,:,:)
          LOGICAL, ALLOCATABLE          :: xmlPrintCoreStates(:,:)
          CHARACTER(len=3), ALLOCATABLE :: noel(:)
85
          !     .. Local Scalars ..
86
          INTEGER    :: i,n,l,m1,m2,isym,iisym,numSpecies,pc,iAtom,iType
87
          COMPLEX    :: cdum
88
          CHARACTER(len=4)              :: namex
Gregor Michalicek's avatar
Gregor Michalicek committed
89
          CHARACTER(len=12)             :: relcor
90
          CHARACTER(LEN=20)             :: filename
91
          REAL                          :: a1(3),a2(3),a3(3)
92
          REAL                          :: dtild, phi_add
Gregor Michalicek's avatar
Gregor Michalicek committed
93
          LOGICAL                       :: l_found, l_kpts, l_exist
94
          LOGICAL                       :: l_wann_inp
Matthias Redies's avatar
Matthias Redies committed
95

96 97 98 99 100 101 102 103
#ifdef CPP_MPI
          INCLUDE 'mpif.h'
          INTEGER ierr(3)
          CALL MPI_COMM_RANK (mpi%mpi_comm,mpi%irank,ierr)
          CALL MPI_COMM_SIZE (mpi%mpi_comm,mpi%isize,ierr)
#else
          mpi%irank=0 ; mpi%isize=1; mpi%mpi_comm=1
#endif
104 105 106 107 108
          !determine if we use an xml-input file
          INQUIRE (file='inp.xml',exist=input%l_inpXML)
          INQUIRE(file='inp',exist=l_found)
          IF (input%l_inpXML) THEN
             !xml found, we will use it, check if we also have a inp-file
109
             IF (l_found) CALL judft_warn("Both inp & inp.xml given.", calledby="fleur_init",hint="Please delete one of the input files")
110 111 112 113
          ELSE
             IF (.NOT.l_found) CALL judft_error("No input file found",calledby='fleur_init',hint="To use FLEUR, you have to provide either an 'inp' or an 'inp.xml' file in the working directory")
          END IF

114
          CALL check_command_line()
Daniel Wortmann's avatar
Daniel Wortmann committed
115
#ifdef CPP_HDF
116
          CALL hdf_init()
Daniel Wortmann's avatar
Daniel Wortmann committed
117
#endif
118
          !call juDFT_check_para()
119
          CALL field%init(input)
Frank Freimuth's avatar
Frank Freimuth committed
120
          input%eig66(1)=.FALSE.
121 122 123 124
          input%gw                = -1
          input%gw_neigd          =  0
          !-t3e
          IF (mpi%irank.EQ.0) THEN
125
             CALL startFleur_XMLOutput()
Daniel Wortmann's avatar
Daniel Wortmann committed
126
             IF (judft_was_argument("-info")) THEN
127
                  CLOSE(6)
Daniel Wortmann's avatar
Daniel Wortmann committed
128 129
                  OPEN (6,status='SCRATCH')
             ELSE
130
                  IF (.not.judft_was_argument("-no_out")) &
Daniel Wortmann's avatar
Daniel Wortmann committed
131 132
                  OPEN (6,file='out',form='formatted',status='unknown')
             ENDIF
133
             CALL writeOutHeader()
134
             !OPEN (16,status='SCRATCH')
135 136
          ENDIF

137 138
          input%l_rdmft = .FALSE.

139
          input%l_wann = .FALSE.
140 141
          CALL initWannierDefaults(wann)

142
          input%minDistance = 0.0
143 144
          input%ldauLinMix = .FALSE.
          input%ldauMixParam = 0.05
145
          input%ldauSpinf = 1.0
146
          input%pallst = .FALSE.
147 148 149 150
          input%scaleCell = 1.0
          input%scaleA1 = 1.0
          input%scaleA2 = 1.0
          input%scaleC = 1.0
151
          input%forcealpha = 1.0
152
          input%forcemix = 2 ! BFGS is default.
153 154
          input%epsdisp = 0.00001
          input%epsforce = 0.00001
155
          input%numBandsKPoints = -1
156

157
          kpts%ntet = 1
158
          kpts%numSpecialPoints = 1
159

160
          sliceplot%iplot=0
161 162 163 164 165
          sliceplot%kk = 0
          sliceplot%e1s = 0.0
          sliceplot%e2s = 0.0
          sliceplot%nnne = 0

166
          banddos%l_mcd = .FALSE.
167
          banddos%e_mcd_lo = -10.0
168
          banddos%e_mcd_up = 0.0
169

170
          banddos%unfoldband = .FALSE.
171 172 173
          banddos%s_cell_x = 1
          banddos%s_cell_y = 1
          banddos%s_cell_z = 1
174

175 176
          noco%l_mtNocoPot = .FALSE.

Matthias Redies's avatar
Matthias Redies committed
177
          IF (input%l_inpXML) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
178
             ALLOCATE(noel(1))
179
             IF (mpi%irank.EQ.0) THEN
180
                WRITE (6,*) 'XML code path used: Calculation parameters are stored in out.xml'
181
                ALLOCATE(kpts%specialPoints(3,kpts%numSpecialPoints))
Daniel Wortmann's avatar
Daniel Wortmann committed
182
                ALLOCATE(atomTypeSpecies(1),speciesRepAtomType(1))
183 184 185 186 187 188 189
                ALLOCATE(xmlElectronStates(1,1),xmlPrintCoreStates(1,1))
                ALLOCATE(xmlCoreOccs(1,1,1))
                namex = '    '
                relcor = '            '
                a1 = 0.0
                a2 = 0.0
                a3 = 0.0
Matthias Redies's avatar
Matthias Redies committed
190
                CALL timestart("r_inpXML")
191
                CALL r_inpXML(&
192
                     atoms,obsolete,vacuum,input,stars,sliceplot,banddos,DIMENSION,forcetheo,field,&
193
                     cell,sym,xcpot,noco,oneD,hybrid,kpts,enpara,coreSpecInput,wann,&
194
                     noel,namex,relcor,a1,a2,a3,dtild,xmlElectronStates,&
Daniel Wortmann's avatar
Daniel Wortmann committed
195
                     xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,&
196
                     l_kpts)
Matthias Redies's avatar
Matthias Redies committed
197
                CALL timestop("r_inpXML")
198
             END IF
199
             CALL mpi_bc_xcpot(xcpot,mpi)
200 201 202 203 204
#ifdef CPP_MPI
#ifndef CPP_OLDINTEL
             CALL mpi_dist_forcetheorem(mpi,forcetheo)
#endif
#endif
Matthias Redies's avatar
Matthias Redies committed
205 206

             CALL timestart("postprocessInput")
207
             CALL postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts,&
208
                                   oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,&
Gregor Michalicek's avatar
Gregor Michalicek committed
209
                                   noco,dimension,enpara,sphhar,l_opti,l_kpts)
Matthias Redies's avatar
Matthias Redies committed
210
             CALL timestop("postprocessInput")
211

212
             IF (mpi%irank.EQ.0) THEN
213
                filename = ''
214 215
                numSpecies = SIZE(speciesRepAtomType)
                CALL w_inpXML(&
216
                              atoms,obsolete,vacuum,input,stars,sliceplot,forcetheo,banddos,&
217
                              cell,sym,xcpot,noco,oneD,hybrid,kpts,kpts%nkpt3,kpts%l_gamma,&
218
                              noel,namex,relcor,a1,a2,a3,dtild,input%comment,&
219 220 221
                              xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
                              atomTypeSpecies,speciesRepAtomType,.TRUE.,filename,&
                             .TRUE.,numSpecies,enpara)
Daniel Wortmann's avatar
Daniel Wortmann committed
222 223

                DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
224
                DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
225
             END IF
226

Daniel Wortmann's avatar
Daniel Wortmann committed
227 228
             DEALLOCATE(noel)

229 230
#ifdef CPP_MPI
             CALL initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
231
                  DIMENSION,cell,sym,xcpot,noco,oneD,hybrid,&
232
                  kpts,enpara,sphhar,mpi,obsolete)
233

234 235
#endif

236
          ELSE ! else branch of "IF (input%l_inpXML) THEN"
237 238 239 240
             CALL fleur_init_old(mpi,&
                  input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
                  sliceplot,banddos,obsolete,enpara,xcpot,kpts,hybrid,&
                  oneD,coreSpecInput,l_opti)
241
          END IF ! end of else branch of "IF (input%l_inpXML) THEN"
242
          !
Matthias Redies's avatar
Matthias Redies committed
243

244
          IF (.NOT.mpi%irank==0) CALL enpara%init(atoms,input%jspins,.FALSE.)
Daniel Wortmann's avatar
Daniel Wortmann committed
245
                   !-odim
246 247
          oneD%odd%nq2 = oneD%odd%n2d
          oneD%odd%kimax2 = oneD%odd%nq2 - 1
248
          oneD%odd%nat = atoms%nat
249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268

          oneD%odi%d1 = oneD%odd%d1 ; oneD%odi%mb = oneD%odd%mb ; oneD%odi%M = oneD%odd%M
          oneD%odi%k3 = oneD%odd%k3 ; oneD%odi%chi = oneD%odd%chi ; oneD%odi%rot = oneD%odd%rot
          oneD%odi%invs = oneD%odd%invs ; oneD%odi%zrfs = oneD%odd%zrfs
          oneD%odi%n2d = oneD%odd%n2d ; oneD%odi%nq2 = oneD%odd%nq2 ; oneD%odi%nn2d = oneD%odd%nn2d
          oneD%odi%kimax2 = oneD%odd%kimax2 ; oneD%odi%m_cyl = oneD%odd%m_cyl
          oneD%odi%ig => oneD%ig1 ; oneD%odi%kv => oneD%kv1 ; oneD%odi%nst2 => oneD%nstr1

          oneD%ods%nop = oneD%odd%nop ; oneD%ods%nat = oneD%odd%nat
          oneD%ods%mrot => oneD%mrot1 ; oneD%ods%tau => oneD%tau1 ; oneD%ods%ngopr => oneD%ngopr1
          oneD%ods%invtab => oneD%invtab1 ; oneD%ods%multab => oneD%multab1

          oneD%odl%nn2d = oneD%odd%nn2d
          oneD%odl%igf => oneD%igfft1 ; oneD%odl%pgf => oneD%pgfft1

          oneD%odg%nn2d = oneD%odd%nn2d
          oneD%odg%pgfx => oneD%pgft1x ; oneD%odg%pgfy => oneD%pgft1y
          oneD%odg%pgfxx => oneD%pgft1xx ; oneD%odg%pgfyy => oneD%pgft1yy ; oneD%odg%pgfxy => oneD%pgft1xy
          !+odim
          !
269

270 271 272 273 274 275 276 277
#ifdef CPP_MPI
          CALL MPI_BCAST(l_opti,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(noco%l_noco,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(noco%l_soc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(input%strho ,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(input%jspins,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(atoms%n_u,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(atoms%lmaxd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
278
          call MPI_BCAST( input%preconditioning_param, 1, MPI_DOUBLE_PRECISION, 0, mpi%mpi_comm, ierr )
279
#endif
280
          CALL ylmnorm_init(max(atoms%lmaxd, 2*hybrid%lexp))
Matthias Redies's avatar
Matthias Redies committed
281
          CALL gaunt_init(max(atoms%lmaxd+1, 2*hybrid%lexp))
282

283 284 285
          !
          !--> determine more dimensions
          !
286
          atoms%nlotot = 0
287 288 289 290 291
          IF(mpi%irank.EQ.0) THEN
             DO n = 1, atoms%ntype
                DO l = 1,atoms%nlo(n)
                   atoms%nlotot = atoms%nlotot + atoms%neq(n) * ( 2*atoms%llo(l,n) + 1 )
                ENDDO
292
             ENDDO
293 294
             DIMENSION%nbasfcn = DIMENSION%nvd + atoms%nlotot
          END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
295 296
          DIMENSION%lmd     = atoms%lmaxd* (atoms%lmaxd+2)
          DIMENSION%lmplmd  = (DIMENSION%lmd* (DIMENSION%lmd+3))/2
297

298 299
          ALLOCATE (stars%igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
          ALLOCATE (stars%igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1))
300
#ifdef CPP_MPI
301 302
          CALL mpi_bc_all(mpi,stars,sphhar,atoms,obsolete,sym,kpts,DIMENSION,input,field,&
                          banddos,sliceplot,vacuum,cell,enpara,noco,oneD,hybrid)
303 304
#endif

Matthias Redies's avatar
Matthias Redies committed
305
          ! Set up pointer for backtransformation from g-vector in positive
306 307 308
          ! domain of carge density fftibox into stars
          CALL prp_qfft_map(stars,sym,input,stars%igq2_fft,stars%igq_fft)

309 310 311 312
          !-t3e
          !-odim
          oneD%odd%nq2 = oneD%odd%n2d
          oneD%odd%kimax2 = oneD%odd%nq2 - 1
313
          oneD%odd%nat = atoms%nat
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332

          oneD%odi%d1 = oneD%odd%d1 ; oneD%odi%mb = oneD%odd%mb ; oneD%odi%M = oneD%odd%M
          oneD%odi%k3 = oneD%odd%k3 ; oneD%odi%chi = oneD%odd%chi ; oneD%odi%rot = oneD%odd%rot
          oneD%odi%invs = oneD%odd%invs ; oneD%odi%zrfs = oneD%odd%zrfs
          oneD%odi%n2d = oneD%odd%n2d ; oneD%odi%nq2 = oneD%odd%nq2 ; oneD%odi%nn2d = oneD%odd%nn2d
          oneD%odi%kimax2 = oneD%odd%kimax2 ; oneD%odi%m_cyl = oneD%odd%m_cyl
          oneD%odi%ig => oneD%ig1 ; oneD%odi%kv => oneD%kv1 ; oneD%odi%nst2 => oneD%nstr1

          oneD%ods%nop = oneD%odd%nop ; oneD%ods%nat = oneD%odd%nat
          oneD%ods%mrot => oneD%mrot1 ; oneD%ods%tau => oneD%tau1 ; oneD%ods%ngopr => oneD%ngopr1
          oneD%ods%invtab => oneD%invtab1 ; oneD%ods%multab => oneD%multab1

          oneD%odl%nn2d = oneD%odd%nn2d
          oneD%odl%igf => oneD%igfft1 ; oneD%odl%pgf => oneD%pgfft1

          oneD%odg%nn2d = oneD%odd%nn2d
          oneD%odg%pgfx => oneD%pgft1x ; oneD%odg%pgfy => oneD%pgft1y
          oneD%odg%pgfxx => oneD%pgft1xx ; oneD%odg%pgfyy => oneD%pgft1yy ; oneD%odg%pgfxy => oneD%pgft1xy
          !+odim
Daniel Wortmann's avatar
Daniel Wortmann committed
333
          IF (noco%l_noco) DIMENSION%nbasfcn = 2*DIMENSION%nbasfcn
Matthias Redies's avatar
Matthias Redies committed
334

335 336 337 338 339 340 341 342
          IF( sym%invs .OR. noco%l_soc ) THEN
             sym%nsym = sym%nop
          ELSE
             ! combine time reversal symmetry with the spatial symmetry opera
             ! thus the symmetry operations are doubled
             sym%nsym = 2*sym%nop
          END IF

343
          CALL checkInputParams(mpi,input,dimension,atoms,sym,noco,xcpot,oneD,forcetheo)
344

345 346
          ! Initializations for Wannier functions (start)
          IF (mpi%irank.EQ.0) THEN
347
#ifdef CPP_WANN
348 349 350
             INQUIRE(FILE='plotbscomf',EXIST=wann%l_bs_comf)
             WRITE(*,*)'l_bs_comf=',wann%l_bs_comf
             WRITE(*,*) 'Logical variables for wannier functions to be read in!!'
351 352
#endif
             wann%l_gwf = wann%l_ms.OR.wann%l_sgwf.OR.wann%l_socgwf
353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419

             if(wann%l_gwf) then
                WRITE(*,*)'running HDWF-extension of FLEUR code'
                WRITE(*,*)'with l_sgwf =',wann%l_sgwf,' and l_socgwf =',wann%l_socgwf

                IF(wann%l_socgwf.AND. .NOT.noco%l_soc) THEN
                  CALL juDFT_error("set l_soc=T if l_socgwf=T",calledby="fleur_init")
                END IF

                IF((wann%l_ms.or.wann%l_sgwf).AND..NOT.(noco%l_noco.AND.noco%l_ss)) THEN
                   CALL juDFT_error("set l_noco=l_ss=T for l_sgwf.or.l_ms",calledby="fleur_init")
                END IF

                IF((wann%l_ms.or.wann%l_sgwf).and.wann%l_socgwf) THEN
                   CALL juDFT_error("(l_ms.or.l_sgwf).and.l_socgwf",calledby="fleur_init")
                END IF

                INQUIRE(FILE=wann%param_file,EXIST=l_exist)
                IF(.NOT.l_exist) THEN
                   CALL juDFT_error("where is param_file"//trim(wann%param_file)//"?",calledby="fleur_init")
                END IF
                OPEN (113,file=wann%param_file,status='old')
                READ (113,*) wann%nparampts,wann%scale_param
                CLOSE(113)
             ELSE
                wann%nparampts=1
                wann%scale_param=1.0
             END IF
          END IF

#ifdef CPP_MPI
          CALL MPI_BCAST(wann%l_bs_comf,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(wann%l_gwf,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(wann%nparampts,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(wann%scale_param,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)

          CALL MPI_BCAST(wann%l_sgwf,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
          CALL MPI_BCAST(wann%l_socgwf,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
          CALL MPI_BCAST(wann%l_ms,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
#endif

          ALLOCATE (wann%param_vec(3,wann%nparampts))
          ALLOCATE (wann%param_alpha(atoms%ntype,wann%nparampts))

          IF(mpi%irank.EQ.0) THEN
             IF(wann%l_gwf) THEN
                OPEN(113,file=wann%param_file,status='old')
                READ(113,*)!header
                write(6,*) 'parameter points for HDWFs generation:'
                IF(wann%l_sgwf.or.wann%l_ms) THEN
                   WRITE(6,*)'      q1       ','      q2       ','      q3'
                ELSE IF(wann%l_socgwf) THEN
                   WRITE(6,*)'      --       ','     phi       ','    theta'
                END IF

                DO pc = 1, wann%nparampts
                   READ(113,'(3(f14.10,1x))') wann%param_vec(1,pc), wann%param_vec(2,pc), wann%param_vec(3,pc)
                   wann%param_vec(:,pc) = wann%param_vec(:,pc) / wann%scale_param
                   WRITE(6,'(3(f14.10,1x))') wann%param_vec(1,pc), wann%param_vec(2,pc), wann%param_vec(3,pc)
                   IF(wann%l_sgwf.or.wann%l_ms) THEN
                      iAtom = 1
                      DO iType = 1, atoms%ntype
                         phi_add = tpi_const*(wann%param_vec(1,pc)*atoms%taual(1,iAtom) +&
                                              wann%param_vec(2,pc)*atoms%taual(2,iAtom) +&
                                              wann%param_vec(3,pc)*atoms%taual(3,iAtom))
                         wann%param_alpha(iType,pc) = noco%alph(iType) + phi_add
                         iAtom = iAtom + atoms%neq(iType)
Matthias Redies's avatar
Matthias Redies committed
420
                      END DO
421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442
                   END IF
                END DO

                IF(ANY(wann%param_vec(1,:).NE.wann%param_vec(1,1))) wann%l_dim(1)=.true.
                IF(ANY(wann%param_vec(2,:).NE.wann%param_vec(2,1))) wann%l_dim(2)=.true.
                IF(ANY(wann%param_vec(3,:).NE.wann%param_vec(3,1))) wann%l_dim(3)=.true.

                CLOSE(113)

                IF(wann%l_dim(1).and.wann%l_socgwf) THEN
                   CALL juDFT_error("do not specify 1st component if l_socgwf",calledby="fleur_init")
                END IF
             END IF!(wann%l_gwf)
          END IF!(mpi%irank.EQ.0)

#ifdef CPP_MPI
          CALL MPI_BCAST(wann%param_vec,3*wann%nparampts,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
          CALL MPI_BCAST(wann%param_alpha,atoms%ntype*wann%nparampts,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
          CALL MPI_BCAST(wann%l_dim,3,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
#endif

          ! Initializations for Wannier functions (end)
443

444
          IF (xcpot%is_hybrid().OR.input%l_rdmft) THEN
445

Daniel Wortmann's avatar
Daniel Wortmann committed
446 447 448
!             IF( ANY( atoms%l_geo  ) )&
!                  &     CALL juDFT_error("Forces not implemented for HF/PBE0/HSE ",&
!                  &                    calledby ="fleur")
449 450

             !calculate whole Brilloun zone
Daniel Wortmann's avatar
Daniel Wortmann committed
451
             !CALL gen_bz(kpts,sym)
452 453
             CALL gen_map(atoms,sym,oneD,hybrid)

454 455
             ! calculate d_wgn
             ALLOCATE (hybrid%d_wgn2(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,sym%nsym))
456
             hybrid%d_wgn2 =  CMPLX(0.0,0.0)
457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474
             CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,hybrid%d_wgn2(:,:,1:,:sym%nop))
             hybrid%d_wgn2(:,:,0,:) = 1

             DO isym = sym%nop+1,sym%nsym
                iisym = isym - sym%nop
                DO l = 0,atoms%lmaxd
                   DO m2 = -l,l
                      DO m1 = -l,-1
                         cdum                  = hybrid%d_wgn2( m1,m2,l,iisym)
                         hybrid%d_wgn2( m1,m2,l,isym) = hybrid%d_wgn2(-m1,m2,l,iisym)*(-1)**m1
                         hybrid%d_wgn2(-m1,m2,l,isym) = cdum                  *(-1)**m1
                      END DO
                      hybrid%d_wgn2(0,m2,l,isym) = hybrid%d_wgn2(0,m2,l,iisym)
                   END DO
                END DO
             END DO
          ELSE
             IF ( banddos%dos .AND. banddos%ndir == -3 ) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
475
                WRITE(*,*) 'Recalculating k point grid to cover the full BZ.'
476
                CALL gen_bz(kpts,sym)
Daniel Wortmann's avatar
Daniel Wortmann committed
477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494
                kpts%nkpt = kpts%nkptf
                DEALLOCATE(kpts%bk,kpts%wtkpt)
                ALLOCATE(kpts%bk(3,kpts%nkptf),kpts%wtkpt(kpts%nkptf))
                kpts%bk(:,:) = kpts%bkf(:,:)
                IF (kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3).NE.kpts%nkptf) THEN
                   IF(kpts%l_gamma) THEN
                      kpts%wtkpt = 1.0 / (kpts%nkptf-1)
                      DO i = 1, kpts%nkptf
                         IF(ALL(kpts%bk(:,i).EQ.0.0)) THEN
                            kpts%wtkpt(i) = 0.0
                         END IF
                      END DO
                   ELSE
                      CALL juDFT_error("nkptf does not match product of nkpt3(i).",calledby="fleur_init")
                   END IF
                ELSE
                   kpts%wtkpt = 1.0 / kpts%nkptf
                END IF
495 496
             END IF
             ALLOCATE(hybrid%map(0,0),hybrid%tvec(0,0,0),hybrid%d_wgn2(0,0,0,0))
497 498 499 500 501
             hybrid%l_calhf = .FALSE.
          END IF

          IF(input%l_rdmft) THEN
             hybrid%l_calhf = .FALSE.
502
          END IF
Matthias Redies's avatar
Matthias Redies committed
503

504
          IF (mpi%irank.EQ.0) THEN
505
             CALL writeOutParameters(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
506
                                     oneD,hybrid,cell,banddos,sliceplot,xcpot,&
507
                                     noco,dimension,enpara,sphhar)
508
             CALL fleur_info(kpts)
509
             CALL deleteDensities()
510 511
          END IF

512
          !Finalize the MPI setup
513
          CALL setupMPI(kpts%nkpt,DIMENSION%neigd,mpi)
514

515 516 517 518 519 520 521 522 523 524
          !Collect some usage info
          CALL add_usage_data("A-Types",atoms%ntype)
          CALL add_usage_data("Atoms",atoms%nat)
          CALL add_usage_data("Real",sym%invs.AND..NOT.noco%l_noco)
          CALL add_usage_data("Spins",input%jspins)
          CALL add_usage_data("Noco",noco%l_noco)
          CALL add_usage_data("SOC",noco%l_soc)
          CALL add_usage_data("SpinSpiral",noco%l_ss)
          CALL add_usage_data("PlaneWaves",DIMENSION%nvd)
          CALL add_usage_data("LOs",atoms%nlotot)
525
          CALL add_usage_data("nkpt", kpts%nkpt)
526 527 528 529 530 531

#ifdef CPP_GPU
         CALL add_usage_data("gpu_per_node",1)
#else
         CALL add_usage_data("gpu_per_node",0)
#endif
Matthias Redies's avatar
Matthias Redies committed
532

Frank Freimuth's avatar
Frank Freimuth committed
533 534 535 536
          INQUIRE (file='wann_inp',exist=l_wann_inp)
          input%l_wann = input%l_wann.OR.l_wann_inp
 
          IF(input%l_wann) THEN
Frank Freimuth's avatar
Frank Freimuth committed
537
            CALL wann_read_inp(DIMENSION,input,noco,mpi,wann)
Frank Freimuth's avatar
Frank Freimuth committed
538 539
          END IF

540
          CALL results%init(dimension,input,atoms,kpts,noco)
541

542
          IF (mpi%irank.EQ.0) THEN
543
             IF(input%gw.NE.0) CALL mixing_history_reset(mpi)
544 545 546
             CALL setStartingDensity(noco%l_noco)
          END IF

Daniel Wortmann's avatar
Daniel Wortmann committed
547 548 549
          !new check mode will only run the init-part of FLEUR
          IF (judft_was_argument("-check")) CALL judft_end("Check-mode done",mpi%irank)

Frank Freimuth's avatar
Frank Freimuth committed
550

551 552


553
        END SUBROUTINE fleur_init
554
      END MODULE m_fleur_init