fleur_init.F90 13.7 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,&
Daniel Wortmann's avatar
Daniel Wortmann committed
11
             sliceplot,banddos,enpara,xcpot,results,kpts,hybrid,&
12
             oneD,coreSpecInput,wann,l_opti)
13
          USE m_types
Daniel Wortmann's avatar
Daniel Wortmann committed
14
          USE m_fleurinput_read_xml
15
          USE m_fleurinput_mpi_bc
16
          USE m_judft
17
          USE m_juDFT_init
18
          USE m_init_wannier_defaults
Daniel Wortmann's avatar
Daniel Wortmann committed
19
          USE m_postprocessInput
20 21
          USE m_gen_map
          USE m_dwigner
22
          !USE m_gen_bz
23
          USE m_ylm
24
          USE m_InitParallelProcesses
25
          USE m_xmlOutput
Daniel Wortmann's avatar
Daniel Wortmann committed
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_writeOutHeader
35
          !USE m_fleur_init_old
36
          USE m_types_xcpot_inbuild
Daniel Wortmann's avatar
Daniel Wortmann committed
37 38
          USE m_mpi_bc_xcpot

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

Daniel Wortmann's avatar
Daniel Wortmann committed
74 75 76
          type(t_enparaXML)::enparaXML
          TYPE(t_forcetheo_data)::forcetheo_data

77

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

94 95 96 97 98 99 100 101
#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
102 103
          !determine if we use an xml-input file
          INQUIRE (file='inp.xml',exist=input%l_inpXML)
Daniel Wortmann's avatar
Daniel Wortmann committed
104 105
          IF (.NOT.input%l_inpXML) THEN
             CALL judft_error("No input file found",calledby='fleur_init',hint="To use FLEUR, you have to provide an 'inp.xml' file in the working directory")
106 107
          END IF

108
          CALL check_command_line()
Daniel Wortmann's avatar
Daniel Wortmann committed
109
#ifdef CPP_HDF
110
          CALL hdf_init()
Daniel Wortmann's avatar
Daniel Wortmann committed
111
#endif
112
          IF (mpi%irank.EQ.0) THEN
113
             CALL startFleur_XMLOutput()
Daniel Wortmann's avatar
Daniel Wortmann committed
114
             IF (judft_was_argument("-info")) THEN
115
                  CLOSE(6)
Daniel Wortmann's avatar
Daniel Wortmann committed
116 117
                  OPEN (6,status='SCRATCH')
             ELSE
118
                  IF (.not.judft_was_argument("-no_out")) &
Daniel Wortmann's avatar
Daniel Wortmann committed
119 120
                  OPEN (6,file='out',form='formatted',status='unknown')
             ENDIF
121
             CALL writeOutHeader()
Daniel Wortmann's avatar
Daniel Wortmann committed
122
             OPEN (16,status='SCRATCH')
123 124
          ENDIF

Daniel Wortmann's avatar
Daniel Wortmann committed
125 126
          ALLOCATE(t_xcpot_inbuild::xcpot)
          
Daniel Wortmann's avatar
Daniel Wortmann committed
127
          IF (mpi%irank.EQ.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
128
             CALL fleurinput_read_xml(cell,sym,atoms,input,noco,vacuum,field,&
Daniel Wortmann's avatar
Daniel Wortmann committed
129 130
                  sliceplot,banddos,hybrid,oneD,coreSpecInput,wann,&
                  xcpot,forcetheo_data,kpts,enparaXML)
Daniel Wortmann's avatar
Daniel Wortmann committed
131
          END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
132
          
133
          CALL fleurinput_mpi_bc(cell,sym,atoms,input,noco,vacuum,field,&
Daniel Wortmann's avatar
Daniel Wortmann committed
134 135 136 137
               sliceplot,banddos,hybrid,oneD,coreSpecInput,wann,&
               xcpot,forcetheo_data,kpts,enparaXML,mpi%mpi_comm)
          
          
Daniel Wortmann's avatar
Daniel Wortmann committed
138 139
          CALL timestart("postprocessInput") 
          CALL postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
Daniel Wortmann's avatar
Daniel Wortmann committed
140 141
               oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,forcetheo_data,&
               noco,DIMENSION,enpara,enparaxml,sphhar,l_opti,noel,l_kpts)
