fleur_init_old.F90 12.3 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------
MODULE m_fleur_init_old
  IMPLICIT NONE
CONTAINS
  !> Collection of code for old-style inp-file treatment
  SUBROUTINE fleur_init_old(mpi,&
       input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
12
       sliceplot,banddos,obsolete,enpara,xcpot,kpts,hybrid,&
13 14
       oneD,coreSpecInput,l_opti)
    USE m_types
15
    USE m_judft
16 17 18 19 20 21
    USE m_dimens
    USE m_inped
    USE m_setup
    USE m_constants
    USE m_winpXML
#ifdef CPP_MPI
22
#ifndef CPP_OLDINTEL
23
    USE m_mpi_dist_forcetheorem
24
#endif
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
#endif

    IMPLICIT NONE
    !     Types, these variables contain a lot of data!
    TYPE(t_mpi)    ,INTENT(INOUT)  :: mpi
    TYPE(t_input)    ,INTENT(INOUT):: input
    TYPE(t_dimension),INTENT(OUT)  :: DIMENSION
    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(INOUT):: sliceplot
    TYPE(t_banddos)  ,INTENT(OUT)  :: banddos
    TYPE(t_obsolete) ,INTENT(OUT)  :: obsolete 
    TYPE(t_enpara)   ,INTENT(OUT)  :: enpara
43
    CLASS(t_xcpot),INTENT(OUT),ALLOCATABLE  :: xcpot
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
    TYPE(t_kpts)     ,INTENT(INOUT):: kpts
    TYPE(t_hybrid)   ,INTENT(OUT)  :: hybrid
    TYPE(t_oneD)     ,INTENT(OUT)  :: oneD
    TYPE(t_coreSpecInput),INTENT(OUT) :: coreSpecInput
    CLASS(t_forcetheo),ALLOCATABLE,INTENT(OUT)::forcetheo
    LOGICAL,          INTENT(OUT):: l_opti


    INTEGER, ALLOCATABLE          :: xmlElectronStates(:,:)
    INTEGER, ALLOCATABLE          :: atomTypeSpecies(:)
    INTEGER, ALLOCATABLE          :: speciesRepAtomType(:)
    REAL, ALLOCATABLE             :: xmlCoreOccs(:,:,:)
    LOGICAL, ALLOCATABLE          :: xmlPrintCoreStates(:,:)
    CHARACTER(len=3), ALLOCATABLE :: noel(:)
    !     .. Local Scalars ..
    INTEGER    :: i,n,l,m1,m2,isym,iisym,numSpecies,pc,iAtom,iType
    COMPLEX    :: cdum
    CHARACTER(len=4)              :: namex
    CHARACTER(len=12)             :: relcor, tempNumberString
    CHARACTER(LEN=20)             :: filename
    REAL                          :: a1(3),a2(3),a3(3)
    REAL                          :: dtild, phi_add
    LOGICAL                       :: l_found, l_kpts, l_exist, l_krla
#ifdef CPP_MPI
    INTEGER:: ierr
    INCLUDE 'mpif.h'
#endif

    ALLOCATE(t_forcetheo::forcetheo) !default no forcetheorem type
73 74 75 76
    ALLOCATE(t_xcpot_inbuild::xcpot)

    SELECT TYPE(xcpot)
    TYPE IS (t_xcpot_inbuild)
77 78 79 80 81
    namex = '    '
    relcor = '            '

    CALL dimens(mpi,input,sym,stars,atoms,sphhar,DIMENSION,vacuum,&
         obsolete,kpts,oneD,hybrid)
82 83
    stars%kimax2= (2*stars%mx1+1)* (2*stars%mx2+1)-1
    stars%kimax = (2*stars%mx1+1)* (2*stars%mx2+1)* (2*stars%mx3+1)-1
84 85 86 87 88 89 90 91 92 93
    !-odim
    IF (oneD%odd%d1) THEN
       oneD%odd%k3 = stars%mx3
       oneD%odd%nn2d = (2*(oneD%odd%k3) + 1)*(2*(oneD%odd%M) + 1)
    ELSE
       oneD%odd%k3 = 0 ; oneD%odd%M =0 ; oneD%odd%nn2d = 1
       oneD%odd%mb = 0
    ENDIF
    !-odim
    ALLOCATE ( atoms%nz(atoms%ntype),atoms%relax(3,atoms%ntype),atoms%nlhtyp(atoms%ntype))
