carrying home some work

main/fleur.F90

@@ -142,7 +142,8 @@ CONTAINS
     ! Initialize and load inDen density (start)
     CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
     DO i=1,3
-       CALL xcB(i)%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
+       CALL xcB(i)%init(stars,atoms,sphhar,vacuum,noco,1,POTDEN_TYPE_DEN)
+       ALLOCATE(xcB(i)%pw_w,mold=xcB(i)%pw)
     ENDDO
     archiveType = CDN_ARCHIVE_TYPE_CDN1_const
     IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
@@ -498,7 +499,9 @@ CONTAINS
     END DO scfloop ! DO WHILE (l_cont)
 
 !    DIVERGENCE
+
     CALL divB%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
+    ALLOCATE(divB%pw_w,mold=divB%pw)
     
     DO i=1,atoms%ntype
        CALL divergence(input%jspins,i,stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft,atoms,sphhar,sym,stars,cell,vacuum,noco,xcB,divB)

main/vgen.F90

@@ -65,11 +65,11 @@ CONTAINS
       CALL vTot%resetPotDen()
       CALL vCoul%resetPotDen()
       CALL vx%resetPotDen()
-      DO i=1,3
-         CALL xcB(i)%resetPotden()
-         ALLOCATE(xcB(i)%pw_w,mold=vTot%pw)
-         xcB(i)%pw_w = 0.0
-      ENDDO
+!      DO i=1,3
+!         CALL xcB(i)%resetPotden()
+!         ALLOCATE(xcB(i)%pw_w,mold=den%pw_w)
+!         xcB(i)%pw_w = CMPLX(0.0,0.0)
+!      ENDDO
       ALLOCATE(vx%pw_w,mold=vTot%pw)
       vx%pw_w = 0.0
 

vgen/divergence.f90

@@ -9,7 +9,7 @@ MODULE m_divergence
    PUBLIC :: mt_div, pw_div, divergence!, divpotgrad
 
 CONTAINS
-   SUBROUTINE mt_div(jspins,n,atoms,sphhar,sym,xcB,div)
+   SUBROUTINE mt_div(n,atoms,sphhar,sym,xcB,div)
    !-----------------------------------------------------------------------------!
    !By use of the cartesian components of a field, its radial/angular derivati-  !
    !ves in the muffin tin at each spherical grid point and the corresponding an- !
@@ -24,7 +24,7 @@ CONTAINS
 
    IMPLICIT NONE
    
-   INTEGER, INTENT(IN)                         :: jspins, n
+   INTEGER, INTENT(IN)                         :: n
    TYPE(t_atoms), INTENT(IN)                   :: atoms
    TYPE(t_sphhar), INTENT(IN)                  :: sphhar
    TYPE(t_sym), INTENT(IN)                     :: sym
@@ -40,14 +40,15 @@ CONTAINS
 
    nsp = atoms%nsp()
 
-   ALLOCATE (gradx%gr(3,atoms%jri(n)*nsp,jspins),grady%gr(3,atoms%jri(n)*nsp,jspins),gradz%gr(3,atoms%jri(n)*nsp,jspins))
-   ALLOCATE (div_temp(atoms%jri(n)*nsp,jspins))
+   ALLOCATE (gradx%gr(3,atoms%jri(n)*nsp,1),grady%gr(3,atoms%jri(n)*nsp,1),gradz%gr(3,atoms%jri(n)*nsp,1))
+   ALLOCATE (div_temp(atoms%jri(n)*nsp,1))
+   ALLOCATE (thet(atoms%nsp()),phi(atoms%nsp()))
 
-   CALL init_mt_grid(jspins, atoms, sphhar, .TRUE., sym)
+   CALL init_mt_grid(1, atoms, sphhar, .TRUE., sym, thet, phi)
 
-   CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(1)%mt(:,0:,n,:), n, gradx)
-   CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(2)%mt(:,0:,n,:), n, grady)
-   CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(3)%mt(:,0:,n,:), n, gradz)
+   CALL mt_to_grid(.TRUE., 1, atoms, sphhar, xcB(1)%mt(:,0:,n,:), n, gradx)
+   CALL mt_to_grid(.TRUE., 1, atoms, sphhar, xcB(2)%mt(:,0:,n,:), n, grady)
+   CALL mt_to_grid(.TRUE., 1, atoms, sphhar, xcB(3)%mt(:,0:,n,:), n, gradz)
 
    kt = 0
    DO jr = 1, atoms%jri(n)
@@ -55,15 +56,15 @@ CONTAINS
       DO k = 1, nsp
          th = thet(k)
          ph = phi(k)
