types_cdnval.f90 22.7 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
!--------------------------------------------------------------------------------
! Copyright (c) 2018 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_types_cdnval

IMPLICIT NONE

PRIVATE

   TYPE t_orb
      REAL, ALLOCATABLE    :: uu(:,:,:,:)
      REAL, ALLOCATABLE    :: dd(:,:,:,:)
      COMPLEX, ALLOCATABLE :: uup(:,:,:,:)
      COMPLEX, ALLOCATABLE :: uum(:,:,:,:)
      COMPLEX, ALLOCATABLE :: ddp(:,:,:,:)
      COMPLEX, ALLOCATABLE :: ddm(:,:,:,:)

      REAL, ALLOCATABLE    :: uulo(:,:,:,:)
      REAL, ALLOCATABLE    :: dulo(:,:,:,:)
      COMPLEX, ALLOCATABLE :: uulop(:,:,:,:)
      COMPLEX, ALLOCATABLE :: uulom(:,:,:,:)
      COMPLEX, ALLOCATABLE :: dulop(:,:,:,:)
      COMPLEX, ALLOCATABLE :: dulom(:,:,:,:)

      REAL, ALLOCATABLE    :: z(:,:,:,:,:)
      COMPLEX, ALLOCATABLE :: p(:,:,:,:,:)
      COMPLEX, ALLOCATABLE :: m(:,:,:,:,:)

      CONTAINS
         PROCEDURE,PASS :: init => orb_init
   END TYPE t_orb

36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
   TYPE t_denCoeffs
      ! spherical
      REAL, ALLOCATABLE    :: uu(:,:,:)
      REAL, ALLOCATABLE    :: dd(:,:,:)
      REAL, ALLOCATABLE    :: du(:,:,:)

      ! nonspherical
      REAL, ALLOCATABLE    :: uunmt(:,:,:,:)
      REAL, ALLOCATABLE    :: ddnmt(:,:,:,:)
      REAL, ALLOCATABLE    :: dunmt(:,:,:,:)
      REAL, ALLOCATABLE    :: udnmt(:,:,:,:)

      ! spherical - LOs
      REAL, ALLOCATABLE    :: aclo(:,:,:)
      REAL, ALLOCATABLE    :: bclo(:,:,:)
      REAL, ALLOCATABLE    :: cclo(:,:,:,:)

      ! nonspherical - LOs
      REAL, ALLOCATABLE    :: acnmt(:,:,:,:,:)
      REAL, ALLOCATABLE    :: bcnmt(:,:,:,:,:)
      REAL, ALLOCATABLE    :: ccnmt(:,:,:,:,:)


      CONTAINS
      PROCEDURE,PASS :: init => denCoeffs_init
   END TYPE t_denCoeffs

63 64 65 66 67 68 69 70
   TYPE t_slab
      INTEGER              :: nsld, nsl

      INTEGER, ALLOCATABLE :: nmtsl(:,:)
      INTEGER, ALLOCATABLE :: nslat(:,:)
      REAL,    ALLOCATABLE :: zsl(:,:)
      REAL,    ALLOCATABLE :: volsl(:)
      REAL,    ALLOCATABLE :: volintsl(:)
71 72
      REAL,    ALLOCATABLE :: qintsl(:,:,:,:)
      REAL,    ALLOCATABLE :: qmtsl(:,:,:,:)
73 74 75 76 77

      CONTAINS
         PROCEDURE,PASS :: init => slab_init
   END TYPE t_slab

78 79 80 81 82 83 84 85 86
   TYPE t_eigVecCoeffs
      COMPLEX, ALLOCATABLE :: acof(:,:,:,:)
      COMPLEX, ALLOCATABLE :: bcof(:,:,:,:)
      COMPLEX, ALLOCATABLE :: ccof(:,:,:,:,:)

      CONTAINS
         PROCEDURE,PASS :: init => eigVecCoeffs_init
   END TYPE t_eigVecCoeffs

87 88 89 90 91
   TYPE t_mcd
      REAL                 :: emcd_lo, emcd_up

      INTEGER, ALLOCATABLE :: ncore(:)
      REAL,    ALLOCATABLE :: e_mcd(:,:,:)