94
    ALLOCATE (atoms%corestateoccs(1,2,atoms%ntype));atoms%corestateoccs=0.0
95 96 97 98 99 100 101 102
    ALLOCATE ( sphhar%clnu(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd),stars%ustep(stars%ng3) )
    ALLOCATE ( stars%ig(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3),stars%ig2(stars%ng3) )
    ALLOCATE ( atoms%jri(atoms%ntype),stars%kv2(2,stars%ng2),stars%kv3(3,stars%ng3),sphhar%llh(0:sphhar%nlhd,sphhar%ntypsd) )
    ALLOCATE (sym%mrot(3,3,sym%nop),sym%tau(3,sym%nop))
    ALLOCATE ( atoms%lmax(atoms%ntype),sphhar%mlh(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))!,sym%mrot(3,3,sym%nop) )
    ALLOCATE ( atoms%ncv(atoms%ntype),atoms%neq(atoms%ntype),atoms%ngopr(atoms%nat) )
    ALLOCATE ( sphhar%nlh(sphhar%ntypsd),sphhar%nmem(0:sphhar%nlhd,sphhar%ntypsd) )
    ALLOCATE ( stars%nstr2(stars%ng2),atoms%ntypsy(atoms%nat),stars%nstr(stars%ng3) )
103
    ALLOCATE ( stars%igfft(0:stars%kimax,2),stars%igfft2(0:stars%kimax2,2),atoms%nflip(atoms%ntype) )
104 105 106 107 108 109 110 111 112 113 114 115
    ALLOCATE ( atoms%ncst(atoms%ntype) )
    ALLOCATE ( vacuum%izlay(vacuum%layerd,2) )
    ALLOCATE ( sym%invarop(atoms%nat,sym%nop),sym%invarind(atoms%nat) )
    ALLOCATE ( sym%multab(sym%nop,sym%nop),sym%invtab(sym%nop) )
    ALLOCATE ( atoms%invsat(atoms%nat),sym%invsatnr(atoms%nat) )
    ALLOCATE ( atoms%lnonsph(atoms%ntype) )
    ALLOCATE ( atoms%dx(atoms%ntype),atoms%pos(3,atoms%nat))!,sym%tau(3,sym%nop) )
    ALLOCATE ( atoms%rmsh(atoms%jmtd,atoms%ntype),atoms%rmt(atoms%ntype),stars%sk2(stars%ng2),stars%sk3(stars%ng3) )
    ALLOCATE ( stars%phi2(stars%ng2) )
    ALLOCATE ( atoms%taual(3,atoms%nat),atoms%volmts(atoms%ntype),atoms%zatom(atoms%ntype) )
    ALLOCATE ( stars%rgphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3)  )
    ALLOCATE ( kpts%bk(3,kpts%nkpt),kpts%wtkpt(kpts%nkpt) )
116
    ALLOCATE ( stars%pgfft(0:stars%kimax),stars%pgfft2(0:stars%kimax2) )
117
    ALLOCATE ( stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1) )
118
    ALLOCATE ( atoms%bmu(atoms%ntype) )
