fleur_init.F90 22.6 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 39
          USE m_mpi_bc_xcpot

40 41
#ifdef CPP_MPI
          USE m_mpi_bc_all,  ONLY : mpi_bc_all
42
#ifndef CPP_OLDINTEL
43
          USE m_mpi_dist_forcetheorem
Daniel Wortmann's avatar
Daniel Wortmann committed
44
#endif
45
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
46 47
#ifdef CPP_HDF
          USE m_hdf_tools
48 49 50 51 52
#endif
          IMPLICIT NONE
          !     Types, these variables contain a lot of data!
          TYPE(t_mpi)    ,INTENT(INOUT):: mpi
          TYPE(t_input)    ,INTENT(OUT):: input
53
          TYPE(t_field),    INTENT(OUT) :: field
Daniel Wortmann's avatar
Daniel Wortmann committed
54
          TYPE(t_dimension),INTENT(OUT):: DIMENSION
55 56 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
          TYPE(t_obsolete) ,INTENT(OUT):: obsolete 
          TYPE(t_enpara)   ,INTENT(OUT):: enpara
66
          CLASS(t_xcpot),ALLOCATABLE,INTENT(OUT):: xcpot
67 68 69 70
          TYPE(t_results)  ,INTENT(OUT):: results
          TYPE(t_kpts)     ,INTENT(OUT):: kpts
          TYPE(t_hybrid)   ,INTENT(OUT):: hybrid
          TYPE(t_oneD)     ,INTENT(OUT):: oneD
71
          TYPE(t_coreSpecInput),INTENT(OUT) :: coreSpecInput
72
          TYPE(t_wann)     ,INTENT(OUT):: wann
73
          CLASS(t_forcetheo),ALLOCATABLE,INTENT(OUT)::forcetheo
74
          LOGICAL,          INTENT(OUT):: l_opti
75

76

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

93 94 95 96 97 98 99 100
#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
101 102 103 104 105
          !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
106
             IF (l_found) CALL judft_warn("Both inp & inp.xml given.", calledby="fleur_init",hint="Please delete one of the input files")
107 108 109 110
          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

111
          CALL check_command_line()
Daniel Wortmann's avatar
Daniel Wortmann committed
112
#ifdef CPP_HDF
113
          CALL hdf_init()
Daniel Wortmann's avatar
Daniel Wortmann committed
114
#endif
115
          !call juDFT_check_para()
116
          CALL field%init(input)
117

118 119 120 121
          input%gw                = -1
          input%gw_neigd          =  0
          !-t3e
          IF (mpi%irank.EQ.0) THEN
122
             CALL startFleur_XMLOutput()
Daniel Wortmann's avatar
Daniel Wortmann committed
123
             IF (judft_was_argument("-info")) THEN
124
                  CLOSE(6)
Daniel Wortmann's avatar
Daniel Wortmann committed
125 126
                  OPEN (6,status='SCRATCH')
             ELSE
127
                  IF (.not.judft_was_argument("-no_out")) &
Daniel Wortmann's avatar
Daniel Wortmann committed
128 129
                  OPEN (6,file='out',form='formatted',status='unknown')
             ENDIF
130
             CALL writeOutHeader()
131
             !OPEN (16,status='SCRATCH')
132 133
          ENDIF

134 135
          input%l_rdmft = .FALSE.

136
          input%l_wann = .FALSE.
137 138
          CALL initWannierDefaults(wann)

139
          input%minDistance = 0.0
140 141
          input%ldauLinMix = .FALSE.
          input%ldauMixParam = 0.05
142
          input%ldauSpinf = 1.0
143
          input%pallst = .FALSE.
144 145 146 147
          input%scaleCell = 1.0
          input%scaleA1 = 1.0
          input%scaleA2 = 1.0
          input%scaleC = 1.0
148 149 150 151
          input%forcealpha = 1.0
          input%forcemix = 0
          input%epsdisp = 0.00001
          input%epsforce = 0.00001
152
          input%numBandsKPoints = -1
153

154
          kpts%ntet = 1
155
          kpts%numSpecialPoints = 1
156 157 158 159 160 161 162

          sliceplot%iplot=.FALSE.
          sliceplot%kk = 0
          sliceplot%e1s = 0.0
          sliceplot%e2s = 0.0
          sliceplot%nnne = 0

163
          banddos%l_mcd = .FALSE.
164
          banddos%e_mcd_lo = -10.0
165
          banddos%e_mcd_up = 0.0
166

167
          banddos%unfoldband = .FALSE.
168 169 170
          banddos%s_cell_x = 1
          banddos%s_cell_y = 1
          banddos%s_cell_z = 1
171

172 173
          noco%l_mtNocoPot = .FALSE.

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

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

                DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
221
                DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
222
             END IF
223

Daniel Wortmann's avatar
Daniel Wortmann committed
224 225
             DEALLOCATE(noel)

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

231 232
#endif

233
          ELSE ! else branch of "IF (input%l_inpXML) THEN"
234 235 236 237
             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)
238
          END IF ! end of else branch of "IF (input%l_inpXML) THEN"
239
          !
