LCOV - code coverage report
Current view: top level - cdn - cdnval.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 155 160 96.9 %
Date: 2024-03-29 04:21:46 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 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_cdnval
       8             : 
       9             : USE m_juDFT
      10             : #ifdef CPP_MPI
      11             : use mpi
      12             : #endif
      13             : 
      14             : CONTAINS
      15             : 
      16        1018 : SUBROUTINE cdnval(eig_id, fmpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,enpara,stars,&
      17             :                   vacuum,sphhar,sym,vTot ,cdnvalJob,den,regCharges,dos,vacdos,results,&
      18             :                   moments,gfinp,hub1inp,hub1data,coreSpecInput,mcd,slab,orbcomp,jDOS,greensfImagPart)
      19             : 
      20             :    !************************************************************************************
      21             :    !     This is the FLEUR valence density generator
      22             :    !******** ABBREVIATIONS *************************************************************
      23             :    !     noccbd   : number of occupied bands
      24             :    !     pallst   : if set to .true. bands above the Fermi-Energy are taken into account
      25             :    !     ener     : band energy averaged over all bands and k-points,
      26             :    !                wheighted with the l-like charge of each atom type
      27             :    !     sqal     : l-like charge of each atom type. sum over all k-points and bands
      28             :    !************************************************************************************
      29             : 
      30             :    USE m_types
      31             :    USE m_constants
      32             :    USE m_eig66_io
      33             :    USE m_genMTBasis
      34             :    USE m_calcDenCoeffs
      35             :    USE m_mcdinit
      36             :    USE m_sympsi
      37             :    USE m_eparas      ! energy parameters and partial charges
      38             :    USE m_qal21       ! off-diagonal part of partial charges
      39             :    USE m_abcof
      40             :    USE m_nmat        ! calculate density matrix for LDA + U
      41             :    USE m_nmat21
      42             :    USE m_vacden
      43             :    USE m_pwden
      44             :    USE m_forcea8
      45             :    USE m_force_sf ! Klueppelberg (force level 3)
      46             :    USE m_checkdopall
      47             :    USE m_greensfBZint
      48             :    USE m_greensfCalcImagPart
      49             :    USE m_local_hamiltonian
      50             :    USE m_greensfCalcScalarProducts
      51             :    USE m_cdnmt       ! calculate the density and orbital moments etc.
      52             :    USE m_orbmom      ! coeffd for orbital moments
      53             :    USE m_qmtsl       ! These subroutines divide the input%film into banddos%layers
      54             :    USE m_qintsl      ! (slabs) and intergate the DOS in these banddos%layers
      55             :    USE m_orbcomp     ! calculate orbital composition (like p_x,p_y,p_z)
      56             :    USE m_jDOS
      57             :    USE m_corespec, only : l_cs    ! calculation of core spectra (EELS)
      58             :    USE m_corespec_io, only : corespec_init
      59             :    USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs
      60             :    USE m_xmlOutput
      61             :    USE m_types_dos
      62             :    USE m_types_mcd
      63             :    USE m_types_slab
      64             :    USE m_types_jDOS
      65             :    USE m_types_vacDOS
      66             :    USE m_types_orbcomp
      67             : #ifdef CPP_MPI
      68             :    USE m_mpi_col_den ! collect density data from parallel nodes
      69             : #endif
      70             :    USE m_dfpt_rhomt
      71             :    USE m_dfpt_rhonmt
      72             :    USE m_nIJmat
      73             : 
      74             :    IMPLICIT NONE
      75             : 
      76             :    TYPE(t_results),       INTENT(INOUT) :: results
      77             :    TYPE(t_mpi),           INTENT(IN)    :: fmpi
      78             : 
      79             :    TYPE(t_enpara),        INTENT(IN)    :: enpara
      80             :    TYPE(t_banddos),       INTENT(IN)    :: banddos
      81             :    TYPE(t_input),         INTENT(IN)    :: input
      82             :    TYPE(t_vacuum),        INTENT(IN)    :: vacuum
      83             :    TYPE(t_noco),          INTENT(IN)    :: noco
      84             :    TYPE(t_nococonv),      INTENT(IN)    :: nococonv
      85             :    TYPE(t_sym),           INTENT(IN)    :: sym
      86             :    TYPE(t_stars),         INTENT(IN)    :: stars
      87             :    TYPE(t_cell),          INTENT(IN)    :: cell
      88             :    TYPE(t_kpts),          INTENT(IN)    :: kpts
      89             :    TYPE(t_sphhar),        INTENT(IN)    :: sphhar
      90             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
      91             :    TYPE(t_gfinp),         INTENT(IN)    :: gfinp
      92             :    TYPE(t_hub1inp),       INTENT(IN)    :: hub1inp
      93             :    TYPE(t_potden),        INTENT(IN)    :: vTot
      94             :    TYPE(t_cdnvalJob),     INTENT(IN)    :: cdnvalJob
      95             :    TYPE(t_potden),        INTENT(INOUT) :: den
      96             :    TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
      97             :    TYPE(t_dos),           INTENT(INOUT) :: dos
      98             :    TYPE(t_vacdos),        INTENT(INOUT) :: vacdos
      99             :    TYPE(t_moments),       INTENT(INOUT) :: moments
     100             :    TYPE(t_hub1data),       OPTIONAL, INTENT(INOUT) :: hub1data
     101             :    TYPE(t_coreSpecInput),  OPTIONAL, INTENT(IN)    :: coreSpecInput
     102             :    TYPE(t_mcd),            OPTIONAL, INTENT(INOUT) :: mcd
     103             :    TYPE(t_slab),           OPTIONAL, INTENT(INOUT) :: slab
     104             :    TYPE(t_orbcomp),        OPTIONAL, INTENT(INOUT) :: orbcomp
     105             :    TYPE(t_jDOS),           OPTIONAL, INTENT(INOUT) :: jDOS
     106             :    TYPE(t_greensfImagPart),OPTIONAL, INTENT(INOUT) :: greensfImagPart
     107             : 
     108             :    ! Scalar Arguments
     109             :    INTEGER,               INTENT(IN)    :: eig_id, jspin
     110             : 
     111             :    ! Local Scalars
     112             :    INTEGER :: ikpt,ikpt_i,jsp_start,jsp_end,ispin,jsp,max_length_k_list,nk
     113             :    INTEGER :: iErr,nbands,noccbd,iType
     114             :    INTEGER :: skip_t,skip_tt,nbasfcn
     115             :    LOGICAL :: l_real, l_corespec, l_empty
     116             : 
     117             :    ! Local Arrays
     118        1018 :    REAL,    ALLOCATABLE  :: we(:),eig(:)
     119             :    REAL                  :: bkpt(3)
     120        1018 :    INTEGER, ALLOCATABLE  :: ev_list(:)
     121        1018 :    REAL,    ALLOCATABLE  :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
     122             : 
     123        1018 :    TYPE (t_lapw)              :: lapw
     124        1018 :    TYPE (t_orb)               :: orb
     125        1018 :    TYPE (t_denCoeffs)         :: denCoeffs
     126        1018 :    TYPE (t_denCoeffsOffdiag)  :: denCoeffsOffdiag
     127        1018 :    TYPE (t_force)             :: force
     128        1018 :    TYPE (t_eigVecCoeffs)      :: eigVecCoeffs
     129        1018 :    TYPE (t_usdus)             :: usdus
     130        1018 :    TYPE (t_mat)               :: zMat
     131        1018 :    TYPE (t_gVacMap)           :: gVacMap
     132        1018 :    TYPE (t_tlmplm)            :: tlmplm
     133        1018 :    TYPE (t_greensfBZintCoeffs):: greensfBZintCoeffs
     134        1018 :    TYPE(t_scalarGF), ALLOCATABLE :: scalarGF(:)
     135             : 
     136        1018 :    CALL timestart("cdnval")
     137             : 
     138        1018 :    call timestart("init")
     139        1018 :    l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco).AND.atoms%n_hia==0
     140             : 
     141             :    ! Klueppelberg (force level 3)
     142        1018 :    IF (input%l_f.AND.(input%f_level.GE.3)) THEN
     143           2 :       CALL init_sf(sym,cell,atoms)
     144             :    END IF
     145             : 
     146        1018 :    IF (noco%l_mperp.OR.banddos%l_jDOS) THEN
     147             :       ! when the off-diag. part of the density matrix, i.e. m_x and
     148             :       ! m_y, is calculated inside the muffin-tins (l_mperp = T), cdnval
     149             :       ! is called only once. therefore, several spin loops have been
     150             :       ! added. if l_mperp = F, these loops run only from jspin - jspin.
     151          60 :       jsp_start = 1
     152          60 :       jsp_end   = 2
     153             :    ELSE
     154         958 :       jsp_start = jspin
     155         958 :       jsp_end   = jspin
     156             :    END IF
     157             : 
     158             :    !Do we need to consider the unoccupied states
     159        1018 :    l_empty = banddos%dos.or.banddos%band
     160        1018 :    IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
     161         160 :       l_empty = l_empty.OR.greensfImagPart%l_calc
     162             :    ENDIF
     163             : 
     164        5090 :    ALLOCATE (f(atoms%jmtd,2,0:atoms%lmaxd,input%jspins)) ! Deallocation before mpi_col_den
     165        4072 :    ALLOCATE (g(atoms%jmtd,2,0:atoms%lmaxd,input%jspins))
     166        5090 :    ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,input%jspins))
     167             : 
     168             :    ! Initializations
     169        1018 :    CALL usdus%init(atoms,input%jspins)
     170        1018 :    CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end)
     171             :    ! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet.
     172             :    ! density without the atomic sphere approximation for the magnet. density.
     173        2836 :    CALL denCoeffsOffdiag%init(atoms,noco,sphhar,banddos%l_jDOS,any(noco%l_unrestrictMT).OR.noco%l_mperp)
     174        1018 :    CALL force%init1(input,atoms)
     175        1018 :    CALL orb%init(atoms,noco,jsp_start,jsp_end)
     176             : 
     177             :    !Greens function always considers the empty states
     178        1018 :    IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
     179          80 :       IF(greensfImagPart%l_calc) THEN
     180          80 :          CALL greensfBZintCoeffs%init(gfinp,atoms,noco,SIZE(cdnvalJob%ev_list))
     181             :          CALL greensfCalcScalarProducts(gfinp,atoms,input,enpara,noco,sphhar,vTot,fmpi,hub1data=hub1data,&
     182          80 :                                         scalarProducts=scalarGF)
     183             :       ENDIF
     184             :    ENDIF
     185             : 
     186             : 
     187        1018 :    IF (denCoeffsOffdiag%l_fmpl.AND.(.NOT.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval")
     188        1018 :    IF (banddos%l_mcd.AND..NOT.PRESENT(mcd)) CALL juDFT_error("mcd is missing",calledby ="cdnval")
     189             : 
     190             :    ! calculation of core spectra (EELS) initializations -start-
     191        1018 :    l_coreSpec = .FALSE.
     192        1018 :    IF (PRESENT(coreSpecInput)) THEN
     193        1018 :       CALL corespec_init(input,atoms,coreSpecInput)
     194        1018 :       IF(l_cs.AND.(fmpi%isize.NE.1)) CALL juDFT_error('EELS + fmpi not implemented', calledby = 'cdnval')
     195        1018 :       IF(l_cs.AND.jspin.EQ.1) CALL corespec_gaunt()
     196        1018 :       l_coreSpec = l_cs
     197             :    END IF
     198             :    ! calculation of core spectra (EELS) initializations -end-
     199             : 
     200        1018 :    IF (fmpi%irank==0) THEN
     201         509 :       WRITE (oUnit,FMT=8000) jspin
     202        1527 :       CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
     203             :    END IF
     204             : 8000 FORMAT (/,/,10x,'valence density: spin=',i2)
     205             : 
     206        2812 :    DO iType = 1, atoms%ntype
     207        4840 :       DO ispin = 1, input%jspins
     208             :          CALL genMTBasis(atoms,enpara,vTot,fmpi,iType,ispin,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin),&
     209        4840 :                          hub1data=hub1data)
     210             :       END DO
     211        1794 :       IF (noco%l_mperp.OR.banddos%l_jDOS) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
     212        1794 :       IF (banddos%l_mcd) CALL mcd_init(atoms,banddos,input,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
     213        1794 :       IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,29,input%jspins,jspin,results%ef,&
     214        1018 :                                         atoms%msh,vTot%mt(:,0,:,:),f,g)
     215             :    END DO
     216        1018 :    DEALLOCATE (f,g,flo)
     217             : 
     218        2812 :    skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
     219        1018 :    IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt
     220             : 
     221        1018 :    jsp = MERGE(1,jspin,noco%l_noco)
     222        1018 :    call timestop("init")
     223             : 
     224        1018 :    max_length_k_list=size(cdnvalJob%k_list)
     225             : #ifdef CPP_MPI   
     226        1018 :    CALL MPI_ALLREDUCE(MPI_IN_PLACE,max_length_k_list,1,MPI_INTEGER,MPI_MAX,fmpi%mpi_comm,ierr)
     227             : #endif
     228        8664 :    DO ikpt_i = 1,size(cdnvalJob%k_list)
     229        7646 :       ikpt=cdnvalJob%k_list(ikpt_i)
     230       30584 :       bkpt=kpts%bk(:,ikpt)
     231             : 
     232        7646 :       CALL lapw%init(input,noco,nococonv, kpts,atoms,sym,ikpt,cell, fmpi)
     233        7646 :       skip_t = skip_tt
     234      115431 :       ev_list=cdnvaljob%compact_ev_list(ikpt_i,l_empty)
     235        7646 :       noccbd = SIZE(ev_list)
     236      115431 :       we  = cdnvalJob%weights(ev_list,ikpt)
     237      115431 :       eig = results%eig(ev_list,ikpt,jsp)
     238             : 
     239        7646 :       IF (cdnvalJob%l_evp) THEN
     240       69523 :          IF (minval(ev_list) > skip_tt) skip_t = 0
     241       69523 :          IF (maxval(ev_list) <= skip_tt) skip_t = noccbd
     242      139046 :          IF ((minval(ev_list) <= skip_tt).AND.(maxval(ev_list) > skip_tt)) skip_t = mod(skip_tt,noccbd)
     243             :       END IF
     244             : 
     245        7646 :       nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
     246        7646 :       CALL zMat%init(l_real,nbasfcn,noccbd)
     247        7646 :       CALL read_eig(eig_id,ikpt,jsp,list=ev_list,neig=nbands,zmat=zMat)
     248             : #ifdef CPP_MPI
     249        7646 :       CALL MPI_BARRIER(fmpi%mpi_comm,iErr) ! Synchronizes the RMA operations
     250             : #endif
     251             : 
     252        7646 :       IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called
     253             : 
     254             :       ! valence density in the atomic spheres
     255        8018 :       CALL eigVecCoeffs%init(input,atoms,jspin,noccbd,noco%l_mperp.OR.banddos%l_jDOS)
     256             : 
     257       15660 :       DO ispin = jsp_start, jsp_end
     258        8018 :          IF (input%l_f) CALL force%init2(noccbd,input,atoms)
     259             :          CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,nococonv,ispin,&
     260             :                     eigVecCoeffs%abcof(:,0:,0,:,ispin),eigVecCoeffs%abcof(:,0:,1,:,ispin),&
     261        8018 :                     eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
     262             : 
     263        8018 :          IF (atoms%n_u+atoms%n_opc.GT.0) CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,ispin))
     264        8018 :          IF (atoms%n_v.GT.0) CALL nIJ_mat(input,atoms,noccbd,usdus,ispin,we,eigVecCoeffs,cell,kpts,ikpt,den%nIJ_llp_mmp(:,:,:,ispin),enpara,vTot)
     265        8018 :          IF (atoms%n_u.GT.0.AND.noco%l_mperp.AND.(ispin==jsp_end)) THEN
     266           0 :             call timestart("n_mat21")
     267           0 :             CALL n_mat21(atoms,sym,noccbd,we,denCoeffsOffdiag,eigVecCoeffs,den%mmpMat(:,:,:,3))
     268           0 :             call timestop("n_mat21")
     269             : 
     270             :          ENDIF
     271             :          ! perform Brillouin zone integration and summation over the
     272             :          ! bands in order to determine the energy parameters for each atom and angular momentum
     273        8018 :          call timestart("eparas")
     274             :          CALL eparas(ispin,atoms,banddos,noccbd,ev_list,fmpi,ikpt,noccbd,we,eig,&
     275        8018 :                      skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,mcd)
     276             : 
     277        8018 :          call timestop("eparas")
     278        8018 :          IF (noco%l_mperp.AND.(ispin==jsp_end)) then
     279         374 :            call timestart("qal_21")
     280         374 :            CALL qal_21(atoms,banddos,input,noccbd,ev_list,nococonv,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
     281         374 :            call timestop("qal_21")
     282             :          endif
     283             : 
     284             :          ! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
     285        8018 :          IF (PRESENT(slab).and.banddos%l_slab) CALL q_mt_sl(ispin,atoms,sym,noccbd,ev_list,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
     286             : 
     287        8018 :          IF(banddos%l_orb) THEN
     288             : 
     289          20 :            IF (PRESENT(orbcomp)) CALL orb_comp(banddos,ispin,ikpt,noccbd,ev_list,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
     290             :          ENDIF
     291             :          !Decomposition into total angular momentum states
     292        8018 :          IF(banddos%dos.AND.banddos%l_jDOS) THEN
     293           4 :             IF(PRESENT(jDOS).AND.ispin==jsp_end) THEN
     294             :                CALL jDOS_comp(ikpt,noccbd,ev_list,we,atoms,banddos,input,usdus,&
     295           2 :                               denCoeffsOffdiag,eigVecCoeffs,jDOS)
     296             :             ENDIF
     297             :          ENDIF
     298        8018 :          CALL dfpt_rhomt(atoms,we,we,noccbd,ispin,ispin,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
     299        8018 :          CALL dfpt_rhonmt(atoms,sphhar,we,we,noccbd,ispin,ispin,[0.0,0.0,0.0],.FALSE.,.TRUE.,sym,eigVecCoeffs,eigVecCoeffs,denCoeffs)
     300        8018 :          CALL dfpt_rhomtlo(atoms,noccbd,we,we,ispin,ispin,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
     301        8018 :          CALL dfpt_rhonmtlo(atoms,sphhar,sym,noccbd,we,we,eigVecCoeffs,eigVecCoeffs,denCoeffs,ispin,ispin,.FALSE.,[0.0,0.0,0.0])
     302             : 
     303        8018 :          IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
     304        8018 :          IF (input%l_f) THEN
     305          62 :            call local_ham(sphhar,atoms,sym,noco,nococonv,enpara,fmpi,vtot,vtot,den,input,hub1inp,hub1data,tlmplm,usdus,0.0)
     306             :            CALL force%addContribsA21A12(input,atoms,sym,cell ,enpara,&
     307          62 :            usdus,tlmplm,vtot,eigVecCoeffs,noccbd,ispin,eig,we,results,jsp_start,jspin,nbasfcn,zMat,lapw,sphhar,lapw%gvec(1,:,:),lapw%gvec(2,:,:),lapw%gvec(3,:,:),bkpt)
     308             :          ENDIF
     309        8018 :          IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,atoms%lmaxd*(atoms%lmaxd+2),kpts%nkpt,ikpt,input%neig,&
     310        7642 :                                           noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs)
     311             :       END DO ! end loop over ispin
     312        7642 :       IF (noco%l_mperp) then
     313         374 :         call timestart("denCoeffsOffdiag%calcCoefficients")
     314         374 :         CALL dfpt_rhomt(atoms,we,we,noccbd,2,1,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
     315         374 :         CALL dfpt_rhonmt(atoms,sphhar,we,we,noccbd,2,1,[0.0,0.0,0.0],.FALSE.,.FALSE.,sym,eigVecCoeffs,eigVecCoeffs,denCoeffs)
     316         374 :         CALL dfpt_rhomtlo(atoms,noccbd,we,we,2,1,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
     317         374 :         CALL dfpt_rhonmtlo(atoms,sphhar,sym,noccbd,we,we,eigVecCoeffs,eigVecCoeffs,denCoeffs,2,1,.FALSE.,[0.0,0.0,0.0])
     318         374 :         call timestop("denCoeffsOffdiag%calcCoefficients")
     319             :       endif
     320             : 
     321        7642 :       IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
     322         448 :          IF(greensfImagPart%l_calc) THEN
     323        1792 :             do ispin = MERGE(1,jsp_start,gfinp%l_mperp),MERGE(3,jsp_end,gfinp%l_mperp)
     324             :                CALL greensfBZint(ikpt,noccbd,ispin,gfinp,sym,atoms,noco,nococonv,input,kpts,&
     325         456 :                                  scalarGF,eigVecCoeffs,greensfBZintCoeffs)
     326             :                CALL greensfCalcImagPart_single_kpt(ikpt,ikpt_i,ev_list,ispin,gfinp,atoms,input,kpts,noco,fmpi,&
     327         904 :                                  results,greensfBZintCoeffs,greensfImagPart)
     328             :             enddo
     329             :          ENDIF
     330             :       ENDIF
     331             : 
     332        7642 :       CALL gVacMap%init(sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
     333             : 
     334             :       ! valence density in the interstitial and vacuum region has to be called only once (if jspin=1) in the non-collinear case
     335        7642 :       IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN
     336             :          ! valence density in the interstitial region
     337             :          CALL pwden(stars,kpts,banddos ,input,fmpi,noco,nococonv,cell,atoms,sym,ikpt,&
     338        7322 :                     jspin,lapw,noccbd,ev_list,we,eig,den,results,force%f_b8,zMat,dos)
     339             :          ! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
     340        7322 :          IF (PRESENT(slab).AND.banddos%l_slab) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,ev_list,lapw,slab ,zMat)
     341             :          ! valence density in the vacuum region
     342        7322 :          IF (input%film) THEN
     343             :             CALL vacden(vacuum,stars,input,cell,atoms,noco,nococonv,banddos,&
     344      106776 :                         we,ikpt,jspin,REAL(vTot%vac(:,1,:,:)),noccbd,ev_list,lapw,enpara%evac,den,zMat,vacdos,dos)
     345             :          END IF
     346             :       END IF
     347        7642 :       IF (input%film) CALL regCharges%sumBandsVac(vacuum,vacdos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
     348             : 
     349        8664 :       IF (.FALSE..AND.(banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN
     350             :          ! since z is no longer an argument of cdninf sympsi has to be called here!
     351             :          CALL sympsi(lapw,jspin,sym,noccbd,cell,eig,noco,dos%jsym(:,ikpt,jspin),zMat)
     352             :       END IF
     353             :    END DO ! end of k-point loop
     354             : 
     355             : #ifdef CPP_MPI
     356             :    !print *,"Remaining Barriers:",size(cdnvalJob%k_list)+1,max_length_k_list
     357        1018 :    DO nk=size(cdnvalJob%k_list)+1,max_length_k_list
     358        1018 :       CALL MPI_BARRIER(fmpi%MPI_COMM,ierr)
     359             :    ENDDO
     360        2096 :    DO ispin = jsp_start,jsp_end
     361             :       CALL mpi_col_den(fmpi,sphhar,atoms ,stars,vacuum,input,noco,ispin,dos,vacdos,&
     362        2096 :                        results,denCoeffs,orb,denCoeffsOffdiag,den,regCharges,mcd,slab,orbcomp,jDOS)
     363             :    END DO
     364             : #endif
     365             : 
     366        1018 :    IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
     367          80 :       IF(greensfImagPart%l_calc) THEN
     368          80 :          call timestart("Green's function: Imag Part collect")
     369         320 :          do ispin = MERGE(1,jsp_start,gfinp%l_mperp),MERGE(3,jsp_end,gfinp%l_mperp)
     370         168 :             CALL greensfImagPart%collect(ispin,fmpi%mpi_comm)
     371             :          enddo
     372          80 :          call timestop("Green's function: Imag Part collect")
     373             :       ENDIF
     374             :    ENDIF
     375             : 
     376        1018 :    IF (fmpi%irank==0) THEN
     377         509 :       CALL timestart("cdnmt")
     378             :       CALL cdnmt(input%jspins,input,atoms,sym,sphhar,noco,jsp_start,jsp_end,enpara,banddos,&
     379     1138354 :                  vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,den%mt,hub1inp,moments,jDOS,hub1data=hub1data)
     380         509 :       CALL timestop("cdnmt")
     381         509 :       IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
     382        1048 :       DO ispin = jsp_start,jsp_end
     383         539 :          IF (input%cdinf) THEN
     384           0 :             WRITE (oUnit,FMT=8210) ispin
     385             : 8210        FORMAT (/,5x,'check continuity of cdn for spin=',i2)
     386           0 :             CALL checkDOPAll(input,sphhar,stars,atoms,sym,vacuum ,cell,den,ispin)
     387             :          END IF
     388        1048 :          IF (input%l_f) CALL force_a8(input,atoms,sym,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,fmpi,results)
     389             :       END DO
     390         509 :       CALL closeXMLElement('mtCharges')
     391             :    END IF
     392             : 
     393        1018 :    CALL timestop("cdnval")
     394             : 
     395        3046 : END SUBROUTINE cdnval
     396             : 
     397             : END MODULE m_cdnval

Generated by: LCOV version 1.14