119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
    ALLOCATE ( atoms%l_geo(atoms%ntype) )
    ALLOCATE ( atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype) )
    ALLOCATE ( atoms%lo1l(0:atoms%llod,atoms%ntype),atoms%nlol(0:atoms%llod,atoms%ntype),atoms%lapw_l(atoms%ntype) )
    ALLOCATE ( noco%alphInit(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype),noco%l_relax(atoms%ntype) )
    ALLOCATE ( noco%b_con(2,atoms%ntype),atoms%lda_u(atoms%ntype),atoms%l_dulo(atoms%nlod,atoms%ntype) )
    ALLOCATE ( sym%d_wgn(-3:3,-3:3,3,sym%nop) )
    ALLOCATE ( atoms%ulo_der(atoms%nlod,atoms%ntype) )
    ALLOCATE ( atoms%numStatesProvided(atoms%ntype))
    ALLOCATE ( kpts%ntetra(4,kpts%ntet), kpts%voltet(kpts%ntet))
    !+odim
    ALLOCATE ( oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M) )
    ALLOCATE ( oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d) )
    ALLOCATE ( oneD%ngopr1(atoms%nat),oneD%mrot1(3,3,oneD%odd%nop),oneD%tau1(3,oneD%odd%nop) )
    ALLOCATE ( oneD%invtab1(oneD%odd%nop),oneD%multab1(oneD%odd%nop,oneD%odd%nop) )
    ALLOCATE ( oneD%igfft1(0:oneD%odd%nn2d-1,2),oneD%pgfft1(0:oneD%odd%nn2d-1) )
    stars%sk2(:) = 0.0 ; stars%phi2(:) = 0.0
    !-odim

    ! HF/hybrid functionals/EXX
    ALLOCATE ( hybrid%nindx(0:atoms%lmaxd,atoms%ntype) )

    kpts%specificationType = 0
    atoms%numStatesProvided(:) = 0
    input%l_coreSpec = .FALSE.


145

146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166

    IF(.NOT.juDFT_was_argument("-toXML")) THEN
       PRINT *,"--------------WARNING----------------------"
       PRINT *,"You are using the old-style FLEUR inp file."
       PRINT *,"Please be warned that not all features are"
       PRINT *,"implemented/tested in this mode. Please "
       PRINT *,"consider switching to xml input. You might"
       PRINT *,"find the -toXML command line option useful."
       PRINT *,"--------------WARNING----------------------"
    ELSE
       IF (mpi%isize>1) CALL judft_error("Do not call -toXML with more than a single PE")
    ENDIF
    CALL timestart("preparation:stars,lattice harmonics,+etc")

    !+t3e
    IF (mpi%irank.EQ.0) THEN
       !-t3e
       CALL inped(atoms,obsolete,vacuum,input,banddos,xcpot,sym,&
            cell,sliceplot,noco,&
            stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor)
       !
167
       IF (xcpot%vxc_is_gga()) THEN
168
          ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
169 170 171 172 173 174 175 176
          ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
               oneD%pgft1xy(0:oneD%odd%nn2d-1),&
               oneD%pgft1y(0:oneD%odd%nn2d-1),oneD%pgft1yy(0:oneD%odd%nn2d-1))
       ELSE
          ALLOCATE (stars%ft2_gfx(0:1),stars%ft2_gfy(0:1))
          ALLOCATE (oneD%pgft1x(0:1),oneD%pgft1xx(0:1),oneD%pgft1xy(0:1),&
               oneD%pgft1y(0:1),oneD%pgft1yy(0:1))
       ENDIF
177
       oneD%odd%nq2 = stars%ng2!oneD%odd%n2d
178 179 180 181 182 183 184 185 186 187 188
       oneD%odi%nq2 = oneD%odd%nq2
       !-odim
       !+t3e
       INQUIRE(file="cdn1",exist=l_opti)
       IF (noco%l_noco) INQUIRE(file="rhomat_inp",exist=l_opti)
       l_opti=.NOT.l_opti
       IF ((sliceplot%iplot).OR.(input%strho).OR.(input%swsp).OR.&
            &    (input%lflip).OR.(input%l_bmt)) l_opti = .TRUE.
       !

       namex=xcpot%get_name()
189
       l_krla = xcpot%data%krla.EQ.1
190 191 192 193 194
    END IF ! mpi%irank.eq.0