240
  
241
          IF (.NOT.mpi%irank==0) CALL enpara%init(atoms,input%jspins,.FALSE.)
Daniel Wortmann's avatar
Daniel Wortmann committed
242
                   !-odim
243 244
          oneD%odd%nq2 = oneD%odd%n2d
          oneD%odd%kimax2 = oneD%odd%nq2 - 1
245
          oneD%odd%nat = atoms%nat
246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265

          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
          !
266

267 268 269 270 271 272 273 274
#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)
275
          call MPI_BCAST( input%preconditioning_param, 1, MPI_DOUBLE_PRECISION, 0, mpi%mpi_comm, ierr )
276
#endif
277
          CALL ylmnorm_init(max(atoms%lmaxd, 2*hybrid%lexp))
278 279 280
          !
          !--> determine more dimensions
          !
281
          DIMENSION%nbasfcn = DIMENSION%nvd + atoms%nat*atoms%nlod*(2*atoms%llod+1)
Daniel Wortmann's avatar
Daniel Wortmann committed
282 283
          DIMENSION%lmd     = atoms%lmaxd* (atoms%lmaxd+2)
          DIMENSION%lmplmd  = (DIMENSION%lmd* (DIMENSION%lmd+3))/2
284

285 286
          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))
287
#ifdef CPP_MPI
288 289
          CALL mpi_bc_all(mpi,stars,sphhar,atoms,obsolete,sym,kpts,DIMENSION,input,field,&
                          banddos,sliceplot,vacuum,cell,enpara,noco,oneD,hybrid)
290 291 292 293 294 295
#endif

          ! Set up pointer for backtransformation from g-vector in positive 
          ! domain of carge density fftibox into stars
          CALL prp_qfft_map(stars,sym,input,stars%igq2_fft,stars%igq_fft)

296 297 298 299 300 301 302 303 304 305 306
          atoms%nlotot = 0
          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
          ENDDO

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

          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
327
          IF (noco%l_noco) DIMENSION%nbasfcn = 2*DIMENSION%nbasfcn
328
          
329 330 331 332 333 334 335 336
          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

337 338
          CALL checkInputParams(mpi,input,dimension,atoms,noco,xcpot,oneD)

339 340
          ! Initializations for Wannier functions (start)
          IF (mpi%irank.EQ.0) THEN
341
#ifdef CPP_WANN
342 343 344
             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!!'
345 346
#endif
             wann%l_gwf = wann%l_ms.OR.wann%l_sgwf.OR.wann%l_socgwf
347 348 349 350 351 352 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 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436

             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)
                      END DO  
                   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)
437

438
          IF (xcpot%is_hybrid().OR.input%l_rdmft) THEN
439

Daniel Wortmann's avatar
Daniel Wortmann committed
440 441 442
!             IF( ANY( atoms%l_geo  ) )&
!                  &     CALL juDFT_error("Forces not implemented for HF/PBE0/HSE ",&
!                  &                    calledby ="fleur")
443 444

             !calculate whole Brilloun zone
Daniel Wortmann's avatar
Daniel Wortmann committed
445
             !CALL gen_bz(kpts,sym)
446 447
             CALL gen_map(atoms,sym,oneD,hybrid)

448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467
             ! calculate d_wgn
             ALLOCATE (hybrid%d_wgn2(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,sym%nsym))
             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
468
                WRITE(*,*) 'Recalculating k point grid to cover the full BZ.'
469
                CALL gen_bz(kpts,sym)
Daniel Wortmann's avatar
Daniel Wortmann committed
470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487
                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
488 489
             END IF
             ALLOCATE(hybrid%map(0,0),hybrid%tvec(0,0,0),hybrid%d_wgn2(0,0,0,0))
490 491 492 493 494
             hybrid%l_calhf = .FALSE.
          END IF

          IF(input%l_rdmft) THEN
             hybrid%l_calhf = .FALSE.
495
          END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
496
 
497
          IF (mpi%irank.EQ.0) THEN
498
             CALL writeOutParameters(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
499
                                     oneD,hybrid,cell,banddos,sliceplot,xcpot,&
500
                                     noco,dimension,enpara,sphhar)
501
             CALL fleur_info(kpts)
502
             CALL deleteDensities()
503 504
          END IF

505
          !Finalize the MPI setup
506
          CALL setupMPI(kpts%nkpt,DIMENSION%neigd,mpi)
507

508 509 510 511 512 513 514 515 516 517
          !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)
518
          CALL add_usage_data("nkpt", kpts%nkpt)
519 520 521 522 523 524

#ifdef CPP_GPU
         CALL add_usage_data("gpu_per_node",1)
#else
         CALL add_usage_data("gpu_per_node",0)
#endif
525
          
526
          CALL results%init(dimension,input,atoms,kpts,noco)
527

528
          IF (mpi%irank.EQ.0) THEN
529
             IF(input%gw.NE.0) CALL mixing_history_reset(mpi)
530 531 532
             CALL setStartingDensity(noco%l_noco)
          END IF

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

536
        END SUBROUTINE fleur_init
537
      END MODULE m_fleur_init