-         div_temp(kt+nsp,1) = (SIN(th)*COS(ph)*gradx%gr(1,kt+nsp,jspins) + SIN(th)*SIN(ph)*grady%gr(1,kt+nsp,jspins) + COS(th)*gradz%gr(1,kt+nsp,jspins))&
-                             +(COS(th)*COS(ph)*gradx%gr(2,kt+nsp,jspins) + COS(th)*SIN(ph)*grady%gr(2,kt+nsp,jspins) - SIN(th)*gradz%gr(2,kt+nsp,jspins))/r&
-                             -(SIN(ph)*gradx%gr(3,kt+nsp,jspins)         + COS(ph)*grady%gr(3,kt+nsp,jspins))/(r*SIN(th))
+         div_temp(kt+nsp,1) = (SIN(th)*COS(ph)*gradx%gr(1,kt+nsp,1) + SIN(th)*SIN(ph)*grady%gr(1,kt+nsp,1) + COS(th)*gradz%gr(1,kt+nsp,1))&
+                             +(COS(th)*COS(ph)*gradx%gr(2,kt+nsp,1) + COS(th)*SIN(ph)*grady%gr(2,kt+nsp,1) - SIN(th)*gradz%gr(2,kt+nsp,1))/r&
+                             -(SIN(ph)*gradx%gr(3,kt+nsp,1)         + COS(ph)*grady%gr(3,kt+nsp,1))/(r*SIN(th))
       ENDDO ! k
    
       kt = kt+nsp
    ENDDO ! jr
     
-   CALL mt_from_grid(atoms, sphhar, n, jspins, div_temp, div%mt(:,0:,n,:))
+   CALL mt_from_grid(atoms, sphhar, n, 1, div_temp, div%mt(:,0:,n,:))
    
    CALL finish_mt_grid
    
@@ -103,9 +104,9 @@ CONTAINS
 
    CALL init_pw_grid(.TRUE.,stars,sym,cell)
 
-   CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(1)%pw,gradx)
-   CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(2)%pw,grady)
-   CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(3)%pw,gradz)
+   CALL pw_to_grid(.TRUE.,1,noco%l_noco,stars,cell,xcB(1)%pw,gradx)
+   CALL pw_to_grid(.TRUE.,1,noco%l_noco,stars,cell,xcB(2)%pw,grady)
+   CALL pw_to_grid(.TRUE.,1,noco%l_noco,stars,cell,xcB(3)%pw,gradz)
 
    DO i = 1, nsp
          div_temp(i,1)=gradx%gr(1,i,1)+grady%gr(2,i,1)+gradz%gr(3,i,1)
@@ -134,12 +135,10 @@ CONTAINS
    TYPE(t_stars),INTENT(IN)                    :: stars
    TYPE(t_cell),INTENT(IN)                     :: cell
    TYPE(t_vacuum),INTENT(IN)                   :: vacuum
-   TYPE(t_potden), dimension(3), INTENT(OUT)   :: xcB
-   TYPE(t_potden), INTENT(OUT)                 :: div
-
-   CALL div%init(stars,atoms,sphhar,vacuum,noco,jspins,POTDEN_TYPE_DEN)
+   TYPE(t_potden), dimension(3), INTENT(IN)    :: xcB
+   TYPE(t_potden), INTENT(INOUT)                 :: div
 
-   CALL mt_div(jspins,n,atoms,sphhar,sym,xcB,div)
+   CALL mt_div(n,atoms,sphhar,sym,xcB,div)
    CALL pw_div(ifftxc3,jspins,stars,cell,noco,sym,xcB,div)
       
    END SUBROUTINE divergence

vgen/mt_tofrom_grid.F90

@@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid
    REAL, ALLOCATABLE :: wt(:), rx(:, :), thet(:), phi(:)
    PUBLIC :: init_mt_grid, mt_to_grid, mt_from_grid, finish_mt_grid
 CONTAINS
-   SUBROUTINE init_mt_grid(jspins, atoms, sphhar, dograds, sym)
+   SUBROUTINE init_mt_grid(jspins, atoms, sphhar, dograds, sym, thout, phout)
       USE m_gaussp
       USE m_lhglptg
       USE m_lhglpts
@@ -23,6 +23,8 @@ CONTAINS
       TYPE(t_sphhar), INTENT(IN)   :: sphhar
       LOGICAL, INTENT(IN)          :: dograds
       TYPE(t_sym), INTENT(IN)      :: sym
+      REAL, INTENT(OUT), OPTIONAL  :: thout(:)
+      REAL, INTENT(OUT), OPTIONAL  :: phout(:)
 
       ! generate nspd points on a sherical shell with radius 1.0
       ! angular mesh equidistant in phi,
@@ -40,6 +42,11 @@ CONTAINS
 
          CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), dograds, sym, &
                       ylh, thet, phi, ylht, ylhtt, ylhf, ylhff, ylhtf)
+         IF (PRESENT(thout)) THEN
+            thout=thet
+            phout=phi
+         END IF
+
       ELSE
          CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh)
       END IF

vgen/vmatgen.f90

@@ -69,6 +69,7 @@ CONTAINS
     ifft3 = 27*stars%mx1*stars%mx2*stars%mx3
     IF (ifft3.NE.SIZE(den%theta_pw)) CALL judft_error("Wrong size of angles")
     ifft2 = SIZE(den%phi_vacxy,1) 
+
     DO i=1,3
        xcB(i)%vacxy(:,:,:,:)=0.0
        xcB(i)%vacz(:,:,:)=0.0