From 3d474af6ef76047f7f9554052765cd03549e0b32 Mon Sep 17 00:00:00 2001 From: Alexander Neukirchen Date: Wed, 2 Oct 2019 15:29:41 +0200 Subject: [PATCH] carrying home some work --- main/fleur.F90 | 5 ++++- main/vgen.F90 | 10 +++++----- vgen/divergence.f90 | 39 +++++++++++++++++++-------------------- vgen/mt_tofrom_grid.F90 | 9 ++++++++- vgen/vmatgen.f90 | 1 + 5 files changed, 37 insertions(+), 27 deletions(-) diff --git a/main/fleur.F90 b/main/fleur.F90 index 4cf8ce20..f9342c22 100644 --- a/main/fleur.F90 +++ b/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) diff --git a/main/vgen.F90 b/main/vgen.F90 index fcc6ecb3..b6ca04ea 100644 --- a/main/vgen.F90 +++ b/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 diff --git a/vgen/divergence.f90 b/vgen/divergence.f90 index 0d8b8477..23d35836 100644 --- a/vgen/divergence.f90 +++ b/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 diff --git a/vgen/mt_tofrom_grid.F90 b/vgen/mt_tofrom_grid.F90 index 57065a81..6eed0258 100644 --- a/vgen/mt_tofrom_grid.F90 +++ b/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 diff --git a/vgen/vmatgen.f90 b/vgen/vmatgen.f90 index 324492da..4e0a37f8 100644 --- a/vgen/vmatgen.f90 +++ b/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 -- GitLab