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_vgen_finalize
       7             :    USE m_juDFT
       8             :    USE m_xcBfield
       9             :    USE m_plot
      10             :    USE m_constants
      11             :    USE m_lattHarmsSphHarmsConv
      12             : 
      13             : CONTAINS
      14             : 
      15         688 :    SUBROUTINE vgen_finalize(fmpi ,field,cell,atoms,stars,vacuum,sym,juphon,noco,nococonv,input,xcpot,sphhar,vTot,vCoul,denRot,sliceplot)
      16             :       !--------------------------------------------------------------------------
      17             :       ! FLAPW potential generator (finalization)
      18             :       !
      19             :       ! Non-noco: Some rescaling is done here.
      20             :       !
      21             :       ! Noco: rotate_int_den_from_local is called to generate 2x2 interstitial V matrix.
      22             :       !
      23             :       ! Fully fully noco: rotate_mt_den_from_local does so for the Muffin Tins.
      24             :       !
      25             :       ! Sourcefree: The xc-B-field is scaled up an source terms are purged out.
      26             :       !--------------------------------------------------------------------------
      27             :       USE m_types
      28             :       USE m_constants
      29             :       USE m_rotate_int_den_tofrom_local
      30             :       USE m_rotate_mt_den_tofrom_local
      31             :       USE m_magnMomFromDen
      32             : 
      33             :       IMPLICIT NONE
      34             : 
      35             :       TYPE(t_mpi),      INTENT(IN)    :: fmpi
      36             :        
      37             :       TYPE(t_field),    INTENT(IN)    :: field
      38             :       TYPE(t_cell),     INTENT(IN)    :: cell
      39             :       TYPE(t_vacuum),   INTENT(IN)    :: vacuum
      40             :       TYPE(t_noco),     INTENT(IN)    :: noco
      41             :       TYPE(t_nococonv), INTENT(INOUT) :: nococonv
      42             :       TYPE(t_sym),      INTENT(IN)    :: sym
      43             :       TYPE(t_juphon),   INTENT(IN)    :: juphon    
      44             :       TYPE(t_stars),    INTENT(IN)    :: stars
      45             :       TYPE(t_atoms),    INTENT(IN)    :: atoms
      46             :       TYPE(t_input),    INTENT(IN)    :: input
      47             :       CLASS(t_xcpot),   INTENT(IN)    :: xcpot
      48             :       TYPE(t_sphhar),   INTENT(IN)    :: sphhar
      49             :       TYPE(t_potden),   INTENT(INOUT) :: vTot, vCoul, denRot
      50             :       TYPE(t_sliceplot), INTENT(IN)   :: sliceplot
      51             : 
      52         688 :       TYPE(t_potden)                  :: vScal, vCorr, vxcForPlotting
      53       36464 :       TYPE(t_potden), DIMENSION(3)    :: bxc
      54             : 
      55             :       INTEGER                         :: i, js, n, lh, nat, nd
      56         688 :       REAL                            :: sfscale, r2(atoms%jmtd)
      57         688 :       REAL                            :: b(3,atoms%ntype), dummy1(atoms%ntype), dummy2(atoms%ntype)
      58             :       REAL, ALLOCATABLE               :: intden(:,:)
      59             : 
      60         688 :       IF (.NOT.noco%l_noco) THEN
      61             :          ! Rescale vTot%pw_w with number of stars:
      62        1198 :          DO js=1,SIZE(vtot%pw_w,2)
      63     1171710 :             DO i=1,stars%ng3
      64     1171214 :                vTot%pw_w(i,js)=vtot%pw_w(i,js) / stars%nstr(i)
      65             :             END DO
      66             :          END DO
      67             :       ELSE IF(noco%l_noco) THEN
      68             :          ! Rotate interstital potential back to global frame:
      69         192 :          CALL rotate_int_den_from_local(stars,atoms,vacuum,sym,input,denRot,vTot)
      70         460 :          IF (any(noco%l_unrestrictMT)) THEN
      71             :             ! Rotate Muffin Tin potential back to global frame:
      72          22 :             CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,noco,vtot)
      73             :          END IF
      74             :       END IF
      75             : 
      76        1874 :       IF (any(noco%l_unrestrictMT).AND.noco%l_scaleMag) THEN
      77           2 :          sfscale=noco%mag_scale
      78           2 :          CALL vTot%SpinsToChargeAndMagnetisation()
      79      736796 :          vTot%mt(:,0:,:,  2:4) = sfscale*vTot%mt(:,0:,:,2:4)
      80       12290 :          vTot%pw(:,       2:3) = sfscale*vTot%pw(:,     2:3)
      81          14 :          vTot%vac(:,:,:,2:3) = sfscale*vTot%vac(:,:,:,2:3)
      82           2 :          CALL vTot%ChargeAndMagnetisationToSpins()
      83             :       END IF
      84             : 
      85        1874 :       IF (any(noco%l_unrestrictMT).AND.noco%l_sourceFree) THEN
      86             : 
      87           2 :          IF (fmpi%irank == 0) THEN
      88           1 :             CALL magnMomFromDen(input,atoms,noco,vTot,b,dummy1,dummy2)
      89           3 :             DO i=1,atoms%ntype
      90           3 :                WRITE (oUnit,8025) i,b(1,i),b(2,i),b(3,i),SQRT(b(1,i)**2+b(2,i)**2+b(3,i)**2)
      91             :                8025 FORMAT(2x,'Bfield before SF [local frame, atom ',i2,']: ','Bx=',f9.5,' By=',f9.5,' Bz=',f9.5,' |B|=',f9.5)
      92             :             END DO
      93             :          END IF
      94             : 
      95           2 :          CALL timestart("Purging source terms in B-field")
      96             : 
      97           2 :          CALL timestart("Building B")
      98           2 :          CALL makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,nococonv,vTot,2.0,vScal,bxc,cell)
      99           2 :          CALL timestop("Building B")
     100             : 
     101           2 :          CALL timestart("SF subroutine")
     102           2 :          CALL sourcefree(fmpi,field,stars,atoms,sphhar,vacuum,input ,sym,juphon,cell,noco,bxc,vScal,vCorr)
     103           2 :          CALL timestop("SF subroutine")
     104             : 
     105           2 :          CALL timestart("Correcting vTot")
     106             : 
     107          10 :          DO js=1,4
     108          26 :             DO i=1,atoms%ntype
     109        1320 :                DO lh=0, sphhar%nlh(sym%ntypsy(atoms%firstAtom(i)))
     110      982368 :                   r2=atoms%rmsh(:,i)**2
     111      982384 :                   vCorr%mt(:,lh,i,js) = vCorr%mt(:,lh,i,js)/r2
     112             :                END DO !lh
     113             :             END DO !i
     114             :          END DO !js
     115             : 
     116           2 :          vTot=vCorr
     117             : 
     118           2 :          CALL timestop("Correcting vTot")
     119             : 
     120           2 :          CALL timestop("Purging source terms in B-field")
     121             : 
     122           2 :          IF (fmpi%irank == 0) THEN
     123           1 :             CALL magnMomFromDen(input,atoms,noco,vTot,b,dummy1,dummy2)
     124           3 :             DO i=1,atoms%ntype
     125           3 :                WRITE (oUnit,8026) i,b(1,i),b(2,i),b(3,i),SQRT(b(1,i)**2+b(2,i)**2+b(3,i)**2)
     126             :                8026 FORMAT(2x,'Bfield after SF [local frame, atom ',i2,']: ','Bx=',f9.5,' By=',f9.5,' Bz=',f9.5,' |B|=',f9.5)
     127             :             END DO
     128             :          END IF
     129             : 
     130             :       END IF
     131             : 
     132         688 :       IF (sliceplot%iplot.NE.0) THEN
     133             :          CALL makeplots(stars, atoms, sphhar, vacuum, input, fmpi , sym, cell, &
     134           0 :                         noco,nococonv, vTot, PLOT_POT_TOT, sliceplot)
     135             :          CALL makeplots(stars, atoms, sphhar, vacuum, input, fmpi , sym, cell, &
     136           0 :                         noco,nococonv, vCoul, PLOT_POT_COU, sliceplot)
     137           0 :          CALL vxcForPlotting%copyPotDen(vTot)
     138           0 :          CALL subPotDen(vxcForPlotting,vTot,vCoul)
     139             :          CALL makeplots(stars, atoms, sphhar, vacuum, input, fmpi , sym, cell, &
     140           0 :                         noco,nococonv, vxcForPlotting, PLOT_POT_VXC, sliceplot)
     141           0 :          IF ((fmpi%irank.EQ.0).AND.(sliceplot%iplot.LT.32).AND.(MODULO(sliceplot%iplot,2).NE.1)) THEN
     142           0 :             CALL juDFT_end("Stopped self consistency loop after plots have been generated.")
     143             :          END IF
     144             :       END IF
     145             : 
     146             :       ! Store vTot(L=0) component as r*vTot(L=0)/sqrt(4*pi):
     147             :       ! (Used input%jspins instead of SIZE(vtot%mt,4) since
     148             :       ! the off diagonal part of VTot%mt needs no rescaling!)
     149        1774 :       DO js = 1, input%jspins
     150        3668 :          DO n = 1, atoms%ntype
     151     1300518 :             vTot%mt(:atoms%jri(n),0,n,js)  = atoms%rmsh(:atoms%jri(n),n)*vTot%mt(:atoms%jri(n),0,n,js)/sfp_const
     152             :          END DO ! n
     153             :       END DO ! js
     154             : 
     155             :       ! Rescale vCoul%pw_w with number of stars:
     156             :       ! (This normalization is needed for gw!)
     157        1966 :       DO js = 1, SIZE(vCoul%pw_w,2)
     158     3085170 :          DO i = 1, stars%ng3
     159     3084482 :             vCoul%pw_w(i,js) = vCoul%pw_w(i,js) / stars%nstr(i)
     160             :          END DO
     161             :       END DO
     162             : 
     163             :       ! Copy first vacuum into second vacuum if this was not calculated before:
     164         688 :       IF (vacuum%nvac==1) THEN
     165          68 :          IF (sym%invs) THEN
     166      966390 :             vTot%vac(:,:,2,:)  = CMPLX(vTot%vac(:,:,1,:))
     167             :          ELSE
     168     7322276 :             vTot%vac(:,:,2,:)  = vTot%vac(:,:,1,:)
     169             :          END IF
     170             :       END IF
     171             : 
     172         688 :    END SUBROUTINE vgen_finalize
     173             : 
     174             : END MODULE m_vgen_finalize