Daniel Wortmann's avatar
Daniel Wortmann committed
142 143 144 145 146 147 148 149
          CALL timestop("postprocessInput") 
          
          IF (mpi%irank.EQ.0) THEN
             CALL w_inpXML(&
                  atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
                  cell,sym,xcpot,noco,oneD,hybrid,kpts,enpara,&
                  .TRUE.,[.TRUE.,.TRUE.,.TRUE.,.TRUE.])           
          END IF
150

Daniel Wortmann's avatar
Daniel Wortmann committed
151
          
152 153 154 155
          CALL ylmnorm_init(atoms%lmaxd)
          !
          !--> determine more dimensions
          !
Daniel Wortmann's avatar
Daniel Wortmann committed
156
          DIMENSION%nbasfcn = DIMENSION%nvd + atoms%nat*atoms%nlod*(2*atoms%llod+1)
Daniel Wortmann's avatar
Daniel Wortmann committed
157 158 159
          DIMENSION%lmd     = atoms%lmaxd* (atoms%lmaxd+2)
          DIMENSION%lmplmd  = (DIMENSION%lmd* (DIMENSION%lmd+3))/2
          IF (noco%l_noco) DIMENSION%nbasfcn = 2*DIMENSION%nbasfcn
Daniel Wortmann's avatar
Daniel Wortmann committed
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
           
        
        IF (mpi%irank.EQ.0) THEN
           CALL writeOutParameters(mpi,input,sym,stars,atoms,vacuum,kpts,&
                oneD,hybrid,cell,banddos,sliceplot,xcpot,&
                noco,DIMENSION,enpara,sphhar)
           CALL fleur_info(kpts)
           CALL deleteDensities()
        END IF

        !Finalize the MPI setup
        CALL setupMPI(kpts%nkpt,mpi)
        
        !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)
        CALL add_usage_data("nkpt", kpts%nkpt)
        
#ifdef CPP_GPU
        CALL add_usage_data("gpu_per_node",1)
#else
        CALL add_usage_data("gpu_per_node",0)
#endif
        
        CALL results%init(DIMENSION,input,atoms,kpts,noco)
        
        IF (mpi%irank.EQ.0) THEN
           IF(input%gw.NE.0) CALL mixing_history_reset(mpi)
           CALL setStartingDensity(noco%l_noco)
        END IF
        
        !new check mode will only run the init-part of FLEUR
        IF (judft_was_argument("-check")) CALL judft_end("Check-mode done",mpi%irank)
      CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
          SUBROUTINE init_hybrid()
          IF (xcpot%is_hybrid().OR.input%l_rdmft) THEN
             IF (input%film.OR.oneD%odi%d1) THEN
                CALL juDFT_error("2D film and 1D calculations not implemented for HF/EXX/PBE0/HSE", &
                     calledby ="fleur", hint="Use a supercell or a different functional")
             END IF
             
             !             IF( ANY( atoms%l_geo  ) )&
             !                  &     CALL juDFT_error("Forces not implemented for HF/PBE0/HSE ",&
             !                  &                    calledby ="fleur")
             
             !calculate whole Brilloun zone
             !CALL gen_bz(kpts,sym)
             CALL gen_map(atoms,sym,oneD,hybrid)

             ! 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
             hybrid%l_calhf = .FALSE.
             ALLOCATE(hybrid%map(0,0),hybrid%tvec(0,0,0),hybrid%d_wgn2(0,0,0,0))
             IF(input%l_rdmft) THEN
                hybrid%l_calhf = .FALSE.
             END IF
          ENDIF
        END SUBROUTINE init_hybrid
Daniel Wortmann's avatar
Daniel Wortmann committed
242 243
        
        SUBROUTINE init_wannier()
244 245
          ! Initializations for Wannier functions (start)
          IF (mpi%irank.EQ.0) THEN
