vgen_finalize.F90 7.04 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_vgen_finalize
7
   USE m_juDFT
8
   USE m_xcBfield
Alexander Neukirchen's avatar
Alexander Neukirchen committed
9
   USE m_plot
10
   USE m_constants
Alexander Neukirchen's avatar
Alexander Neukirchen committed
11
   USE m_lattHarmsSphHarmsConv
12

13
CONTAINS
14

15
   SUBROUTINE vgen_finalize(fmpi,oneD,field,cell,atoms,stars,vacuum,sym,noco,nococonv,input,xcpot,sphhar,vTot,vCoul,denRot,sliceplot)
16
      !--------------------------------------------------------------------------
17 18
      ! FLAPW potential generator (finalization)
      !
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 26
      ! Sourcefree: The xc-B-field is scaled up an source terms are purged out.
      !--------------------------------------------------------------------------
27
      USE m_types
28
      USE m_constants
29
      USE m_rotate_int_den_tofrom_local
30 31
      USE m_rotate_mt_den_tofrom_local
      USE m_magnMomFromDen
32

33
      IMPLICIT NONE
34

35
      TYPE(t_mpi),      INTENT(IN)    :: fmpi
36 37 38 39 40 41 42 43 44 45 46 47 48
      TYPE(t_oneD),     INTENT(IN)    :: oneD
      TYPE(t_field),    INTENT(IN)    :: field
      TYPE(t_cell),     INTENT(IN)    :: cell
      TYPE(t_vacuum),   INTENT(IN)    :: vacuum
      TYPE(t_noco),     INTENT(IN)    :: noco
      TYPE(t_nococonv), INTENT(IN)    :: nococonv
      TYPE(t_sym),      INTENT(IN)    :: sym
      TYPE(t_stars),    INTENT(IN)    :: stars
      TYPE(t_atoms),    INTENT(IN)    :: atoms
      TYPE(t_input),    INTENT(IN)    :: input
      CLASS(t_xcpot),   INTENT(IN)    :: xcpot
      TYPE(t_sphhar),   INTENT(IN)    :: sphhar
      TYPE(t_potden),   INTENT(INOUT) :: vTot, vCoul, denRot
49
      TYPE(t_sliceplot), INTENT(IN)   :: sliceplot
50

51
      TYPE(t_potden)                  :: vScal, vCorr, vxcForPlotting
Alexander Neukirchen's avatar
Alexander Neukirchen committed
52
      TYPE(t_potden), DIMENSION(3)    :: bxc
53

Alexander Neukirchen's avatar
Alexander Neukirchen committed
54
      INTEGER                         :: i, js, n, lh, nat, nd
Alexander Neukirchen's avatar
Alexander Neukirchen committed
55
      REAL                            :: sfscale, r2(atoms%jmtd)
56 57
      REAL                            :: b(3,atoms%ntype), dummy1(atoms%ntype), dummy2(atoms%ntype)
      REAL, ALLOCATABLE               :: intden(:,:)
58 59 60 61 62 63 64 65 66 67

      IF (.NOT.noco%l_noco) THEN
         ! Rescale vTot%pw_w with number of stars:
         DO js=1,SIZE(vtot%pw_w,2)
            DO i=1,stars%ng3
               vTot%pw_w(i,js)=vtot%pw_w(i,js) / stars%nstr(i)
            END DO
         END DO
      ELSE IF(noco%l_noco) THEN
         ! Rotate interstital potential back to global frame:
68
         CALL rotate_int_den_from_local(stars,atoms,vacuum,sym,input,denRot,vTot)
69 70 71 72 73 74
         IF (noco%l_mtnocoPot) THEN
            ! Rotate Muffin Tin potential back to global frame:
            CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,noco,vtot)
         END IF
      END IF

Alexander Neukirchen's avatar
Alexander Neukirchen committed
75 76
      IF (noco%l_mtnocoPot.AND.noco%l_scaleMag) THEN
         sfscale=noco%mag_scale
77 78 79 80 81 82
         CALL vTot%SpinsToChargeAndMagnetisation()
         vTot%mt(:,0:,:,  2:4) = sfscale*vTot%mt(:,0:,:,2:4)
         vTot%pw(:,       2:3) = sfscale*vTot%pw(:,     2:3)
         vTot%vacz(:,:,   2:4) = sfscale*vTot%vacz(:,:, 2:4)
         vTot%vacxy(:,:,:,2:3) = sfscale*vTot%vacxy(:,:,:,2:3)
         CALL vTot%ChargeAndMagnetisationToSpins()
Alexander Neukirchen's avatar
Alexander Neukirchen committed
83 84 85 86
      END IF

      IF (noco%l_mtnocoPot.AND.noco%l_sourceFree) THEN

87
         IF (fmpi%irank == 0) THEN
Alexander Neukirchen's avatar
Alexander Neukirchen committed
88 89
            CALL magnMomFromDen(input,atoms,noco,vTot,b,dummy1,dummy2)
            DO i=1,atoms%ntype
90
               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)
