LCOV - code coverage report
Current view: top level - main - cdngen.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 76 84 90.5 %
Date: 2019-09-08 04:53:50 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             : MODULE m_cdngen
       7             : CONTAINS
       8             : 
       9         340 : SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
      10             :                   dimension,kpts,atoms,sphhar,stars,sym,&
      11             :                   enpara,cell,noco,vTot,results,oneD,coreSpecInput,&
      12             :                   archiveType, xcpot,outDen,EnergyDen)
      13             : 
      14             :    !*****************************************************
      15             :    !    Charge density generator
      16             :    !    calls cdnval to generate the valence charge and the
      17             :    !    core routines for the core contribution
      18             :    !*****************************************************
      19             : 
      20             :    USE m_types
      21             :    USE m_constants
      22             :    USE m_juDFT
      23             :    USE m_prpqfftmap
      24             :    USE m_cdnval
      25             :    USE m_cdn_io
      26             :    USE m_wrtdop
      27             :    USE m_cdntot
      28             :    USE m_qfix
      29             :    USE m_genNewNocoInp
      30             :    USE m_xmlOutput
      31             :    USE m_magMoms
      32             :    USE m_orbMagMoms
      33             :    USE m_cdncore
      34             :    USE m_doswrite
      35             :    USE m_Ekwritesl
      36             :    USE m_banddos_io
      37             :    USE m_metagga
      38             :    USE m_unfold_band_kpts
      39             : #ifdef CPP_MPI
      40             :    USE m_mpi_bc_potden
      41             : #endif
      42             : 
      43             :    IMPLICIT NONE
      44             : 
      45             : #ifdef CPP_MPI
      46             :    INCLUDE 'mpif.h'
      47             : #endif
      48             : 
      49             :    ! Type instance arguments
      50             :    TYPE(t_results),INTENT(INOUT)    :: results
      51             :    TYPE(t_mpi),INTENT(IN)           :: mpi
      52             :    TYPE(t_dimension),INTENT(IN)     :: dimension
      53             :    TYPE(t_oneD),INTENT(IN)          :: oneD
      54             :    TYPE(t_enpara),INTENT(INOUT)     :: enpara
      55             :    TYPE(t_banddos),INTENT(IN)       :: banddos
      56             :    TYPE(t_sliceplot),INTENT(IN)     :: sliceplot
      57             :    TYPE(t_input),INTENT(IN)         :: input
      58             :    TYPE(t_vacuum),INTENT(IN)        :: vacuum
      59             :    TYPE(t_noco),INTENT(INOUT)       :: noco
      60             :    TYPE(t_sym),INTENT(IN)           :: sym
      61             :    TYPE(t_stars),INTENT(IN)         :: stars
      62             :    TYPE(t_cell),INTENT(IN)          :: cell
      63             :    TYPE(t_kpts),INTENT(IN)          :: kpts
      64             :    TYPE(t_sphhar),INTENT(IN)        :: sphhar
      65             :    TYPE(t_atoms),INTENT(IN)         :: atoms
      66             :    TYPE(t_coreSpecInput),INTENT(IN) :: coreSpecInput
      67             :    TYPE(t_potden),INTENT(IN)        :: vTot
      68             :    CLASS(t_xcpot),INTENT(INOUT)     :: xcpot
      69             :    TYPE(t_potden),INTENT(INOUT)     :: outDen, EnergyDen
      70             : 
      71             :    !Scalar Arguments
      72             :    INTEGER, INTENT (IN)             :: eig_id, archiveType
      73             : 
      74             :    ! Local type instances
      75         340 :    TYPE(t_noco)          :: noco_new
      76         340 :    TYPE(t_regionCharges) :: regCharges, fake_regCharges
      77         340 :    TYPE(t_dos)           :: dos, fake_dos
      78         340 :    TYPE(t_moments)       :: moments, fake_moments
      79             :    TYPE(t_results)       :: fake_results
      80         340 :    TYPE(t_mcd)           :: mcd
      81         340 :    TYPE(t_slab)          :: slab
      82         340 :    TYPE(t_orbcomp)       :: orbcomp
      83         340 :    TYPE(t_cdnvalJob)     :: cdnvalJob
      84         680 :    TYPE(t_potden)        :: val_den, core_den
      85             : 
      86             : 
      87             :    !Local Scalars
      88             :    REAL                  :: fix, qtot, dummy,eFermiPrev
      89             :    INTEGER               :: jspin, jspmax, ierr
      90             :    INTEGER               :: dim_idx
      91             : 
      92             : #ifdef CPP_HDF
      93             :    INTEGER(HID_T)        :: banddosFile_id
      94             : #endif
      95             :    LOGICAL               :: l_error, perform_MetaGGA
      96             : 
      97         340 :    CALL regCharges%init(input,atoms)
      98         340 :    CALL dos%init(input,atoms,dimension,kpts,vacuum)
      99         340 :    CALL moments%init(input,atoms)
     100         340 :    CALL mcd%init1(banddos,dimension,input,atoms,kpts)
     101         340 :    CALL slab%init(banddos,dimension,atoms,cell,input,kpts)
     102         340 :    CALL orbcomp%init(input,banddos,dimension,atoms,kpts)
     103             : 
     104         340 :    CALL outDen%init(stars,    atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
     105         340 :    CALL EnergyDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_EnergyDen)
     106             : 
     107         340 :    IF (mpi%irank == 0) CALL openXMLElementNoAttributes('valenceDensity')
     108             : 
     109             :    !In a non-collinear calcuation where the off-diagonal part of the
     110             :    !density matrix in the muffin-tins is calculated, the a- and
     111             :    !b-coef. for both spins are needed at once. Thus, cdnval is only
     112             :    !called once and both spin directions are calculated in a single run.
     113         340 :    results%force=0.0
     114         340 :    jspmax = input%jspins
     115         340 :    IF (noco%l_mperp) jspmax = 1
     116         948 :    DO jspin = 1,jspmax
     117         608 :       CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin)
     118         608 :       IF (sliceplot%slice) CALL cdnvalJob%select_slice(sliceplot,results,input,kpts,noco,jspin)
     119             :       CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
     120         948 :                   sphhar,sym,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,coreSpecInput,mcd,slab,orbcomp)
     121             :    END DO
     122         340 :    call val_den%copyPotDen(outDen)
     123             : 
     124             :    ! calculate kinetic energy density for MetaGGAs
     125         340 :    if(xcpot%exc_is_metagga()) then
     126             :       CALL calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars,&
     127           0 :                              vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen)
     128             :    endif
     129             : 
     130         340 :    IF (mpi%irank == 0) THEN
     131         170 :       IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
     132           7 :          IF (banddos%unfoldband) THEN
     133           0 :             eFermiPrev = 0.0
     134           0 :             CALL readPrevEFermi(eFermiPrev,l_error)
     135           0 :             CALL write_band_sc(kpts,results,eFermiPrev)
     136             :          END IF
     137             : #ifdef CPP_HDF
     138           7 :          CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts,banddos)
     139           7 :          CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
     140           7 :          CALL closeBandDOSFile(banddosFile_id)
     141             : #endif
     142           7 :          CALL timestart("cdngen: dos")
     143           7 :          CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD)
     144           7 :          IF (banddos%dos.AND.(banddos%ndir == -3)) THEN
     145           0 :             CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab,orbcomp,results)
     146             :          END IF
     147           7 :          CALL timestop("cdngen: dos")
     148             :       END IF
     149             :    END IF
     150             : 
     151         340 :    IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK",mpi%irank)
     152         326 :    IF (vacuum%nstm == 3) CALL juDFT_end("VACWAVE OK",mpi%irank)
     153             : 
     154         326 :    IF (mpi%irank.EQ.0) THEN
     155         163 :       CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
     156         163 :       CALL closeXMLElement('valenceDensity')
     157             :    END IF ! mpi%irank = 0
     158             : 
     159         326 :    IF (sliceplot%slice) THEN
     160           2 :       IF (mpi%irank == 0) THEN
     161             :          CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
     162           1 :                            0,-1.0,0.0,.FALSE.,outDen,'cdn_slice')
     163             :       END IF
     164           2 :       CALL juDFT_end("slice OK",mpi%irank)
     165             :    END IF
     166             : 
     167         324 :    CALL timestart("cdngen: cdncore")
     168         324 :    if(xcpot%exc_is_MetaGGA()) then
     169             :       CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
     170           0 :                    stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen)
     171             :    else
     172             :       CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
     173         324 :                    stars,cell,sphhar,atoms,vTot,outDen,moments,results)
     174             :    endif
     175         324 :    call core_den%subPotDen(outDen, val_den)
     176         324 :    CALL timestop("cdngen: cdncore")
     177             : 
     178         324 :    CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)
     179             : 
     180         324 :    IF (mpi%irank == 0) THEN
     181         162 :       CALL openXMLElementNoAttributes('allElectronCharges')
     182         162 :       CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
     183         162 :       CALL closeXMLElement('allElectronCharges')
     184             : 
     185         162 :       IF (input%jspins == 2) THEN
     186         133 :          noco_new = noco
     187             : 
     188             :          !Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
     189         133 :          CALL magMoms(dimension,input,atoms,noco_new,vTot,moments)
     190             : 
     191         133 :          noco = noco_new
     192             : 
     193             :          !Generate and save the new nocoinp file if the directions of the local
     194             :          !moments are relaxed or a constraint B-field is calculated.
     195         133 :          IF (ANY(noco%l_relax(:atoms%ntype)).OR.noco%l_constr) THEN
     196           0 :             CALL genNewNocoInp(input,atoms,noco,noco_new)
     197             :          END IF
     198             : 
     199         133 :          IF (noco%l_soc) CALL orbMagMoms(input,atoms,noco,moments%clmom)
     200             :          
     201             :       END IF
     202             :    END IF ! mpi%irank == 0
     203             :    
     204             :    perform_MetaGGA = ALLOCATED(EnergyDen%mt) &
     205         324 :                    .AND. (xcpot%exc_is_MetaGGA() .or. xcpot%vx_is_MetaGGA())
     206             :    if(perform_MetaGGA) then
     207             :       call set_kinED(mpi, sphhar, atoms, sym, core_den, val_den, xcpot, &
     208           0 :                      input, noco, stars, cell, outDen, EnergyDen, vTot)
     209             :    endif
     210             : #ifdef CPP_MPI
     211         324 :    CALL MPI_BCAST(noco%l_ss,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     212         324 :    CALL MPI_BCAST(noco%l_mperp,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     213         324 :    CALL MPI_BCAST(noco%l_constr,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     214         324 :    CALL MPI_BCAST(noco%mix_b,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     215             : 
     216         324 :    CALL MPI_BCAST(noco%alphInit,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     217         324 :    CALL MPI_BCAST(noco%alph,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     218         324 :    CALL MPI_BCAST(noco%beta,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     219         324 :    CALL MPI_BCAST(noco%b_con,atoms%ntype*2,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     220         324 :    CALL MPI_BCAST(noco%l_relax,atoms%ntype,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     221         324 :    CALL MPI_BCAST(noco%qss,3,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     222             : 
     223         324 :    CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
     224             : #endif
     225             : 
     226         324 : END SUBROUTINE cdngen
     227             : 
     228             : END MODULE m_cdngen

Generated by: LCOV version 1.13