LCOV - code coverage report
Current view: top level - juphon - dfpt_vgen.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 0 55 0.0 %
Date: 2024-05-15 04:28:08 Functions: 0 1 0.0 %

          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_vgen
       7             :    USE m_juDFT
       8             : 
       9             : CONTAINS
      10             : 
      11           0 :    SUBROUTINE dfpt_vgen(hybdat,field,input,xcpot,atoms,sphhar,stars,vacuum,sym,&
      12             :                    juphon, cell,fmpi,noco,nococonv,den,vTot,&
      13             :                    &starsq,dfptdenimag,dfptvTot,l_xc,dfptvTotimag,dfptdenreal,iDtype,iDir,killcont,sigma_disc)
      14             :       !--------------------------------------------------------------------------
      15             :       ! FLAPW potential perturbation generator (main routine)
      16             :       !
      17             :       ! Modification for use with DFPT:
      18             :       ! The density variables in the interstitial now live in a G-expansion
      19             :       ! shifted by q and those in the Muffin Tin are no longer real. Account for
      20             :       ! that with optional arguments: use q-shifted stars and carry the imaginary
      21             :       ! part of the MT-density along explicitely. Changes:
      22             :       ! - The interstitial part and MT real part is in dfptdenreal
      23             :       ! - The MT imaginary part is in dfptdenimag
      24             :       ! - vTot will carry the same quantities for V1 as dfptdenreal for rho1
      25             :       ! - The MT imaginary part is in dfptvTotimag
      26             :       ! - iDtype and iDir tell us where we perturb (atom and direction)
      27             :       ! - den is still den; we need it for additional qlm of surface contributions
      28             :       !--------------------------------------------------------------------------
      29             : 
      30             :       USE m_types
      31             :       USE m_constants
      32             :       USE m_rotate_int_den_tofrom_local
      33             :       USE m_bfield
      34             :       USE m_vgen_coulomb
      35             :       USE m_vgen_xcpot
      36             :       USE m_vgen_finalize
      37             :       USE m_rotate_mt_den_tofrom_local
      38             :       USE m_get_int_perturbation
      39             :       USE m_get_mt_perturbation
      40             :       USE m_dfpt_vgen_finalize
      41             : 
      42             :       IMPLICIT NONE
      43             : 
      44             :       CLASS(t_xcpot),    INTENT(IN)    :: xcpot
      45             :       TYPE(t_hybdat),    INTENT(IN)    :: hybdat
      46             :       TYPE(t_mpi),       INTENT(IN)    :: fmpi
      47             : 
      48             :       TYPE(t_input),     INTENT(IN)    :: input
      49             :       TYPE(t_field),     INTENT(IN)    :: field
      50             :       TYPE(t_vacuum),    INTENT(IN)    :: vacuum
      51             :       TYPE(t_noco),      INTENT(IN)    :: noco
      52             :       TYPE(t_nococonv),  INTENT(IN)    :: nococonv
      53             :       TYPE(t_sym),       INTENT(IN)    :: sym
      54             :       TYPE(t_juphon),    INTENT(IN)    :: juphon
      55             :       TYPE(t_stars),     INTENT(IN)    :: stars
      56             :       TYPE(t_cell),      INTENT(IN)    :: cell
      57             :       TYPE(t_sphhar),    INTENT(IN)    :: sphhar
      58             :       TYPE(t_atoms),     INTENT(IN)    :: atoms
      59             :       TYPE(t_potden),    INTENT(IN)    :: vTot
      60             :       TYPE(t_potden),    INTENT(INOUT) :: den, dfptvTot
      61             : 
      62             :       LOGICAL, INTENT(IN) :: l_xc
      63             : 
      64             :       TYPE(t_stars),  OPTIONAL, INTENT(IN)    :: starsq
      65             :       TYPE(t_potden), OPTIONAL, INTENT(INOUT) :: dfptdenimag, dfptvTotimag, dfptdenreal
      66             : 
      67             :       INTEGER, OPTIONAL, INTENT(IN)           :: iDtype, iDir ! DFPT: Type and direction of displaced atom
      68             : 
      69             :       INTEGER, OPTIONAL, INTENT(IN)           :: killcont(2)
      70             :       complex, OPTIONAL, INTENT(IN)           :: sigma_disc(2)
      71             : 
      72           0 :       TYPE(t_potden)                   :: workden, denRot, workdenImag, workdenReal, den1Rot, den1imRot
      73           0 :       TYPE(t_potden)                   :: vCoul, dfptvCoulimag, vxc, exc, vx, EnergyDen
      74             : 
      75             :       complex                           :: sigma_loc(2)
      76             : 
      77           0 :       vCoul = dfptvTot
      78           0 :       vx = vTot
      79           0 :       vxc = vTot
      80           0 :       exc = vTot
      81           0 :       dfptvCoulimag = dfptvTot
      82             : 
      83           0 :       IF (fmpi%irank==0) WRITE (oUnit,FMT=8000)
      84           0 :       IF (fmpi%irank==0) WRITE (oUnit,FMT=8001)
      85             : 8000  FORMAT (/,/,t10,' p o t e n t i a l   g e n e r a t o r',/)
      86             : 8001  FORMAT (/,/,t10,'          (DFPT edition)              ',/)
      87           0 :       CALL dfptvTot%resetPotDen()
      88           0 :       CALL dfptvTotimag%resetPotDen()
      89           0 :       CALL vCoul%resetPotDen()
      90           0 :       CALL vx%resetPotDen()
      91           0 :       CALL vxc%resetPotDen()
      92           0 :       CALL exc%resetPotDen()
      93           0 :       CALL dfptvCoulimag%resetPotDen()
      94             : 
      95           0 :       ALLOCATE(vx%pw_w,mold=vTot%pw)
      96           0 :       vx%pw_w = 0.0
      97           0 :       ALLOCATE(vxc%pw_w,mold=vTot%pw)
      98           0 :       vxc%pw_w = 0.0
      99           0 :       CALL exc%init(stars, atoms, sphhar, vacuum, noco, 1, 1) !one spin only
     100           0 :       ALLOCATE (exc%pw_w(stars%ng3, 1)); exc%pw_w = 0.0
     101             : 
     102             : #ifndef CPP_OLDINTEL
     103           0 :       ALLOCATE(dfptvTot%pw_w,mold=dfptvTot%pw)
     104           0 :       ALLOCATE(dfptvTotimag%pw_w,mold=dfptvTotimag%pw)
     105             : #else
     106             :       ALLOCATE( dfptvTot%pw_w(size(dfptvTot%pw,1),size(dfptvTot%pw,2)))
     107             :       ALLOCATE( dfptvTotimag%pw_w(size(dfptvTotimag%pw,1),size(dfptvTotimag%pw,2)))
     108             : #endif
     109             : 
     110           0 :       ALLOCATE(vCoul%pw_w(SIZE(vCoul%pw,1),size(vCoul%pw,2)))
     111           0 :       vCoul%pw_w = CMPLX(0.0,0.0)
     112             : 
     113           0 :         CALL workDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0)
     114           0 :         CALL workDenReal%init(starsq,atoms,sphhar,vacuum,noco,input%jspins,0)
     115           0 :         CALL workDenImag%init(starsq,atoms,sphhar,vacuum,noco,input%jspins,0)
     116             : 
     117             :         ! a)
     118             :         ! Sum up both spins in den into workden:
     119           0 :         CALL den%sum_both_spin(workden)
     120           0 :         CALL dfptdenreal%sum_both_spin(workdenReal)
     121           0 :         CALL dfptdenimag%sum_both_spin(workdenImag)
     122             :         ! NOTE: The normal stars are also passed as an optional argument, because
     123             :         !       they are needed for surface-qlm.
     124           0 :         sigma_loc = sigma_disc
     125             :         CALL vgen_coulomb(1,fmpi ,input,field,vacuum,sym,juphon,starsq,cell,sphhar,atoms,.TRUE.,workdenReal,vCoul,sigma_loc,&
     126           0 :                         & dfptdenimag=workdenImag,dfptvCoulimag=dfptvCoulimag,dfptden0=workden,stars2=stars,iDtype=iDtype,iDir=iDir)
     127             : 
     128             :       ! b)
     129           0 :       CALL vCoul%copy_both_spin(dfptvTot)
     130           0 :       CALL dfptvCoulimag%copy_both_spin(dfptvTotimag)
     131             : 
     132             :       ! c)
     133           0 :       CALL denRot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0)
     134           0 :       denRot=den
     135           0 :       CALL den1Rot%init(starsq,atoms,sphhar,vacuum,noco,input%jspins,0)
     136           0 :       CALL den1imRot%init(starsq,atoms,sphhar,vacuum,noco,input%jspins,0)
     137           0 :       den1Rot=dfptdenreal
     138           0 :       den1imRot=dfptdenimag
     139           0 :       IF (noco%l_noco) THEN
     140           0 :          CALL rotate_int_den_to_local(sym,stars,atoms,sphhar,vacuum,cell,input,noco ,denRot)
     141           0 :          IF (any(noco%l_unrestrictMT)) CALL rotate_mt_den_to_local(atoms,sphhar,sym,noco,denrot)
     142             :          !Functions that construct the spin-dependent perturbed densities
     143             :          !from the perturbed charge and (vectorial) magnetization density/
     144             :          !perturbed density matrix. Also saves the perturbed angles.
     145             :          ! TODO: Work on the internal spin logic and add vacuum as well. DFPT_NOCO
     146           0 :           CALL get_int_local_perturbation(sym, stars, atoms, sphhar, input, denRot, den1Rot, den1imRot, starsq)
     147           0 :           IF (any(noco%l_unrestrictMT)) CALL get_mt_local_perturbation(atoms,sphhar,sym,noco,denRot,den1Rot,den1imRot)
     148             :       END IF
     149             : 
     150             :       ! Skip vxc if we want only vC/vExt
     151           0 :          IF (l_xc) CALL vgen_xcpot(hybdat,input,xcpot,atoms,sphhar,stars,vacuum,sym,&
     152             :                         cell,fmpi,noco,den,denRot,EnergyDen,dfptvTot,vx,vxc,exc, &
     153           0 :                         & den1Rot=den1Rot, den1Rotimag=den1imRot, dfptvTotimag=dfptvTotimag,starsq=starsq)
     154             : 
     155           0 :       IF (iDtype/=0.AND.ANY(killcont/=0)) THEN
     156             :          ! d)
     157             :          ! NOTE: This is so different from the base case, that we build a new subroutine.
     158           0 :          CALL dfpt_vgen_finalize(fmpi,atoms,stars,sym,juphon,noco,nococonv,input,sphhar,vTot,dfptvTot,dfptvTotimag,denRot,den1Rot,den1imRot,starsq,killcont)
     159             :          !DEALLOCATE(vcoul%pw_w)
     160             :       ELSE
     161             :          ! TODO: Write here something for the gradient. It does not need pw(_w)-stuff.
     162             :       END IF
     163             : 
     164           0 :       CALL dfptvTot%distribute(fmpi%mpi_comm)
     165           0 :       CALL dfptvTotimag%distribute(fmpi%mpi_comm)
     166             : 
     167           0 :   END SUBROUTINE dfpt_vgen
     168             : 
     169             : END MODULE m_dfpt_vgen

Generated by: LCOV version 1.14