Alexander Neukirchen's avatar
Alexander Neukirchen committed
91 92 93
               8025 FORMAT(2x,'Bfield before SF [local frame, atom ',i2,']: ','Bx=',f9.5,' By=',f9.5,' Bz=',f9.5,' |B|=',f9.5)
            END DO
         END IF
94

95 96 97
         CALL timestart("Purging source terms in B-field")

         CALL timestart("Building B")
Alexander Neukirchen's avatar
Alexander Neukirchen committed
98
         CALL makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,nococonv,vTot,2.0,vScal,bxc,cell)
99 100 101
         CALL timestop("Building B")

         CALL timestart("SF subroutine")
102
         CALL sourcefree(fmpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,bxc,vScal,vCorr)
103 104
         CALL timestop("SF subroutine")

Alexander Neukirchen's avatar
Alexander Neukirchen committed
105
         CALL timestart("Correcting vTot")
106 107 108 109 110 111 112 113 114

         DO js=1,4
            DO i=1,atoms%ntype
               DO lh=0, sphhar%nlh(sym%ntypsy(SUM(atoms%neq(:i - 1)) + 1))
                  r2=atoms%rmsh(:,i)**2
                  vCorr%mt(:,lh,i,js) = vCorr%mt(:,lh,i,js)/r2
               END DO !lh
            END DO !i
         END DO !js
Alexander Neukirchen's avatar
Alexander Neukirchen committed
115

116
         vTot=vCorr
117

118
         CALL timestop("Correcting vTot")
Alexander Neukirchen's avatar
Alexander Neukirchen committed
119

120
         CALL timestop("Purging source terms in B-field")
121

122
         IF (fmpi%irank == 0) THEN
Alexander Neukirchen's avatar
Alexander Neukirchen committed
123 124
            CALL magnMomFromDen(input,atoms,noco,vTot,b,dummy1,dummy2)
            DO i=1,atoms%ntype
125
               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)
Alexander Neukirchen's avatar
Alexander Neukirchen committed
126 127 128
               8026 FORMAT(2x,'Bfield after SF [local frame, atom ',i2,']: ','Bx=',f9.5,' By=',f9.5,' Bz=',f9.5,' |B|=',f9.5)
            END DO
         END IF
129

130 131
      END IF

132
      IF (sliceplot%iplot.NE.0) THEN
133
         CALL makeplots(stars, atoms, sphhar, vacuum, input, fmpi,oneD, sym, cell, &
134
                        noco,nococonv, vTot, PLOT_POT_TOT, sliceplot)
135
         CALL makeplots(stars, atoms, sphhar, vacuum, input, fmpi,oneD, sym, cell, &
136 137 138
                        noco,nococonv, vCoul, PLOT_POT_COU, sliceplot)
         CALL vxcForPlotting%copyPotDen(vTot)
         CALL subPotDen(vxcForPlotting,vTot,vCoul)
139
         CALL makeplots(stars, atoms, sphhar, vacuum, input, fmpi,oneD, sym, cell, &
140
                        noco,nococonv, vxcForPlotting, PLOT_POT_VXC, sliceplot)
141
         IF ((fmpi%irank.EQ.0).AND.(sliceplot%iplot.LT.32).AND.(MODULO(sliceplot%iplot,2).NE.1)) THEN
142 143
            CALL juDFT_end("Stopped self consistency loop after plots have been generated.")
         END IF
144 145
      END IF

146 147 148
      ! Store vTot(L=0) component as r*vTot(L=0)/sqrt(4*pi):
      ! (Used input%jspins instead of SIZE(vtot%mt,4) since
      ! the off diagonal part of VTot%mt needs no rescaling!)
149
      DO js = 1, input%jspins
150 151 152 153 154 155 156 157 158
         DO n = 1, atoms%ntype
            vTot%mt(:atoms%jri(n),0,n,js)  = atoms%rmsh(:atoms%jri(n),n)*vTot%mt(:atoms%jri(n),0,n,js)/sfp_const
         END DO ! n
      END DO ! js

      ! Rescale vCoul%pw_w with number of stars:
      ! (This normalization is needed for gw!)
      DO js = 1, SIZE(vCoul%pw_w,2)
         DO i = 1, stars%ng3
159
            vCoul%pw_w(i,js) = vCoul%pw_w(i,js) / stars%nstr(i)
160 161 162 163 164 165 166 167 168 169 170 171 172 173
         END DO
      END DO

      ! Copy first vacuum into second vacuum if this was not calculated before:
      IF (vacuum%nvac==1) THEN
         vTot%vacz(:,2,:)  = vTot%vacz(:,1,:)
         IF (sym%invs) THEN
            vTot%vacxy(:,:,2,:)  = CMPLX(vTot%vacxy(:,:,1,:))
         ELSE
            vTot%vacxy(:,:,2,:)  = vTot%vacxy(:,:,1,:)
         END IF
      END IF

   END SUBROUTINE vgen_finalize
174

Alexander Neukirchen's avatar
Alexander Neukirchen committed
175
END MODULE m_vgen_finalize