Commit 6fd61ae8 authored by Matthias Redies's avatar Matthias Redies

clear out mt_grid

parent 289c481a
......@@ -33,6 +33,8 @@ CONTAINS
INTEGER :: n
call init_pw_grid(xcpot, stars, sym, cell)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym)
is_inte_mut = is_inte
!allocate potden type
......@@ -43,7 +45,6 @@ CONTAINS
call pw_from_grid(xcpot, stars,.True., is_inte_mut%grid, integrand%pw, integrand%pw_w)
!put mt in potden-basis
call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym)
do n = 1,atoms%ntype
call mt_from_grid(atoms,sphhar,n,input%jspins,mt_inte(n)%grid,integrand%mt(:,0:,n,:))
enddo
......@@ -52,6 +53,7 @@ CONTAINS
call integrate_cdn(stars, atoms, sym, vacuum, input, cell, oneD, integrand,&
q, qis, qmt, qvac, qtot, qistot)
call finish_pw_grid()
call finish_mt_grid()
END SUBROUTINE integrate_grid
SUBROUTINE integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, integrand, &
......
......@@ -130,22 +130,7 @@ CONTAINS
xcpot%is_lapl, xcpot%mt_lapl, &
q, qis, qmt, qvac, qtot, qistot)
write (*,*) "------------------------"
write (*,*) "lapl integration:"
write (*,*) "q = "
write (*,*) q
write (*,*) "qis = "
write (*,*) qis
write (*,*) "qmt = "
write (*,*) qmt
write (*,*) "qvac = "
write (*,*) qvac
write (*,*) "qtot = "
write (*,*) qtot
write (*,*) "qistot = "
write (*,*) qistot
write (*,*) "------------------------"
call print_qs(q,qis,qmt,qvac,qtot,qistot,"laplace")
END SUBROUTINE integrate_lapl
SUBROUTINE integrate_kED_schr(xcpot, stars, atoms, sym, vacuum, input, cell, oneD, sphhar,noco)
......@@ -171,21 +156,7 @@ CONTAINS
xcpot%is_kED_schr, xcpot%mt_kED_schr, &
q, qis, qmt, qvac, qtot, qistot)
write (*,*) "------------------------"
write (*,*) "kED_schr integration:"
write (*,*) "q = "
write (*,*) q
write (*,*) "qis = "
write (*,*) qis
write (*,*) "qmt = "
write (*,*) qmt
write (*,*) "qvac = "
write (*,*) qvac
write (*,*) "qtot = "
write (*,*) qtot
write (*,*) "qistot = "
write (*,*) qistot
write (*,*) "------------------------"
call print_qs(q,qis,qmt,qvac,qtot,qistot,"kED_schr")
endif
END SUBROUTINE integrate_kED_schr
......@@ -222,23 +193,34 @@ CONTAINS
call integrate_grid(xcpot, stars, atoms, sym, vacuum, input, cell, oneD, sphhar,noco,&
is_kED_libXC, mt_kED_libXC, &
q, qis, qmt, qvac, qtot, qistot)
call print_qs(q,qis,qmt,qvac,qtot,qistot,"kED_libxc")
endif
END SUBROUTINE integrate_kED_libxc
write (*,*) "------------------------"
write (*,*) "kED_libXC integration:"
write (*,*) "q = "
write (*,*) q
write (*,*) "qis = "
write (*,*) qis
write (*,*) "qmt = "
write (*,*) qmt
subroutine print_qs(q,qis,qmt,qvac,qtot,qistot, label)
implicit none
REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot
character(len=*), intent(in) :: label
write (*,*) "------------------------"
write (*,*) label // " integration:"
write (*,*) "q = "
write (*,'(ES17.10)') q
write (*,*) "qis = "
write (*,'(ES17.10)') qis
write (*,*) "qmt = "
write (*,'(ES17.10)') qmt
if(.not. all(isnan(qvac))) then
write (*,*) "qvac = "
write (*,*) qvac
write (*,*) "qtot = "
write (*,*) qtot
write (*,*) "qistot = "
write (*,*) qistot
write (*,*) "------------------------"
write (*,'(ES17.10)') qvac
endif
END SUBROUTINE integrate_kED_libxc
write (*,*) "qtot = "
write (*,'(ES17.10)') qtot
write (*,*) "qistot = "
write (*,'(ES17.10)') qistot
write (*,*) "------------------------"
end subroutine print_qs
END MODULE m_vgen
......@@ -27,24 +27,24 @@ CONTAINS
! generate nspd points on a sherical shell with radius 1.0
! angular mesh equidistant in phi,
! theta are zeros of the legendre polynomials
if(.not. allocated(wt)) then
ALLOCATE (wt(atoms%nsp()), rx(3, atoms%nsp()), thet(atoms%nsp()))
CALL gaussp(atoms%lmaxd, rx, wt)
! generate the lattice harmonics on the angular mesh
ALLOCATE (ylh(atoms%nsp(), 0:sphhar%nlhd, sphhar%ntypsd))
IF (xcpot%needs_grad()) THEN
ALLOCATE (ylht, MOLD=ylh)
ALLOCATE (ylhtt, MOLD=ylh)
ALLOCATE (ylhf, MOLD=ylh)
ALLOCATE (ylhff, MOLD=ylh)
ALLOCATE (ylhtf, MOLD=ylh)
CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), xcpot, sym, &
ylh, thet, ylht, ylhtt, ylhf, ylhff, ylhtf)
ELSE
CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh)
END IF
ENDIF
!if(.not. allocated(wt)) then
ALLOCATE (wt(atoms%nsp()), rx(3, atoms%nsp()), thet(atoms%nsp()))
CALL gaussp(atoms%lmaxd, rx, wt)
! generate the lattice harmonics on the angular mesh
ALLOCATE (ylh(atoms%nsp(), 0:sphhar%nlhd, sphhar%ntypsd))
IF (xcpot%needs_grad()) THEN
ALLOCATE (ylht, MOLD=ylh)
ALLOCATE (ylhtt, MOLD=ylh)
ALLOCATE (ylhf, MOLD=ylh)
ALLOCATE (ylhff, MOLD=ylh)
ALLOCATE (ylhtf, MOLD=ylh)
CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), xcpot, sym, &
ylh, thet, ylht, ylhtt, ylhf, ylhff, ylhtf)
ELSE
CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh)
END IF
!ENDIF
END SUBROUTINE init_mt_grid
SUBROUTINE mt_to_grid(xcpot, jspins, atoms, sphhar, den_mt, n, grad, ch)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment