Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2022 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_dfpt_cdngen
       7             : #ifdef CPP_MPI
       8             :    USE mpi
       9             : #endif
      10             : CONTAINS
      11             : 
      12           0 : SUBROUTINE dfpt_cdngen(eig_id,dfpt_eig_id,fmpi,input,banddosdummy,vacuum,&
      13             :                   kpts,atoms,sphhar,starsq,sym,juphon,gfinp,hub1inp,&
      14             :                   enpara,cell,noco,nococonv,vTot,resultsdummy, resultsdummy1,&
      15             :                   archiveType, xcpot,outDen,outDenIm,bqpt,iDtype,iDir,l_real,&
      16             :                   qm_eid_id,dfpt_eigm_id,starsmq,resultsdummy1m)
      17             : 
      18             :    use m_types_vacdos
      19             :    USE m_types
      20             :    USE m_constants
      21             :    USE m_juDFT
      22             :    USE m_dfpt_cdnval
      23             :    USE m_cdn_io
      24             :    USE m_wrtdop
      25             :    USE m_cdncore
      26             : 
      27             :    IMPLICIT NONE
      28             : 
      29             :    ! Type instance arguments
      30             :    TYPE(t_results),INTENT(INOUT)    :: resultsdummy, resultsdummy1
      31             :    TYPE(t_mpi),INTENT(IN)           :: fmpi
      32             :    TYPE(t_enpara),INTENT(IN)        :: enpara
      33             :    TYPE(t_banddos),INTENT(IN)       :: banddosdummy
      34             :    TYPE(t_input),INTENT(IN)         :: input
      35             :    TYPE(t_vacuum),INTENT(IN)        :: vacuum
      36             :    TYPE(t_noco),INTENT(IN)          :: noco
      37             :    TYPE(t_nococonv),INTENT(IN)      :: nococonv
      38             :    TYPE(t_sym),INTENT(IN)           :: sym
      39             :    TYPE(t_juphon),INTENT(IN)        :: juphon
      40             :    TYPE(t_stars),INTENT(IN)         :: starsq
      41             :    TYPE(t_cell),INTENT(IN)          :: cell
      42             :    TYPE(t_kpts),INTENT(IN)          :: kpts
      43             :    TYPE(t_sphhar),INTENT(IN)        :: sphhar
      44             :    TYPE(t_atoms),INTENT(IN)         :: atoms
      45             :    TYPE(t_potden),INTENT(IN)        :: vTot
      46             :    TYPE(t_gfinp),INTENT(IN)         :: gfinp
      47             :    TYPE(t_hub1inp),INTENT(IN)       :: hub1inp
      48             :    CLASS(t_xcpot),INTENT(IN)     :: xcpot
      49             :    TYPE(t_potden),INTENT(INOUT)     :: outDen, outDenIm
      50             : 
      51             :    !Scalar Arguments
      52             :    INTEGER, INTENT(IN)              :: eig_id, dfpt_eig_id, archiveType, iDtype, iDir
      53             :    LOGICAL, INTENT(IN)              :: l_real
      54             : 
      55             :    REAL, INTENT(IN) :: bqpt(3)
      56             : 
      57             :    INTEGER, OPTIONAL, INTENT(IN)    :: qm_eid_id, dfpt_eigm_id
      58             :    TYPE(t_stars), OPTIONAL, INTENT(IN)         :: starsmq
      59             :    TYPE(t_results), OPTIONAL, INTENT(INOUT)    :: resultsdummy1m
      60             : 
      61             :    ! Local type instances
      62             :    TYPE(t_regionCharges)          :: regCharges
      63           0 :    TYPE(t_dos),TARGET             :: dosdummy
      64           0 :    TYPE(t_vacdos),TARGET          :: vacdosdummy
      65           0 :    TYPE(t_moments)                :: moments
      66           0 :    TYPE(t_cdnvalJob)       :: cdnvalJob, cdnvalJob1, cdnvalJob1m
      67             : 
      68             :    !Local Scalars
      69             :    REAL                  :: fix, qtot, dummy,eFermiPrev
      70             :    INTEGER               :: jspin, ierr
      71             :    INTEGER               :: dim_idx
      72             :    INTEGER               :: n, iK
      73             : 
      74             :    LOGICAL               :: l_error,Perform_metagga, l_minusq
      75             : 
      76           0 :    l_minusq = PRESENT(qm_eid_id)
      77             : 
      78             :    ! Initialization section
      79           0 :    CALL moments%init(fmpi,input,sphhar,atoms)
      80             :    
      81             :    !initalize data for DOS
      82           0 :    if (noco%l_noco) resultsdummy%eig(:,:,2)=resultsdummy%eig(:,:,1)
      83           0 :    if (noco%l_noco) resultsdummy1%eig(:,:,2)=resultsdummy1%eig(:,:,1)
      84           0 :    if (noco%l_noco.and.l_minusq) resultsdummy1%eig(:,:,2)=resultsdummy1%eig(:,:,1)
      85           0 :    CALL dosdummy%init(input,atoms,kpts,banddosdummy,resultsdummy%eig)
      86           0 :    CALL vacdosdummy%init(input,atoms,kpts,banddosdummy,resultsdummy%eig)
      87             : 
      88           0 :    CALL timestart("dfpt_cdngen: cdnval")
      89           0 :    DO jspin = 1,merge(1,input%jspins,noco%l_mperp)
      90           0 :       CALL cdnvalJob%init(fmpi,input,kpts,noco,resultsdummy,jspin)
      91           0 :       CALL cdnvalJob1%init(fmpi,input,kpts,noco,resultsdummy1,jspin)
      92           0 :       IF (l_minusq) THEN
      93           0 :          CALL cdnvalJob1m%init(fmpi,input,kpts,noco,resultsdummy1m,jspin)
      94             :          CALL dfpt_cdnval(eig_id, dfpt_eig_id,fmpi,kpts,jspin,noco,nococonv,input,banddosdummy,cell,atoms,enpara,starsq,&
      95             :                           vacuum,sphhar,sym,juphon,vTot,cdnvalJob,outDen,dosdummy,vacdosdummy,&
      96             :                           hub1inp, cdnvalJob1, resultsdummy, resultsdummy1, bqpt, iDtype, iDir, outDenIm, l_real,&
      97           0 :                           qm_eid_id,dfpt_eigm_id,starsmq,resultsdummy1m,cdnvalJob1m)
      98             :       ELSE
      99             :          CALL dfpt_cdnval(eig_id, dfpt_eig_id,fmpi,kpts,jspin,noco,nococonv,input,banddosdummy,cell,atoms,enpara,starsq,&
     100             :                           vacuum,sphhar,sym,juphon,vTot,cdnvalJob,outDen,dosdummy,vacdosdummy,&
     101           0 :                           hub1inp, cdnvalJob1, resultsdummy, resultsdummy1, bqpt, iDtype, iDir, outDenIm, l_real)
     102             :       END IF
     103             :    END DO
     104           0 :    CALL timestop("dfpt_cdngen: cdnval")
     105             : 
     106             :    ! TODO: Implement this appropriately.
     107             :    !CALL timestart("cdngen: cdncore")
     108             :    !CALL cdncore(fmpi,input,vacuum,noco,nococonv,sym,&
     109             :    !             starsq,cell,sphhar,atoms,vTot,outDen,moments,results)
     110             :    !CALL timestop("cdngen: cdncore")
     111             : 
     112             :    ! These should already be broadcast.
     113             : !#ifdef CPP_MPI
     114             : !   CALL MPI_BCAST(nococonv%alph,atoms%ntype,MPI_DOUBLE_PRECISION,0,fmpi%mpi_comm,ierr)
     115             : !   CALL MPI_BCAST(nococonv%beta,atoms%ntype,MPI_DOUBLE_PRECISION,0,fmpi%mpi_comm,ierr)
     116             : !   CALL MPI_BCAST(nococonv%b_con,atoms%ntype*2,MPI_DOUBLE_PRECISION,0,fmpi%mpi_comm,ierr)
     117             : !   CALL MPI_BCAST(nococonv%qss,3,MPI_DOUBLE_PRECISION,0,fmpi%mpi_comm,ierr)
     118             : !#endif
     119           0 :    CALL outDen%distribute(fmpi%mpi_comm)
     120           0 :    CALL outDenIm%distribute(fmpi%mpi_comm)
     121             : 
     122           0 : END SUBROUTINE dfpt_cdngen
     123             : 
     124             : END MODULE m_dfpt_cdngen