246
             wann%l_gwf = wann%l_ms.OR.wann%l_sgwf.OR.wann%l_socgwf
Daniel Wortmann's avatar
Daniel Wortmann committed
247 248
             
             IF(wann%l_gwf) THEN
249 250
                WRITE(*,*)'running HDWF-extension of FLEUR code'
                WRITE(*,*)'with l_sgwf =',wann%l_sgwf,' and l_socgwf =',wann%l_socgwf
Daniel Wortmann's avatar
Daniel Wortmann committed
251
                
252
                IF(wann%l_socgwf.AND. .NOT.noco%l_soc) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
253
                   CALL juDFT_error("set l_soc=T if l_socgwf=T",calledby="fleur_init")
254
                END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
255 256
                
                IF((wann%l_ms.OR.wann%l_sgwf).AND..NOT.(noco%l_noco.AND.noco%l_ss)) THEN
257 258
                   CALL juDFT_error("set l_noco=l_ss=T for l_sgwf.or.l_ms",calledby="fleur_init")
                END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
259 260
                
                IF((wann%l_ms.OR.wann%l_sgwf).AND.wann%l_socgwf) THEN
261 262
                   CALL juDFT_error("(l_ms.or.l_sgwf).and.l_socgwf",calledby="fleur_init")
                END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
263
                
264 265
                INQUIRE(FILE=wann%param_file,EXIST=l_exist)
                IF(.NOT.l_exist) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
266
                   CALL juDFT_error("where is param_file"//TRIM(wann%param_file)//"?",calledby="fleur_init")
267 268 269 270 271 272 273 274 275 276 277 278
                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

          ALLOCATE (wann%param_vec(3,wann%nparampts))
          ALLOCATE (wann%param_alpha(atoms%ntype,wann%nparampts))
Daniel Wortmann's avatar
Daniel Wortmann committed
279
          
280 281 282 283
          IF(mpi%irank.EQ.0) THEN
             IF(wann%l_gwf) THEN
                OPEN(113,file=wann%param_file,status='old')
                READ(113,*)!header
Daniel Wortmann's avatar
Daniel Wortmann committed
284 285
                WRITE(6,*) 'parameter points for HDWFs generation:'
                IF(wann%l_sgwf.OR.wann%l_ms) THEN
286 287 288 289
                   WRITE(6,*)'      q1       ','      q2       ','      q3'
                ELSE IF(wann%l_socgwf) THEN
                   WRITE(6,*)'      --       ','     phi       ','    theta'
                END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
290
                
291 292 293 294
                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)
Daniel Wortmann's avatar
Daniel Wortmann committed
295
                   IF(wann%l_sgwf.OR.wann%l_ms) THEN
296 297 298
                      iAtom = 1
                      DO iType = 1, atoms%ntype
                         phi_add = tpi_const*(wann%param_vec(1,pc)*atoms%taual(1,iAtom) +&
Daniel Wortmann's avatar
Daniel Wortmann committed
299 300
                              wann%param_vec(2,pc)*atoms%taual(2,iAtom) +&
                              wann%param_vec(3,pc)*atoms%taual(3,iAtom))
301 302
                         wann%param_alpha(iType,pc) = noco%alph(iType) + phi_add
                         iAtom = iAtom + atoms%neq(iType)
Daniel Wortmann's avatar
Daniel Wortmann committed
303
                      END DO
304 305
                   END IF
                END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
306 307 308 309 310
                
                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.
                
311
                CLOSE(113)
Daniel Wortmann's avatar
Daniel Wortmann committed
312 313
                
                IF(wann%l_dim(1).AND.wann%l_socgwf) THEN
314 315 316 317
                   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)
Daniel Wortmann's avatar
Daniel Wortmann committed
318
          
319 320 321 322 323 324 325
#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)
Daniel Wortmann's avatar
Daniel Wortmann committed
326 327
        END SUBROUTINE init_wannier
      END SUBROUTINE fleur_init
328
      END MODULE m_fleur_init