#ifdef CPP_MPI
    CALL MPI_BCAST(namex,4,MPI_CHARACTER,0,mpi%mpi_comm,ierr)
    CALL MPI_BCAST(l_krla,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
195
    CALL MPI_BCAST(atoms%ntype,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
196
#ifndef CPP_OLDINTEL
197
    CALL mpi_dist_forcetheorem(mpi,forcetheo)
198
#endif
199 200
#endif
    IF (mpi%irank.NE.0) THEN
201
       CALL xcpot%init(namex,l_krla,atoms%ntype)
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
    END IF

    CALL setup(mpi,atoms,kpts,DIMENSION,sphhar,&
         obsolete,sym,stars,oneD,input,noco,&
         vacuum,cell,xcpot,&
         sliceplot,enpara,l_opti)

    IF (mpi%irank.EQ.0) THEN
       banddos%l_orb = .FALSE.
       banddos%orbCompAtom = 0

       ALLOCATE(noco%socscale(atoms%ntype))
       xcpot%lda_atom(:) = .FALSE.
       noco%socscale(:) = 1.0

       IF(juDFT_was_argument("-toXML")) THEN
          WRITE(*,*) ''
          WRITE(*,*) 'Please note:'
          WRITE(*,*) 'The inp to xml input conversion is experimental and'
          WRITE(*,*) 'only made for basic inp files without sophisticated'
          WRITE(*,*) 'parametrizations. You might have to adjust the generated'
          WRITE(*,*) 'file by hand to really obtain an adequate input file.'
          WRITE(*,*) 'Also the generated XML input file is not meant to be'
          WRITE(*,*) 'beautiful.'
          WRITE(*,*) ''
          ALLOCATE(noel(atoms%ntype),atomTypeSpecies(atoms%ntype),speciesRepAtomType(atoms%ntype))
          ALLOCATE(xmlElectronStates(29,atoms%ntype),xmlPrintCoreStates(29,atoms%ntype))
          ALLOCATE(xmlCoreOccs(1,1,1),atoms%label(atoms%nat))
230
          ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype))
231 232 233 234 235 236
          filename = 'inpConverted.xml'
          xmlElectronStates = noState_const
          xmlPrintCoreStates = .FALSE.
          DO i = 1, atoms%nat
             WRITE(atoms%label(i),'(i0)') i
          END DO
237 238 239 240
          DO iType = 1, atoms%ntype
             noel(iType) = namat_const(atoms%nz(iType))
             atomTypeSpecies(iType) = iType
             speciesRepAtomType(iType) = iType
241 242 243 244

             hybrid%lcutm1(iType) = 4
             hybrid%lcutwf(iType) = atoms%lmax(iType) - atoms%lmax(iType) / 10
             hybrid%select1(:,iType) = (/4, 0, 4, 2 /)
245
          END DO
246 247 248 249 250 251
          hybrid%gcutm1 = input%rkmax - 0.5
          hybrid%tolerance1 = 1.0e-4
          hybrid%ewaldlambda = 3
          hybrid%lexp = 16
          hybrid%bands1 = max( nint(input%zelec)*10, 60 )

252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
          numSpecies = SIZE(speciesRepAtomType)
          ALLOCATE(atoms%speciesName(numSpecies))
          atoms%speciesName = ''
          DO i = 1, numSpecies
             tempNumberString = ''
             WRITE(tempNumberString,'(i0)') i
             atoms%speciesName(i) = TRIM(ADJUSTL(noel(speciesRepAtomType(i)))) // '-' // TRIM(ADJUSTL(tempNumberString))
          END DO
          a1(:) = a1(:) / input%scaleCell
          a2(:) = a2(:) / input%scaleCell
          a3(:) = a3(:) / input%scaleCell
          kpts%specificationType = 3
          sym%symSpecType = 3
          CALL w_inpXML(&
               atoms,obsolete,vacuum,input,stars,sliceplot,forcetheo,banddos,&
               cell,sym,xcpot,noco,oneD,hybrid,kpts,kpts%nkpt3,kpts%l_gamma,&
               noel,namex,relcor,a1,a2,a3,dtild,input%comment,&
               xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
               atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,&
               .TRUE.,numSpecies,enpara)
          DEALLOCATE(atoms%speciesName, atoms%label)
          DEALLOCATE(noel,atomTypeSpecies,speciesRepAtomType)
          DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
          CALL juDFT_end("Fleur inp to XML input conversion completed.")
       END IF
    END IF ! mpi%irank.eq.0
    CALL timestop("preparation:stars,lattice harmonics,+etc")
279
    END SELECT
280 281
  END SUBROUTINE fleur_init_old
END MODULE m_fleur_init_old