Trying to make mean B-field accessable.

cdn_mt/magnMomFromDen.f90

@@ -8,6 +8,7 @@
 ! 
 !
 ! Robin Hilgers, Nov '19
+! Modified for usability with the potential matrix; A. Neukirchen, Dec '19
 
 MODULE m_magnMomFromDen
 
@@ -22,8 +23,7 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
    USE m_intgr
    USE m_juDFT
    USE m_polangle
-
-
+   USE m_constants
 
    TYPE(t_input), INTENT(IN)     ::  input
    TYPE(t_atoms), INTENT(INOUT)  ::  atoms
@@ -31,10 +31,12 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
    TYPE(t_potden),INTENT(IN)     ::  den
    REAL, INTENT(OUT)             ::  moments(3,atoms%ntype)
 
-   INTEGER                       ::  jsp,i,j
+   INTEGER                       ::  jsp,i,j,ir
    REAL                          ::  mx,my,mz
-
+   
+   TYPE(t_potden)                ::  denloc
    REAL, ALLOCATABLE             ::  dummyResults(:,:)
+   
 
   ALLOCATE(dummyResults(SIZE(den%mt,3),SIZE(den%mt,4)))
 
@@ -47,7 +49,14 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
    DO i=1, atoms%ntype 
       DO j=1, jsp
 !!Integration over r
-           CALL intgr3(den%mt(:,0,i,j), atoms%rmsh(:,i),atoms%dx(i),atoms%jri(i),dummyResults(i,j))
+           IF (den%potdenType<=1000) THEN
+              DO ir=1, atoms%jri(i)
+                 denloc%mt(ir,:,i,j)=den%mt(ir,:,i,j)*atoms%rmsh(ir,i)
+              END DO
+           ELSE
+              denloc=den
+           END IF
+           CALL intgr3(denloc%mt(:,0,i,j), atoms%rmsh(:,i),atoms%dx(i),atoms%jri(i),dummyResults(i,j))
 !!Considering Lattice harmonics integral (Only L=0 component does not vanish and has a factor of sqrt(4*Pi))
           dummyResults(i,j)=dummyResults(i,j)*sfp_const
       END DO
@@ -59,14 +68,21 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
    END IF
       moments(i,3)=dummyResults(i,1)-dummyResults(i,2)
    END DO
+   
 DEALLOCATE(dummyResults)
 
+IF (den%potdenType<=1000) THEN
+   moments=moments/2
+END IF
+
 !!Calculation of Angles
    DO i=1 , atoms%ntype
       mx=moments(1,i)
       my=moments(2,i)
       mz=moments(3,i)
-      CALL pol_angle(mx,my,mz,atoms%theta_mt_avg(i),atoms%phi_mt_avg(i))
+      IF (den%potdenType>1000) THEN
+         CALL pol_angle(mx,my,mz,atoms%theta_mt_avg(i),atoms%phi_mt_avg(i))
+      END IF
       IF(mx<0) atoms%theta_mt_avg(i)=-atoms%theta_mt_avg(i)
    ENDDO
 

vgen/xcBfield.f90

@@ -18,7 +18,7 @@ MODULE m_xcBfield
    ! process test or in the scf-loop to achieve said fields self-consistently.
    !-----------------------------------------------------------------------------
 
-   PUBLIC :: makeBxc, sourcefree
+   PUBLIC :: makeVectorField, sourcefree, correctPot
 
 CONTAINS
    SUBROUTINE makeVectorField(stars,atoms,sphhar,vacuum,input,noco,denmat,factor,aVec)
@@ -125,7 +125,7 @@ CONTAINS
       
       TYPE(t_potden)                               :: divloc
       TYPE(t_atoms)                                :: atloc
-      INTEGER                                      :: n, jr, lh, lhmax, jcut, nat
+      INTEGER                                      :: n, i, jr, lh, lhmax, jcut, nat
       REAL                                         :: xp(3,dimension%nspd)
 
       CALL div%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype, &
@@ -220,6 +220,6 @@ CONTAINS
       !vTot%vacxy(1:,1:,1:,3)=vTot%vacxy(1:,1:,1:,3)+c(1)%vacxy(1:,1:,1:,1)
       !vTot%vacxy(1:,1:,1:,4)=vTot%vacxy(1:,1:,1:,4)+c(2)%vacxy(1:,1:,1:,1)
 
-   END SUBROUTINE
+   END SUBROUTINE correctPot
 
 END MODULE m_xcBfield