Gregor Michalicek's avatar
Gregor Michalicek committed
92
      REAL,    ALLOCATABLE :: mcd(:,:,:,:,:)
93 94 95 96 97 98
      COMPLEX, ALLOCATABLE :: m_mcd(:,:,:,:)

      CONTAINS
         PROCEDURE,PASS :: init1 => mcd_init1
   END TYPE t_mcd

99
   TYPE t_moments
100

101 102 103 104 105 106 107 108 109 110 111
      REAL, ALLOCATABLE    :: chmom(:,:)
      REAL, ALLOCATABLE    :: clmom(:,:,:)
      COMPLEX, ALLOCATABLE :: qa21(:)

      REAL, ALLOCATABLE    :: stdn(:,:)
      REAL, ALLOCATABLE    :: svdn(:,:)

      CONTAINS
         PROCEDURE,PASS :: init => moments_init
   END TYPE t_moments

112 113
   TYPE t_orbcomp

114 115
      REAL, ALLOCATABLE    :: comp(:,:,:,:,:)
      REAL, ALLOCATABLE    :: qmtp(:,:,:,:)
116 117 118 119 120

      CONTAINS
         PROCEDURE,PASS :: init => orbcomp_init
   END TYPE t_orbcomp

121
   TYPE t_cdnvalJob
122 123 124 125 126 127 128 129 130

      INTEGER              :: ikptIncrement
      INTEGER              :: ikptStart
      INTEGER              :: nkptExtended
      LOGICAL              :: l_evp

      INTEGER, ALLOCATABLE :: noccbd(:)
      INTEGER, ALLOCATABLE :: nStart(:)
      INTEGER, ALLOCATABLE :: nEnd(:)
Matthias Redies's avatar
Matthias Redies committed
131
      REAL,    ALLOCATABLE :: weights(:,:) ! weights(band_idx, kpt_idx)
132 133

      CONTAINS
134 135
         PROCEDURE,PASS :: init => cdnvalJob_init
   END TYPE t_cdnvalJob
136

137 138 139 140 141 142 143 144
   TYPE t_gVacMap

      INTEGER, ALLOCATABLE    :: gvac1d(:)
      INTEGER, ALLOCATABLE    :: gvac2d(:)

      CONTAINS
         PROCEDURE,PASS :: init => gVacMap_init
   END TYPE t_gVacMap
145

146
PUBLIC t_orb, t_denCoeffs, t_slab, t_eigVecCoeffs
147
PUBLIC t_mcd, t_moments, t_orbcomp, t_cdnvalJob, t_gVacMap
148 149 150 151 152 153 154 155 156 157 158 159 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 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

CONTAINS

