LCOV - code coverage report
Current view: top level - types - types_cdnval.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 191 213 89.7 %
Date: 2019-09-08 04:53:50 Functions: 12 29 41.4 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_types_cdnval
       8             : 
       9             : IMPLICIT NONE
      10             : 
      11             : PRIVATE
      12             : 
      13             :    TYPE t_orb
      14             :       REAL, ALLOCATABLE    :: uu(:,:,:,:)
      15             :       REAL, ALLOCATABLE    :: dd(:,:,:,:)
      16             :       COMPLEX, ALLOCATABLE :: uup(:,:,:,:)
      17             :       COMPLEX, ALLOCATABLE :: uum(:,:,:,:)
      18             :       COMPLEX, ALLOCATABLE :: ddp(:,:,:,:)
      19             :       COMPLEX, ALLOCATABLE :: ddm(:,:,:,:)
      20             : 
      21             :       REAL, ALLOCATABLE    :: uulo(:,:,:,:)
      22             :       REAL, ALLOCATABLE    :: dulo(:,:,:,:)
      23             :       COMPLEX, ALLOCATABLE :: uulop(:,:,:,:)
      24             :       COMPLEX, ALLOCATABLE :: uulom(:,:,:,:)
      25             :       COMPLEX, ALLOCATABLE :: dulop(:,:,:,:)
      26             :       COMPLEX, ALLOCATABLE :: dulom(:,:,:,:)
      27             : 
      28             :       REAL, ALLOCATABLE    :: z(:,:,:,:,:)
      29             :       COMPLEX, ALLOCATABLE :: p(:,:,:,:,:)
      30             :       COMPLEX, ALLOCATABLE :: m(:,:,:,:,:)
      31             : 
      32             :       CONTAINS
      33             :          PROCEDURE,PASS :: init => orb_init
      34             :    END TYPE t_orb
      35             : 
      36             :    TYPE t_denCoeffs
      37             :       ! spherical
      38             :       REAL, ALLOCATABLE    :: uu(:,:,:)
      39             :       REAL, ALLOCATABLE    :: dd(:,:,:)
      40             :       REAL, ALLOCATABLE    :: du(:,:,:)
      41             : 
      42             :       ! nonspherical
      43             :       REAL, ALLOCATABLE    :: uunmt(:,:,:,:)
      44             :       REAL, ALLOCATABLE    :: ddnmt(:,:,:,:)
      45             :       REAL, ALLOCATABLE    :: dunmt(:,:,:,:)
      46             :       REAL, ALLOCATABLE    :: udnmt(:,:,:,:)
      47             : 
      48             :       ! spherical - LOs
      49             :       REAL, ALLOCATABLE    :: aclo(:,:,:)
      50             :       REAL, ALLOCATABLE    :: bclo(:,:,:)
      51             :       REAL, ALLOCATABLE    :: cclo(:,:,:,:)
      52             : 
      53             :       ! nonspherical - LOs
      54             :       REAL, ALLOCATABLE    :: acnmt(:,:,:,:,:)
      55             :       REAL, ALLOCATABLE    :: bcnmt(:,:,:,:,:)
      56             :       REAL, ALLOCATABLE    :: ccnmt(:,:,:,:,:)
      57             : 
      58             : 
      59             :       CONTAINS
      60             :       PROCEDURE,PASS :: init => denCoeffs_init
      61             :    END TYPE t_denCoeffs
      62             : 
      63             :    TYPE t_slab
      64             :       INTEGER              :: nsld, nsl
      65             : 
      66             :       INTEGER, ALLOCATABLE :: nmtsl(:,:)
      67             :       INTEGER, ALLOCATABLE :: nslat(:,:)
      68             :       REAL,    ALLOCATABLE :: zsl(:,:)
      69             :       REAL,    ALLOCATABLE :: volsl(:)
      70             :       REAL,    ALLOCATABLE :: volintsl(:)
      71             :       REAL,    ALLOCATABLE :: qintsl(:,:,:,:)
      72             :       REAL,    ALLOCATABLE :: qmtsl(:,:,:,:)
      73             : 
      74             :       CONTAINS
      75             :          PROCEDURE,PASS :: init => slab_init
      76             :    END TYPE t_slab
      77             : 
      78             :    TYPE t_eigVecCoeffs
      79             :       COMPLEX, ALLOCATABLE :: acof(:,:,:,:)
      80             :       COMPLEX, ALLOCATABLE :: bcof(:,:,:,:)
      81             :       COMPLEX, ALLOCATABLE :: ccof(:,:,:,:,:)
      82             : 
      83             :       CONTAINS
      84             :          PROCEDURE,PASS :: init => eigVecCoeffs_init
      85             :    END TYPE t_eigVecCoeffs
      86             : 
      87             :    TYPE t_mcd
      88             :       REAL                 :: emcd_lo, emcd_up
      89             : 
      90             :       INTEGER, ALLOCATABLE :: ncore(:)
      91             :       REAL,    ALLOCATABLE :: e_mcd(:,:,:)
      92             :       REAL,    ALLOCATABLE :: mcd(:,:,:,:,:)
      93             :       COMPLEX, ALLOCATABLE :: m_mcd(:,:,:,:)
      94             : 
      95             :       CONTAINS
      96             :          PROCEDURE,PASS :: init1 => mcd_init1
      97             :    END TYPE t_mcd
      98             : 
      99             :    TYPE t_moments
     100             : 
     101             :       REAL, ALLOCATABLE    :: chmom(:,:)
     102             :       REAL, ALLOCATABLE    :: clmom(:,:,:)
     103             :       COMPLEX, ALLOCATABLE :: qa21(:)
     104             : 
     105             :       REAL, ALLOCATABLE    :: stdn(:,:)
     106             :       REAL, ALLOCATABLE    :: svdn(:,:)
     107             : 
     108             :       CONTAINS
     109             :          PROCEDURE,PASS :: init => moments_init
     110             :    END TYPE t_moments
     111             : 
     112             :    TYPE t_orbcomp
     113             : 
     114             :       REAL, ALLOCATABLE    :: comp(:,:,:,:,:)
     115             :       REAL, ALLOCATABLE    :: qmtp(:,:,:,:)
     116             : 
     117             :       CONTAINS
     118             :          PROCEDURE,PASS :: init => orbcomp_init
     119             :    END TYPE t_orbcomp
     120             : 
     121             :    TYPE t_cdnvalJob
     122             :       LOGICAL              :: l_evp
     123             :       INTEGER, ALLOCATABLE :: k_list(:)
     124             :       INTEGER, ALLOCATABLE :: ev_list(:)
     125             :       INTEGER, ALLOCATABLE :: noccbd(:)    ! Attention, these are for all k-points and all states
     126             :       REAL,    ALLOCATABLE :: weights(:,:) ! 
     127             : 
     128             : 
     129             :       CONTAINS
     130             :          PROCEDURE,PASS :: init => cdnvalJob_init
     131             :          PROCEDURE      :: select_slice
     132             :          PROCEDURE      :: compact_ev_list
     133             :    END TYPE t_cdnvalJob
     134             : 
     135             :    TYPE t_gVacMap
     136             : 
     137             :       INTEGER, ALLOCATABLE    :: gvac1d(:)
     138             :       INTEGER, ALLOCATABLE    :: gvac2d(:)
     139             : 
     140             :       CONTAINS
     141             :          PROCEDURE,PASS :: init => gVacMap_init
     142             :    END TYPE t_gVacMap
     143             : 
     144             : PUBLIC t_orb, t_denCoeffs, t_slab, t_eigVecCoeffs
     145             : PUBLIC t_mcd, t_moments, t_orbcomp, t_cdnvalJob, t_gVacMap
     146             : 
     147             : CONTAINS
     148             : 
     149         608 : SUBROUTINE orb_init(thisOrb, atoms, noco, jsp_start, jsp_end)
     150             : 
     151             :    USE m_types_setup
     152             : 
     153             :    IMPLICIT NONE
     154             : 
     155             :    CLASS(t_orb), INTENT(INOUT)    :: thisOrb
     156             :    TYPE(t_atoms), INTENT(IN)      :: atoms
     157             :    TYPE(t_noco), INTENT(IN)       :: noco
     158             :    INTEGER, INTENT(IN)            :: jsp_start
     159             :    INTEGER, INTENT(IN)            :: jsp_end
     160             : 
     161             :    INTEGER                        :: dim1, dim2, dim3
     162             : 
     163         608 :    IF(ALLOCATED(thisOrb%uu)) DEALLOCATE(thisOrb%uu)
     164         608 :    IF(ALLOCATED(thisOrb%dd)) DEALLOCATE(thisOrb%dd)
     165         608 :    IF(ALLOCATED(thisOrb%uup)) DEALLOCATE(thisOrb%uup)
     166         608 :    IF(ALLOCATED(thisOrb%uum)) DEALLOCATE(thisOrb%uum)
     167         608 :    IF(ALLOCATED(thisOrb%ddp)) DEALLOCATE(thisOrb%ddp)
     168         608 :    IF(ALLOCATED(thisOrb%ddm)) DEALLOCATE(thisOrb%ddm)
     169             : 
     170         608 :    IF(ALLOCATED(thisOrb%uulo)) DEALLOCATE(thisOrb%uulo)
     171         608 :    IF(ALLOCATED(thisOrb%dulo)) DEALLOCATE(thisOrb%dulo)
     172         608 :    IF(ALLOCATED(thisOrb%uulop)) DEALLOCATE(thisOrb%uulop)
     173         608 :    IF(ALLOCATED(thisOrb%uulom)) DEALLOCATE(thisOrb%uulom)
     174         608 :    IF(ALLOCATED(thisOrb%dulop)) DEALLOCATE(thisOrb%dulop)
     175         608 :    IF(ALLOCATED(thisOrb%dulom)) DEALLOCATE(thisOrb%dulom)
     176             : 
     177         608 :    IF(ALLOCATED(thisOrb%z)) DEALLOCATE(thisOrb%z)
     178         608 :    IF(ALLOCATED(thisOrb%p)) DEALLOCATE(thisOrb%p)
     179         608 :    IF(ALLOCATED(thisOrb%m)) DEALLOCATE(thisOrb%m)
     180             : 
     181         608 :    dim1 = 0
     182         608 :    dim2 = 1
     183         608 :    dim3 = 1
     184         608 :    IF (noco%l_soc) THEN
     185         184 :       dim1 = atoms%lmaxd
     186         184 :       dim2 = atoms%ntype
     187         184 :       dim3 = atoms%nlod
     188             :    END IF
     189             : 
     190         608 :    ALLOCATE(thisOrb%uu(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
     191         608 :    ALLOCATE(thisOrb%dd(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
     192         608 :    ALLOCATE(thisOrb%uup(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
     193         608 :    ALLOCATE(thisOrb%uum(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
     194         608 :    ALLOCATE(thisOrb%ddp(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
     195         608 :    ALLOCATE(thisOrb%ddm(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
     196             : 
     197         608 :    ALLOCATE(thisOrb%uulo(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     198         608 :    ALLOCATE(thisOrb%dulo(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     199         608 :    ALLOCATE(thisOrb%uulop(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     200         608 :    ALLOCATE(thisOrb%uulom(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     201         608 :    ALLOCATE(thisOrb%dulop(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     202         608 :    ALLOCATE(thisOrb%dulom(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     203             : 
     204         608 :    ALLOCATE(thisOrb%z(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     205         608 :    ALLOCATE(thisOrb%p(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     206         608 :    ALLOCATE(thisOrb%m(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
     207             : 
     208        1216 :    thisOrb%uu = 0.0
     209        1216 :    thisOrb%dd = 0.0
     210        1216 :    thisOrb%uup = CMPLX(0.0,0.0)
     211        1216 :    thisOrb%uum = CMPLX(0.0,0.0)
     212        1216 :    thisOrb%ddp = CMPLX(0.0,0.0)
     213        1216 :    thisOrb%ddm = CMPLX(0.0,0.0)
     214             : 
     215        1216 :    thisOrb%uulo = 0.0
     216        1216 :    thisOrb%dulo = 0.0
     217        1216 :    thisOrb%uulop = CMPLX(0.0,0.0)
     218        1216 :    thisOrb%uulom = CMPLX(0.0,0.0)
     219        1216 :    thisOrb%dulop = CMPLX(0.0,0.0)
     220        1216 :    thisOrb%dulom = CMPLX(0.0,0.0)
     221             : 
     222        1216 :    thisOrb%z = 0.0
     223        1216 :    thisOrb%p = CMPLX(0.0,0.0)
     224        1216 :    thisOrb%m = CMPLX(0.0,0.0)
     225             : 
     226         608 : END SUBROUTINE orb_init
     227             : 
     228         608 : SUBROUTINE denCoeffs_init(thisDenCoeffs, atoms, sphhar, jsp_start, jsp_end)
     229             : 
     230             :    USE m_types_setup
     231             : 
     232             :    IMPLICIT NONE
     233             : 
     234             :    CLASS(t_denCoeffs), INTENT(INOUT) :: thisDenCoeffs
     235             :    TYPE(t_atoms),      INTENT(IN)    :: atoms
     236             :    TYPE(t_sphhar),     INTENT(IN)    :: sphhar
     237             :    INTEGER,            INTENT(IN)    :: jsp_start
     238             :    INTEGER,            INTENT(IN)    :: jsp_end
     239             : 
     240             :    INTEGER                           :: llpd
     241             : 
     242         608 :    llpd = (atoms%lmaxd*(atoms%lmaxd+3)) / 2
     243             : 
     244         608 :    ALLOCATE (thisDenCoeffs%uu(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end))
     245         608 :    ALLOCATE (thisDenCoeffs%dd(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end))
     246         608 :    ALLOCATE (thisDenCoeffs%du(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end))
     247             : 
     248         608 :    ALLOCATE (thisDenCoeffs%uunmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
     249         608 :    ALLOCATE (thisDenCoeffs%ddnmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
     250         608 :    ALLOCATE (thisDenCoeffs%dunmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
     251         608 :    ALLOCATE (thisDenCoeffs%udnmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
     252             : 
     253         608 :    ALLOCATE (thisDenCoeffs%aclo(atoms%nlod,atoms%ntype,jsp_start:jsp_end))
     254         608 :    ALLOCATE (thisDenCoeffs%bclo(atoms%nlod,atoms%ntype,jsp_start:jsp_end))
     255         608 :    ALLOCATE (thisDenCoeffs%cclo(atoms%nlod,atoms%nlod,atoms%ntype,jsp_start:jsp_end))
     256             : 
     257         608 :    ALLOCATE (thisDenCoeffs%acnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
     258         608 :    ALLOCATE (thisDenCoeffs%bcnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
     259         608 :    ALLOCATE (thisDenCoeffs%ccnmt(atoms%nlod,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end))
     260             : 
     261        1216 :    thisDenCoeffs%uu = 0.0
     262        1216 :    thisDenCoeffs%dd = 0.0
     263        1216 :    thisDenCoeffs%du = 0.0
     264             : 
     265        1216 :    thisDenCoeffs%uunmt = 0.0
     266        1216 :    thisDenCoeffs%ddnmt = 0.0
     267        1216 :    thisDenCoeffs%dunmt = 0.0
     268        1216 :    thisDenCoeffs%udnmt = 0.0
     269             : 
     270        1216 :    thisDenCoeffs%aclo = 0.0
     271        1216 :    thisDenCoeffs%bclo = 0.0
     272        1216 :    thisDenCoeffs%cclo = 0.0
     273             : 
     274        1216 :    thisDenCoeffs%acnmt = 0.0
     275        1216 :    thisDenCoeffs%bcnmt = 0.0
     276        1216 :    thisDenCoeffs%ccnmt = 0.0
     277             : 
     278         608 : END SUBROUTINE denCoeffs_init
     279             : 
     280         340 : SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts)
     281             : 
     282             :    USE m_types_setup
     283             :    USE m_types_kpts
     284             :    USE m_slabdim
     285             :    USE m_slabgeom
     286             : 
     287             :    IMPLICIT NONE
     288             : 
     289             :    CLASS(t_slab),      INTENT(INOUT) :: thisSlab
     290             :    TYPE(t_banddos),    INTENT(IN)    :: banddos
     291             :    TYPE(t_dimension),  INTENT(IN)    :: dimension
     292             :    TYPE(t_atoms),      INTENT(IN)    :: atoms
     293             :    TYPE(t_cell),       INTENT(IN)    :: cell
     294             :    TYPE(t_input),      INTENT(IN)    :: input
     295             :    TYPE(t_kpts),       INTENT(IN)    :: kpts
     296             : 
     297             :    INTEGER :: nsld
     298             : 
     299         340 :    nsld=1
     300             : 
     301         340 :    IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
     302           0 :       CALL slab_dim(atoms, nsld)
     303           0 :       ALLOCATE (thisSlab%nmtsl(atoms%ntype,nsld))
     304           0 :       ALLOCATE (thisSlab%nslat(atoms%nat,nsld))
     305           0 :       ALLOCATE (thisSlab%zsl(2,nsld))
     306           0 :       ALLOCATE (thisSlab%volsl(nsld))
     307           0 :       ALLOCATE (thisSlab%volintsl(nsld))
     308           0 :       ALLOCATE (thisSlab%qintsl(nsld,dimension%neigd,kpts%nkpt,input%jspins))
     309           0 :       ALLOCATE (thisSlab%qmtsl(nsld,dimension%neigd,kpts%nkpt,input%jspins))
     310             :       CALL slabgeom(atoms,cell,nsld,thisSlab%nsl,thisSlab%zsl,thisSlab%nmtsl,&
     311           0 :                     thisSlab%nslat,thisSlab%volsl,thisSlab%volintsl)
     312             :    ELSE
     313         340 :       ALLOCATE (thisSlab%nmtsl(1,1))
     314         340 :       ALLOCATE (thisSlab%nslat(1,1))
     315         340 :       ALLOCATE (thisSlab%zsl(1,1))
     316         340 :       ALLOCATE (thisSlab%volsl(1))
     317         340 :       ALLOCATE (thisSlab%volintsl(1))
     318         340 :       ALLOCATE (thisSlab%qintsl(1,1,1,input%jspins))
     319         340 :       ALLOCATE (thisSlab%qmtsl(1,1,1,input%jspins))
     320             :    END IF
     321         340 :    thisSlab%nsld = nsld
     322             : 
     323         340 :    thisSlab%nmtsl = 0
     324         340 :    thisSlab%nslat = 0
     325         340 :    thisSlab%zsl = 0.0
     326         340 :    thisSlab%volsl = 0.0
     327         340 :    thisSlab%volintsl = 0.0
     328         340 :    thisSlab%qintsl = 0.0
     329         340 :    thisSlab%qmtsl = 0.0
     330             : 
     331         340 : END SUBROUTINE slab_init
     332             : 
     333             : 
     334        1848 : SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,input,DIMENSION,atoms,noco,jspin,noccbd)
     335             : 
     336             :    USE m_types_setup
     337             : 
     338             :    IMPLICIT NONE
     339             : 
     340             :    CLASS(t_eigVecCoeffs), INTENT(INOUT) :: thisEigVecCoeffs
     341             :    TYPE(t_dimension),     INTENT(IN)    :: dimension
     342             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
     343             :    TYPE(t_noco),          INTENT(IN)    :: noco
     344             :    TYPE(t_input),         INTENT(IN)    :: input
     345             : 
     346             :    INTEGER,               INTENT(IN)    :: jspin, noccbd
     347             : 
     348        1848 :    IF(ALLOCATED(thisEigVecCoeffs%acof)) DEALLOCATE(thisEigVecCoeffs%acof)
     349        1848 :    IF(ALLOCATED(thisEigVecCoeffs%bcof)) DEALLOCATE(thisEigVecCoeffs%bcof)
     350        1848 :    IF(ALLOCATED(thisEigVecCoeffs%ccof)) DEALLOCATE(thisEigVecCoeffs%ccof)
     351             : 
     352        1848 :    IF (noco%l_mperp) THEN
     353           0 :       ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:dimension%lmd,atoms%nat,input%jspins))
     354           0 :       ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:dimension%lmd,atoms%nat,input%jspins))
     355           0 :       ALLOCATE (thisEigVecCoeffs%ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,input%jspins))
     356             :    ELSE
     357        1848 :       ALLOCATE (thisEigVecCoeffs%acof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin))
     358        1848 :       ALLOCATE (thisEigVecCoeffs%bcof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin))
     359        1848 :       ALLOCATE (thisEigVecCoeffs%ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,jspin:jspin))
     360             :    END IF
     361             : 
     362        1848 :    thisEigVecCoeffs%acof = CMPLX(0.0,0.0)
     363        1848 :    thisEigVecCoeffs%bcof = CMPLX(0.0,0.0)
     364        1848 :    thisEigVecCoeffs%ccof = CMPLX(0.0,0.0)
     365             : 
     366        1848 : END SUBROUTINE eigVecCoeffs_init
     367             : 
     368         340 : SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms,kpts)
     369             : 
     370             :    USE m_types_setup
     371             :    USE m_types_kpts
     372             : 
     373             :    IMPLICIT NONE
     374             : 
     375             :    CLASS(t_mcd),          INTENT(INOUT) :: thisMCD
     376             :    TYPE(t_banddos),       INTENT(IN)    :: banddos
     377             :    TYPE(t_dimension),     INTENT(IN)    :: dimension
     378             :    TYPE(t_input),         INTENT(IN)    :: input
     379             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
     380             :    TYPE(t_kpts),          INTENT(IN)    :: kpts
     381             : 
     382         340 :    ALLOCATE (thisMCD%ncore(atoms%ntype))
     383         340 :    ALLOCATE (thisMCD%e_mcd(atoms%ntype,input%jspins,dimension%nstd))
     384         340 :    IF (banddos%l_mcd) THEN
     385           2 :       thisMCD%emcd_lo = banddos%e_mcd_lo
     386           2 :       thisMCD%emcd_up = banddos%e_mcd_up
     387           2 :       ALLOCATE (thisMCD%m_mcd(dimension%nstd,(3+1)**2,3*atoms%ntype,2))
     388           2 :       ALLOCATE (thisMCD%mcd(3*atoms%ntype,dimension%nstd,dimension%neigd,kpts%nkpt,input%jspins) )
     389           2 :       IF (.NOT.banddos%dos) WRITE (*,*) 'For mcd-spectra set banddos%dos=T!'
     390             :    ELSE
     391         338 :       ALLOCATE (thisMCD%m_mcd(1,1,1,1))
     392         338 :       ALLOCATE (thisMCD%mcd(1,1,1,1,input%jspins))
     393             :    ENDIF
     394             : 
     395         340 :    thisMCD%ncore = 0
     396         340 :    thisMCD%e_mcd = 0.0
     397         340 :    thisMCD%mcd = 0.0
     398         340 :    thisMCD%m_mcd = CMPLX(0.0,0.0)
     399             : 
     400         340 : END SUBROUTINE mcd_init1
     401             : 
     402         340 : SUBROUTINE moments_init(thisMoments,input,atoms)
     403             : 
     404             :    USE m_types_setup
     405             : 
     406             :    IMPLICIT NONE
     407             : 
     408             :    CLASS(t_moments),      INTENT(INOUT) :: thisMoments
     409             :    TYPE(t_input),         INTENT(IN)    :: input
     410             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
     411             : 
     412         340 :    ALLOCATE(thisMoments%chmom(atoms%ntype,input%jspins))
     413         340 :    ALLOCATE(thisMoments%clmom(3,atoms%ntype,input%jspins))
     414         340 :    ALLOCATE(thisMoments%qa21(atoms%ntype))
     415             : 
     416         340 :    ALLOCATE(thisMoments%stdn(atoms%ntype,input%jspins))
     417         340 :    ALLOCATE(thisMoments%svdn(atoms%ntype,input%jspins))
     418             : 
     419         948 :    thisMoments%chmom = 0.0
     420         948 :    thisMoments%clmom = 0.0
     421         998 :    thisMoments%qa21 = CMPLX(0.0,0.0)
     422             : 
     423         948 :    thisMoments%stdn = 0.0
     424         948 :    thisMoments%svdn = 0.0
     425             : 
     426         340 : END SUBROUTINE moments_init
     427             : 
     428         340 : SUBROUTINE orbcomp_init(thisOrbcomp,input,banddos,dimension,atoms,kpts)
     429             : 
     430             :    USE m_types_setup
     431             :    USE m_types_kpts
     432             : 
     433             :    IMPLICIT NONE
     434             : 
     435             :    CLASS(t_orbcomp),      INTENT(INOUT) :: thisOrbcomp
     436             :    TYPE(t_input),         INTENT(IN)    :: input
     437             :    TYPE(t_banddos),       INTENT(IN)    :: banddos
     438             :    TYPE(t_dimension),     INTENT(IN)    :: dimension
     439             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
     440             :    TYPE(t_kpts),          INTENT(IN)    :: kpts
     441             : 
     442         340 :    IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
     443           0 :       ALLOCATE(thisOrbcomp%comp(dimension%neigd,23,atoms%nat,kpts%nkpt,input%jspins))
     444           0 :       ALLOCATE(thisOrbcomp%qmtp(dimension%neigd,atoms%nat,kpts%nkpt,input%jspins))
     445             :    ELSE
     446         680 :       ALLOCATE(thisOrbcomp%comp(1,1,1,1,input%jspins))
     447         340 :       ALLOCATE(thisOrbcomp%qmtp(1,1,1,input%jspins))
     448             :    END IF
     449             : 
     450         340 :    thisOrbcomp%comp = 0.0
     451         340 :    thisOrbcomp%qmtp = 0.0
     452             : 
     453         340 : END SUBROUTINE orbcomp_init
     454             : 
     455         608 : SUBROUTINE cdnvalJob_init(thisCdnvalJob,mpi,input,kpts,noco,results,jspin)
     456             : 
     457             :    USE m_types_mpi
     458             :    USE m_types_setup
     459             :    USE m_types_kpts
     460             :    USE m_types_misc
     461             : 
     462             :    IMPLICIT NONE
     463             : 
     464             :    CLASS(t_cdnvalJob),             INTENT(OUT)   :: thisCdnvalJob
     465             :    TYPE(t_mpi),                    INTENT(IN)    :: mpi
     466             :    TYPE(t_input),                  INTENT(IN)    :: input
     467             :    TYPE(t_kpts),                   INTENT(IN)    :: kpts
     468             :    TYPE(t_noco),                   INTENT(IN)    :: noco
     469             :    TYPE(t_results),                INTENT(IN)    :: results
     470             :  
     471             : 
     472             :    INTEGER,                        INTENT(IN)    :: jspin
     473             : 
     474             :    INTEGER :: jsp, iBand, ikpt, nslibd, noccbd_l, noccbd, ikpt_i
     475             : 
     476         608 :    jsp = MERGE(1,jspin,noco%l_noco)
     477             : 
     478         608 :    thisCdnvalJob%l_evp=mpi%n_size>1
     479         608 :    thisCdnvalJob%k_list=mpi%k_list !includes allocate
     480         608 :    thisCdnvalJob%ev_list=mpi%ev_list
     481             :    
     482         608 :    thisCdnvalJob%weights = results%w_iks(:,:,jsp)*2.0/input%jspins
     483             : 
     484         608 :    ALLOCATE(thisCdnvalJob%noccbd(kpts%nkpt))
     485        2764 :    thisCdnvalJob%noccbd = 0
     486             : 
     487             : 
     488             :    ! determine bands to be used for each k point, MPI process
     489        2460 :    DO ikpt_i = 1,SIZE(thisCdnvalJob%k_list)
     490        1852 :       ikpt=thisCdnvalJob%k_list(ikpt_i)
     491             :       !Max number of bands
     492        2460 :       thisCdnvalJob%noccbd(ikpt)= COUNT(thiscdnvaljob%ev_list<=results%neig(ikpt,jsp))
     493             :    ENDDO
     494         608 :  END SUBROUTINE cdnvalJob_init
     495             : 
     496           2 :  SUBROUTINE select_slice(thiscdnvalJob,sliceplot,results,input,kpts,noco,jspin)
     497             :    USE m_types_setup
     498             :    USE m_types_misc
     499             :    USE m_types_kpts
     500             :    IMPLICIT NONE
     501             :    CLASS(t_cdnvalJob),INTENT(INOUT)  :: thisCdnvalJob
     502             :    TYPE(t_sliceplot), INTENT(IN)     :: sliceplot
     503             :    TYPE(t_results),    INTENT(IN)    :: results
     504             :    TYPE(t_input),INTENT(IN)          :: input
     505             :    TYPE(t_kpts),INTENT(IN)           :: kpts
     506             :    TYPE(t_noco),INTENT(IN)           :: noco
     507             :    INTEGER,INTENT(IN)                :: jspin
     508             : 
     509             :    INTEGER :: iband,iband_i,ikpt,ikpt_i,jsp
     510           2 :    jsp = MERGE(1,jspin,noco%l_noco)
     511             : 
     512           8 :    DO ikpt_i=1,SIZE(thiscdnvalJob%k_list)
     513           6 :       ikpt=thiscdnvalJob%k_list(ikpt_i)
     514             :       !--->    if slice, only certain bands are taken into account
     515           6 :       IF (sliceplot%slice.AND.input%pallst) thisCdnvalJob%weights(:,ikpt) = kpts%wtkpt(ikpt)*2.0/input%jspins
     516           8 :       IF (sliceplot%slice.AND.thisCdnvalJob%noccbd(ikpt).GT.0) THEN
     517           6 :          IF (sliceplot%kk.EQ.0) THEN
     518           0 :             DO iband_i=1,thisCdnvalJob%noccbd(ikpt)
     519           0 :                iband=thiscdnvaljob%ev_list(iband_i)
     520           0 :                IF (results%eig(iBand,ikpt,jsp).LT.sliceplot%e1s) thisCdnvalJob%weights(iband,ikpt)=0.0
     521           0 :                IF (results%eig(iBand,ikpt,jsp).GT.sliceplot%e2s) thisCdnvalJob%weights(iband,ikpt)=0.0
     522             :             END DO
     523           6 :          ELSE IF (sliceplot%kk.EQ.ikpt) THEN
     524           2 :             IF ((sliceplot%e1s.EQ.0.0) .AND. (sliceplot%e2s.EQ.0.0)) THEN
     525           0 :                DO iband_i=1,thisCdnvalJob%noccbd(ikpt)
     526           0 :                   iband=thiscdnvaljob%ev_list(iband_i)
     527           0 :                   IF (iBand.NE.sliceplot%nnne) thisCdnvalJob%weights(iband,ikpt)=0.0
     528             :                ENDDO
     529             :             ELSE
     530          40 :                DO iband_i=1,thisCdnvalJob%noccbd(ikpt)
     531          19 :                   iband=thiscdnvaljob%ev_list(iband_i)
     532          19 :                   IF (results%eig(iBand,ikpt,jsp).LT.sliceplot%e1s) thisCdnvalJob%weights(iband,ikpt)=0.0
     533          21 :                   IF (results%eig(iBand,ikpt,jsp).GT.sliceplot%e2s) thisCdnvalJob%weights(iband,ikpt)=0.0
     534             :                END DO
     535             :             END IF
     536             :          ELSE
     537           4 :             thisCdnvalJob%weights(:,ikpt)=0.0
     538             :          END IF
     539             :       END IF ! sliceplot%slice
     540             :    END DO
     541           2 :  END SUBROUTINE select_slice
     542             : 
     543        3704 :  FUNCTION compact_ev_list(thiscdnvaljob,ikpt,l_empty)
     544             :    IMPLICIT NONE
     545             :    CLASS(t_cdnvalJob),INTENT(IN)  :: thisCdnvalJob
     546             :    INTEGER,INTENT(IN)             :: ikpt
     547             :    LOGICAL,INTENT(IN)             :: l_empty
     548             : 
     549             :    INTEGER,ALLOCATABLE :: compact_ev_list(:)
     550             :    INTEGER :: nk
     551             : 
     552        1852 :    nk=thisCdnvalJob%k_list(ikpt)
     553        1852 :    IF (l_empty) THEN
     554         140 :       compact_ev_list=thiscdnvalJob%ev_list(:thisCdnvalJob%noccbd(nk))
     555             :    ELSE
     556             :       compact_ev_list=PACK(thiscdnvalJob%ev_list(:thisCdnvalJob%noccbd(nk)),&
     557        1712 :            thisCdnvalJob%weights(thiscdnvalJob%ev_list(:thisCdnvalJob%noccbd(nk)),nk)>1.e-8)
     558             :    END IF
     559             :  END FUNCTION compact_ev_list
     560             : 
     561             : 
     562        1848 : SUBROUTINE gVacMap_init(thisGVacMap,dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
     563             : 
     564             :    USE m_types_setup
     565             :    USE m_types_lapw
     566             :    USE m_types_enpara
     567             :    USE m_types_potden
     568             :    USE m_types_kpts
     569             :    USE m_nstm3
     570             : 
     571             :    IMPLICIT NONE
     572             : 
     573             :    CLASS(t_gVacMap),      INTENT(INOUT) :: thisGVacMap
     574             :    TYPE(t_dimension),     INTENT(IN)    :: dimension
     575             :    TYPE(t_sym),           INTENT(IN)    :: sym
     576             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
     577             :    TYPE(t_vacuum),        INTENT(IN)    :: vacuum
     578             :    TYPE(t_stars),         INTENT(IN)    :: stars
     579             :    TYPE(t_lapw),          INTENT(IN)    :: lapw
     580             :    TYPE(t_input),         INTENT(IN)    :: input
     581             :    TYPE(t_cell),          INTENT(IN)    :: cell
     582             :    TYPE(t_kpts),          INTENT(IN)    :: kpts
     583             :    TYPE(t_enpara),        INTENT(IN)    :: enpara
     584             :    TYPE(t_potden),        INTENT(IN)    :: vTot
     585             : 
     586             :    INTEGER,               INTENT(IN)    :: ikpt
     587             :    INTEGER,               INTENT(IN)    :: jspin
     588             : 
     589        1848 :    IF (ALLOCATED(thisGVacMap%gvac1d)) DEALLOCATE(thisGVacMap%gvac1d)
     590        1848 :    IF (ALLOCATED(thisGVacMap%gvac2d)) DEALLOCATE(thisGVacMap%gvac2d)
     591             : 
     592        1848 :    ALLOCATE(thisGVacMap%gvac1d(dimension%nv2d))
     593        1848 :    ALLOCATE(thisGVacMap%gvac2d(dimension%nv2d))
     594             : 
     595       46222 :    thisGVacMap%gvac1d = 0
     596       46222 :    thisGVacMap%gvac2d = 0
     597             : 
     598        1848 :    IF (vacuum%nstm.EQ.3.AND.input%film) THEN
     599             :       CALL nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
     600           0 :                  cell,enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),thisGVacMap%gvac1d,thisGVacMap%gvac2d)
     601             :    END IF
     602             : 
     603        1848 : END SUBROUTINE gVacMap_init
     604             : 
     605         608 : END MODULE m_types_cdnval

Generated by: LCOV version 1.13