SUBROUTINE orb_init(thisOrb, atoms, noco, jsp_start, jsp_end)

   USE m_types_setup

   IMPLICIT NONE

   CLASS(t_orb), INTENT(INOUT)    :: thisOrb
   TYPE(t_atoms), INTENT(IN)      :: atoms
   TYPE(t_noco), INTENT(IN)       :: noco
   INTEGER, INTENT(IN)            :: jsp_start
   INTEGER, INTENT(IN)            :: jsp_end

   INTEGER                        :: dim1, dim2, dim3

   IF(ALLOCATED(thisOrb%uu)) DEALLOCATE(thisOrb%uu)
   IF(ALLOCATED(thisOrb%dd)) DEALLOCATE(thisOrb%dd)
   IF(ALLOCATED(thisOrb%uup)) DEALLOCATE(thisOrb%uup)
   IF(ALLOCATED(thisOrb%uum)) DEALLOCATE(thisOrb%uum)
   IF(ALLOCATED(thisOrb%ddp)) DEALLOCATE(thisOrb%ddp)
   IF(ALLOCATED(thisOrb%ddm)) DEALLOCATE(thisOrb%ddm)

   IF(ALLOCATED(thisOrb%uulo)) DEALLOCATE(thisOrb%uulo)
   IF(ALLOCATED(thisOrb%dulo)) DEALLOCATE(thisOrb%dulo)
   IF(ALLOCATED(thisOrb%uulop)) DEALLOCATE(thisOrb%uulop)
   IF(ALLOCATED(thisOrb%uulom)) DEALLOCATE(thisOrb%uulom)
   IF(ALLOCATED(thisOrb%dulop)) DEALLOCATE(thisOrb%dulop)
   IF(ALLOCATED(thisOrb%dulom)) DEALLOCATE(thisOrb%dulom)

   IF(ALLOCATED(thisOrb%z)) DEALLOCATE(thisOrb%z)
   IF(ALLOCATED(thisOrb%p)) DEALLOCATE(thisOrb%p)
   IF(ALLOCATED(thisOrb%m)) DEALLOCATE(thisOrb%m)

   dim1 = 0
   dim2 = 1
   dim3 = 1
   IF (noco%l_soc) THEN
      dim1 = atoms%lmaxd
      dim2 = atoms%ntype
      dim3 = atoms%nlod
   END IF

   ALLOCATE(thisOrb%uu(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%dd(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%uup(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%uum(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%ddp(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%ddm(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))

   ALLOCATE(thisOrb%uulo(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%dulo(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%uulop(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%uulom(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%dulop(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%dulom(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))

   ALLOCATE(thisOrb%z(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%p(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
   ALLOCATE(thisOrb%m(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))

   thisOrb%uu = 0.0
   thisOrb%dd = 0.0
   thisOrb%uup = CMPLX(0.0,0.0)
   thisOrb%uum = CMPLX(0.0,0.0)
   thisOrb%ddp = CMPLX(0.0,0.0)
   thisOrb%ddm = CMPLX(0.0,0.0)

   thisOrb%uulo = 0.0
   thisOrb%dulo = 0.0
   thisOrb%uulop = CMPLX(0.0,0.0)
   thisOrb%uulom = CMPLX(0.0,0.0)
   thisOrb%dulop = CMPLX(0.0,0.0)
   thisOrb%dulom = CMPLX(0.0,0.0)

   thisOrb%z = 0.0
   thisOrb%p = CMPLX(0.0,0.0)
   thisOrb%m = CMPLX(0.0,0.0)

END SUBROUTINE orb_init

230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 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 279 280 281
SUBROUTINE denCoeffs_init(thisDenCoeffs, atoms, sphhar, jsp_start, jsp_end)

   USE m_types_setup

   IMPLICIT NONE

   CLASS(t_denCoeffs), INTENT(INOUT) :: thisDenCoeffs
   TYPE(t_atoms),      INTENT(IN)    :: atoms
   TYPE(t_sphhar),     INTENT(IN)    :: sphhar
   INTEGER,            INTENT(IN)    :: jsp_start
   INTEGER,            INTENT(IN)    :: jsp_end

   INTEGER                           :: llpd

   llpd = (atoms%lmaxd*(atoms%lmaxd+3)) / 2

   ALLOCATE (thisDenCoeffs%uu(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%dd(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%du(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end))

   ALLOCATE (thisDenCoeffs%uunmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%ddnmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%dunmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%udnmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))

   ALLOCATE (thisDenCoeffs%aclo(atoms%nlod,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%bclo(atoms%nlod,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%cclo(atoms%nlod,atoms%nlod,atoms%ntype,jsp_start:jsp_end))

   ALLOCATE (thisDenCoeffs%acnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%bcnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
   ALLOCATE (thisDenCoeffs%ccnmt(atoms%nlod,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))

   thisDenCoeffs%uu = 0.0
   thisDenCoeffs%dd = 0.0
   thisDenCoeffs%du = 0.0

   thisDenCoeffs%uunmt = 0.0
   thisDenCoeffs%ddnmt = 0.0
   thisDenCoeffs%dunmt = 0.0
   thisDenCoeffs%udnmt = 0.0

   thisDenCoeffs%aclo = 0.0
   thisDenCoeffs%bclo = 0.0
   thisDenCoeffs%cclo = 0.0

   thisDenCoeffs%acnmt = 0.0
   thisDenCoeffs%bcnmt = 0.0
   thisDenCoeffs%ccnmt = 0.0

END SUBROUTINE denCoeffs_init

282
SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts)
283 284

   USE m_types_setup
285
   USE m_types_kpts
286 287 288 289 290 291 292 293 294 295
   USE m_slabdim
   USE m_slabgeom

   IMPLICIT NONE

   CLASS(t_slab),      INTENT(INOUT) :: thisSlab
   TYPE(t_banddos),    INTENT(IN)    :: banddos
   TYPE(t_dimension),  INTENT(IN)    :: dimension
   TYPE(t_atoms),      INTENT(IN)    :: atoms
   TYPE(t_cell),       INTENT(IN)    :: cell
296 297
   TYPE(t_input),      INTENT(IN)    :: input
   TYPE(t_kpts),       INTENT(IN)    :: kpts
298 299 300 301 302 303 304 305 306 307 308 309

   INTEGER :: nsld

   nsld=1

   IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
      CALL slab_dim(atoms, nsld)
      ALLOCATE (thisSlab%nmtsl(atoms%ntype,nsld))
      ALLOCATE (thisSlab%nslat(atoms%nat,nsld))
      ALLOCATE (thisSlab%zsl(2,nsld))
      ALLOCATE (thisSlab%volsl(nsld))
      ALLOCATE (thisSlab%volintsl(nsld))
310 311
      ALLOCATE (thisSlab%qintsl(nsld,dimension%neigd,kpts%nkpt,input%jspins))
      ALLOCATE (thisSlab%qmtsl(nsld,dimension%neigd,kpts%nkpt,input%jspins))
312 313 314 315 316 317 318 319
      CALL slabgeom(atoms,cell,nsld,thisSlab%nsl,thisSlab%zsl,thisSlab%nmtsl,&
                    thisSlab%nslat,thisSlab%volsl,thisSlab%volintsl)
   ELSE
      ALLOCATE (thisSlab%nmtsl(1,1))
      ALLOCATE (thisSlab%nslat(1,1))
      ALLOCATE (thisSlab%zsl(1,1))
      ALLOCATE (thisSlab%volsl(1))
      ALLOCATE (thisSlab%volintsl(1))
320 321
      ALLOCATE (thisSlab%qintsl(1,1,1,input%jspins))
      ALLOCATE (thisSlab%qmtsl(1,1,1,input%jspins))
322 323 324 325 326
   END IF
   thisSlab%nsld = nsld

END SUBROUTINE slab_init

327

328
SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,input,DIMENSION,atoms,noco,jspin,noccbd)
329 330 331 332 333 334 335 336 337

   USE m_types_setup

   IMPLICIT NONE

   CLASS(t_eigVecCoeffs), INTENT(INOUT) :: thisEigVecCoeffs
   TYPE(t_dimension),     INTENT(IN)    :: dimension
   TYPE(t_atoms),         INTENT(IN)    :: atoms
   TYPE(t_noco),          INTENT(IN)    :: noco
338
   TYPE(t_input),         INTENT(IN)    :: input
339 340 341 342 343 344 345 346

   INTEGER,               INTENT(IN)    :: jspin, noccbd

   IF(ALLOCATED(thisEigVecCoeffs%acof)) DEALLOCATE(thisEigVecCoeffs%acof)
   IF(ALLOCATED(thisEigVecCoeffs%bcof)) DEALLOCATE(thisEigVecCoeffs%bcof)
   IF(ALLOCATED(thisEigVecCoeffs%ccof)) DEALLOCATE(thisEigVecCoeffs%ccof)

   IF (noco%l_mperp) THEN
347 348 349
      ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:dimension%lmd,atoms%nat,input%jspins))
      ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:dimension%lmd,atoms%nat,input%jspins))
      ALLOCATE (thisEigVecCoeffs%ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,input%jspins))
350 351 352 353 354 355 356 357 358 359 360 361
   ELSE
      ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin))
      ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin))
      ALLOCATE (thisEigVecCoeffs%ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,jspin:jspin))
   END IF

   thisEigVecCoeffs%acof = CMPLX(0.0,0.0)
   thisEigVecCoeffs%bcof = CMPLX(0.0,0.0)
   thisEigVecCoeffs%ccof = CMPLX(0.0,0.0)

END SUBROUTINE eigVecCoeffs_init

Gregor Michalicek's avatar
Gregor Michalicek committed
362
SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms,kpts)
363 364

   USE m_types_setup
Gregor Michalicek's avatar
Gregor Michalicek committed
365
   USE m_types_kpts
366 367 368 369 370 371 372 373

   IMPLICIT NONE

   CLASS(t_mcd),          INTENT(INOUT) :: thisMCD
   TYPE(t_banddos),       INTENT(IN)    :: banddos
   TYPE(t_dimension),     INTENT(IN)    :: dimension
   TYPE(t_input),         INTENT(IN)    :: input
   TYPE(t_atoms),         INTENT(IN)    :: atoms
Gregor Michalicek's avatar
Gregor Michalicek committed
374
   TYPE(t_kpts),          INTENT(IN)    :: kpts
375 376 377 378 379 380 381

   ALLOCATE (thisMCD%ncore(atoms%ntype))
   ALLOCATE (thisMCD%e_mcd(atoms%ntype,input%jspins,dimension%nstd))
   IF (banddos%l_mcd) THEN
      thisMCD%emcd_lo = banddos%e_mcd_lo
      thisMCD%emcd_up = banddos%e_mcd_up
      ALLOCATE (thisMCD%m_mcd(dimension%nstd,(3+1)**2,3*atoms%ntype,2))
Gregor Michalicek's avatar
Gregor Michalicek committed
382
      ALLOCATE (thisMCD%mcd(3*atoms%ntype,dimension%nstd,dimension%neigd,kpts%nkpt,input%jspins) )
383 384 385
      IF (.NOT.banddos%dos) WRITE (*,*) 'For mcd-spectra set banddos%dos=T!'
   ELSE
      ALLOCATE (thisMCD%m_mcd(1,1,1,1))
Gregor Michalicek's avatar
Gregor Michalicek committed
386
      ALLOCATE (thisMCD%mcd(1,1,1,1,input%jspins))
387 388
   ENDIF

389
   thisMCD%ncore = 0
390 391 392 393 394 395
   thisMCD%e_mcd = 0.0
   thisMCD%mcd = 0.0
   thisMCD%m_mcd = CMPLX(0.0,0.0)

END SUBROUTINE mcd_init1

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
SUBROUTINE moments_init(thisMoments,input,atoms)

   USE m_types_setup

   IMPLICIT NONE

   CLASS(t_moments),      INTENT(INOUT) :: thisMoments
   TYPE(t_input),         INTENT(IN)    :: input
   TYPE(t_atoms),         INTENT(IN)    :: atoms

   ALLOCATE(thisMoments%chmom(atoms%ntype,input%jspins))
   ALLOCATE(thisMoments%clmom(3,atoms%ntype,input%jspins))
   ALLOCATE(thisMoments%qa21(atoms%ntype))

   ALLOCATE(thisMoments%stdn(atoms%ntype,input%jspins))
   ALLOCATE(thisMoments%svdn(atoms%ntype,input%jspins))

   thisMoments%chmom = 0.0
   thisMoments%clmom = 0.0
   thisMoments%qa21 = CMPLX(0.0,0.0)

   thisMoments%stdn = 0.0
   thisMoments%svdn = 0.0

END SUBROUTINE moments_init

422
SUBROUTINE orbcomp_init(thisOrbcomp,input,banddos,dimension,atoms,kpts)
423 424

   USE m_types_setup
425
   USE m_types_kpts
426 427 428 429

   IMPLICIT NONE

   CLASS(t_orbcomp),      INTENT(INOUT) :: thisOrbcomp
430
   TYPE(t_input),         INTENT(IN)    :: input
431 432 433
   TYPE(t_banddos),       INTENT(IN)    :: banddos
   TYPE(t_dimension),     INTENT(IN)    :: dimension
   TYPE(t_atoms),         INTENT(IN)    :: atoms
434
   TYPE(t_kpts),          INTENT(IN)    :: kpts
435 436

   IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
437 438
      ALLOCATE(thisOrbcomp%comp(dimension%neigd,23,atoms%nat,kpts%nkpt,input%jspins))
      ALLOCATE(thisOrbcomp%qmtp(dimension%neigd,atoms%nat,kpts%nkpt,input%jspins))
439
   ELSE
440 441
      ALLOCATE(thisOrbcomp%comp(1,1,1,1,input%jspins))
      ALLOCATE(thisOrbcomp%qmtp(1,1,1,input%jspins))
442 443 444 445 446 447 448
   END IF

   thisOrbcomp%comp = 0.0
   thisOrbcomp%qmtp = 0.0

END SUBROUTINE orbcomp_init

449
SUBROUTINE cdnvalJob_init(thisCdnvalJob,mpi,input,kpts,noco,results,jspin,sliceplot,banddos)
450

451
   USE m_types_mpi
452 453 454 455 456 457
   USE m_types_setup
   USE m_types_kpts
   USE m_types_misc

   IMPLICIT NONE

458
   CLASS(t_cdnvalJob),             INTENT(INOUT) :: thisCdnvalJob
459 460 461 462 463 464
   TYPE(t_mpi),                    INTENT(IN)    :: mpi
   TYPE(t_input),                  INTENT(IN)    :: input
   TYPE(t_kpts),                   INTENT(IN)    :: kpts
   TYPE(t_noco),                   INTENT(IN)    :: noco
   TYPE(t_results),                INTENT(IN)    :: results
   TYPE(t_sliceplot),    OPTIONAL, INTENT(IN)    :: sliceplot
465
   TYPE(t_banddos), OPTIONAL,      INTENT(IN)    :: banddos
466 467 468

   INTEGER,                        INTENT(IN)    :: jspin

469
   INTEGER :: jsp, iBand, ikpt, nslibd, noccbd_l, noccbd, nStart, nEnd
470

471
   thisCdnvalJob%l_evp = .FALSE.
472
   IF (kpts%nkpt < mpi%isize) THEN
473 474 475 476
      thisCdnvalJob%l_evp = .TRUE.
      thisCdnvalJob%nkptExtended = kpts%nkpt
      thisCdnvalJob%ikptStart = 1
      thisCdnvalJob%ikptIncrement = 1
477 478
   ELSE
      ! the number of iterations is adjusted to the number of MPI processes to synchronize RMA operations
479 480 481
      thisCdnvalJob%nkptExtended = (kpts%nkpt / mpi%isize + 1) * mpi%isize
      thisCdnvalJob%ikptStart = mpi%irank + 1
      thisCdnvalJob%ikptIncrement = mpi%isize
482 483
   END IF

484 485 486
   IF (ALLOCATED(thisCdnvalJob%noccbd)) DEALLOCATE (thisCdnvalJob%noccbd)
   IF (ALLOCATED(thisCdnvalJob%nStart)) DEALLOCATE (thisCdnvalJob%nStart)
   IF (ALLOCATED(thisCdnvalJob%nEnd)) DEALLOCATE (thisCdnvalJob%nEnd)
487

488 489 490
   ALLOCATE(thisCdnvalJob%noccbd(kpts%nkpt))
   ALLOCATE(thisCdnvalJob%nStart(kpts%nkpt))
   ALLOCATE(thisCdnvalJob%nEnd(kpts%nkpt))
491

492 493 494
   thisCdnvalJob%noccbd = 0
   thisCdnvalJob%nStart = 1
   thisCdnvalJob%nEnd = -1
495 496 497 498

   jsp = MERGE(1,jspin,noco%l_noco)

   ! determine bands to be used for each k point, MPI process
499
   DO ikpt = thisCdnvalJob%ikptStart, kpts%nkpt, thisCdnvalJob%ikptIncrement
500

Gregor Michalicek's avatar
Gregor Michalicek committed
501 502 503
      iBand = results%neig(ikpt,jsp)
      DO WHILE (results%w_iks(iBand,ikpt,jsp).LT.1.e-8)
         iBand = iBand - 1
504
      END DO
Gregor Michalicek's avatar
Gregor Michalicek committed
505 506 507 508 509 510 511
      thisCdnvalJob%noccbd(ikpt) = iBand

!      DO iBand = 1,results%neig(ikpt,jsp)
!         IF ((results%w_iks(iBand,ikpt,jsp).GE.1.e-8).OR.input%pallst) THEN
!            thisCdnvalJob%noccbd(ikpt) = thisCdnvalJob%noccbd(ikpt) + 1
!         END IF
!      END DO
512

513 514 515
      IF(PRESENT(banddos)) THEN
            IF (banddos%dos) thisCdnvalJob%noccbd(ikpt) = results%neig(ikpt,jsp)
      END IF 
516

517 518
      thisCdnvalJob%nStart(ikpt) = 1
      thisCdnvalJob%nEnd(ikpt)   = thisCdnvalJob%noccbd(ikpt)
519 520 521

      !--->    if slice, only certain bands are taken into account
      IF(PRESENT(sliceplot)) THEN
522 523 524
         IF (sliceplot%slice.AND.thisCdnvalJob%noccbd(ikpt).GT.0) THEN
            thisCdnvalJob%nStart(ikpt) = 1
            thisCdnvalJob%nEnd(ikpt)   = -1
525 526
            IF (mpi%irank==0) WRITE (6,FMT=*) 'NNNE',sliceplot%nnne
            IF (mpi%irank==0) WRITE (6,FMT=*) 'sliceplot%kk',sliceplot%kk
527 528 529
            nslibd = 0
            IF (sliceplot%kk.EQ.0) THEN
               IF (mpi%irank==0) THEN
530 531
                  WRITE (6,FMT='(a)') 'ALL K-POINTS ARE TAKEN IN SLICE'
                  WRITE (6,FMT='(a,i2)') ' sliceplot%slice: k-point nr.',ikpt
532 533 534 535 536 537 538
               END IF

               iBand = 1
               DO WHILE (results%eig(iBand,ikpt,jsp).LT.sliceplot%e1s)
                  iBand = iBand + 1
                  IF(iBand.GT.results%neig(ikpt,jsp)) EXIT
               END DO
539
               thisCdnvalJob%nStart(ikpt) = iBand
540 541 542 543 544 545 546
               IF(iBand.LE.results%neig(ikpt,jsp)) THEN
                  DO WHILE (results%eig(iBand,ikpt,jsp).LE.sliceplot%e2s)
                     iBand = iBand + 1
                     IF(iBand.GT.results%neig(ikpt,jsp)) EXIT
                  END DO
                  iBand = iBand - 1
               END IF
547 548
               thisCdnvalJob%nEnd(ikpt) = iBand
               nslibd = MAX(0,thisCdnvalJob%nEnd(ikpt) - thisCdnvalJob%nStart(ikpt) + 1)
549
               IF (mpi%irank==0) WRITE (6,'(a,i3)') ' eigenvalues in sliceplot%slice:', nslibd
550
            ELSE IF (sliceplot%kk.EQ.ikpt) THEN
551
               IF (mpi%irank==0) WRITE (6,FMT='(a,i2)') ' sliceplot%slice: k-point nr.',ikpt
552
               IF ((sliceplot%e1s.EQ.0.0) .AND. (sliceplot%e2s.EQ.0.0)) THEN
553
                  IF (mpi%irank==0) WRITE (6,FMT='(a,i5,f10.5)') 'slice: eigenvalue nr.',&
554 555
                       sliceplot%nnne,results%eig(sliceplot%nnne,ikpt,jsp)
                  nslibd = 1
556 557
                  thisCdnvalJob%nStart(ikpt) = sliceplot%nnne
                  thisCdnvalJob%nEnd(ikpt) = sliceplot%nnne
558 559 560 561 562 563
               ELSE
                  iBand = 1
                  DO WHILE (results%eig(iBand,ikpt,jsp).LT.sliceplot%e1s)
                     iBand = iBand + 1
                     IF(iBand.GT.results%neig(ikpt,jsp)) EXIT
                  END DO
564
                  thisCdnvalJob%nStart(ikpt) = iBand
565 566 567 568 569 570 571
                  IF(iBand.LE.results%neig(ikpt,jsp)) THEN
                     DO WHILE (results%eig(iBand,ikpt,jsp).LE.sliceplot%e2s)
                        iBand = iBand + 1
                        IF(iBand.GT.results%neig(ikpt,jsp)) EXIT
                     END DO
                     iBand = iBand - 1
                  END IF
572 573
                  thisCdnvalJob%nEnd(ikpt) = iBand
                  nslibd = MAX(0,thisCdnvalJob%nEnd(ikpt) - thisCdnvalJob%nStart(ikpt) + 1)
574
                  IF (mpi%irank==0) WRITE (6,FMT='(a,i3)')' eigenvalues in sliceplot%slice:',nslibd
575 576
               END IF
            END IF
577
            thisCdnvalJob%noccbd(ikpt) = nslibd
578 579 580
         END IF ! sliceplot%slice
      END IF

581 582 583
      IF (thisCdnvalJob%l_evp) THEN
         noccbd_l = CEILING(REAL(thisCdnvalJob%noccbd(ikpt)) / mpi%isize)
         thisCdnvalJob%nEnd(ikpt)   = min(thisCdnvalJob%nStart(ikpt)+(mpi%irank+1)*noccbd_l-1, thisCdnvalJob%noccbd(ikpt))
584
         thisCdnvalJob%nStart(ikpt) = thisCdnvalJob%nStart(ikpt) + mpi%irank*noccbd_l
585 586
         thisCdnvalJob%noccbd(ikpt) = thisCdnvalJob%nEnd(ikpt) - thisCdnvalJob%nStart(ikpt) + 1
         IF (thisCdnvalJob%noccbd(ikpt).LT.1) thisCdnvalJob%noccbd(ikpt) = 0
587 588 589 590
      END IF

   END DO

591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607
   IF (ALLOCATED(thisCdnvalJob%weights)) DEALLOCATE (thisCdnvalJob%weights)
   ALLOCATE(thisCdnvalJob%weights(MAXVAL(thisCdnvalJob%noccbd(:)),kpts%nkpt))

   thisCdnvalJob%weights = 0.0
   DO ikpt = thisCdnvalJob%ikptStart, kpts%nkpt, thisCdnvalJob%ikptIncrement
      noccbd = thisCdnvalJob%noccbd(ikpt)
      nStart = thisCdnvalJob%nStart(ikpt)
      nEnd = thisCdnvalJob%nEnd(ikpt)

      thisCdnvalJob%weights(1:noccbd,ikpt) = results%w_iks(nStart:nEnd,ikpt,jsp)
      IF(PRESENT(sliceplot)) THEN
         IF (sliceplot%slice.AND.input%pallst) thisCdnvalJob%weights(:,ikpt) = kpts%wtkpt(ikpt)
      END IF
      thisCdnvalJob%weights(:noccbd,ikpt) = 2.0 * thisCdnvalJob%weights(:noccbd,ikpt) / input%jspins ! add in spin-doubling factor
   END DO

END SUBROUTINE cdnvalJob_init
608

609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651
SUBROUTINE gVacMap_init(thisGVacMap,dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)

   USE m_types_setup
   USE m_types_lapw
   USE m_types_enpara
   USE m_types_potden
   USE m_types_kpts
   USE m_nstm3

   IMPLICIT NONE

   CLASS(t_gVacMap),      INTENT(INOUT) :: thisGVacMap
   TYPE(t_dimension),     INTENT(IN)    :: dimension
   TYPE(t_sym),           INTENT(IN)    :: sym
   TYPE(t_atoms),         INTENT(IN)    :: atoms
   TYPE(t_vacuum),        INTENT(IN)    :: vacuum
   TYPE(t_stars),         INTENT(IN)    :: stars
   TYPE(t_lapw),          INTENT(IN)    :: lapw
   TYPE(t_input),         INTENT(IN)    :: input
   TYPE(t_cell),          INTENT(IN)    :: cell
   TYPE(t_kpts),          INTENT(IN)    :: kpts
   TYPE(t_enpara),        INTENT(IN)    :: enpara
   TYPE(t_potden),        INTENT(IN)    :: vTot

   INTEGER,               INTENT(IN)    :: ikpt
   INTEGER,               INTENT(IN)    :: jspin

   IF (ALLOCATED(thisGVacMap%gvac1d)) DEALLOCATE(thisGVacMap%gvac1d)
   IF (ALLOCATED(thisGVacMap%gvac2d)) DEALLOCATE(thisGVacMap%gvac2d)

   ALLOCATE(thisGVacMap%gvac1d(dimension%nv2d))
   ALLOCATE(thisGVacMap%gvac2d(dimension%nv2d))

   thisGVacMap%gvac1d = 0
   thisGVacMap%gvac2d = 0

   IF (vacuum%nstm.EQ.3.AND.input%film) THEN
      CALL nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
                 cell,enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),thisGVacMap%gvac1d,thisGVacMap%gvac2d)
   END IF

END SUBROUTINE gVacMap_init

652
END MODULE m_types_cdnval