1 2! Copyright (C) 2009 J. K. Dewhurst, S. Sharma and E. K. U. Gross. 3! This file is distributed under the terms of the GNU General Public License. 4! See the file COPYING for license details. 5 6!BOP 7! !ROUTINE: ggamt_1 8! !INTERFACE: 9subroutine ggamt_1(tsh,is,np,rho,grho,g2rho,g3rho) 10! !USES: 11use modmain 12! !DESCRIPTION: 13! Spin-unpolarised version of {\tt ggamt\_sp\_1}. 14! 15! !REVISION HISTORY: 16! Created November 2009 (JKD) 17!EOP 18!BOC 19implicit none 20! arguments 21logical, intent(in) :: tsh 22integer, intent(in) :: is,np 23real(8), intent(in) :: rho(np) 24real(8), intent(out) :: grho(np),g2rho(np),g3rho(np) 25! local variables 26integer nr,nri,i 27! allocatable arrays 28real(8), allocatable :: grfmt(:,:),gvrho(:,:),rfmt1(:),rfmt2(:) 29allocate(grfmt(np,3),gvrho(np,3),rfmt2(np)) 30nr=nrmt(is) 31nri=nrmti(is) 32! |grad rho| 33if (tsh) then 34 call gradrfmt(nr,nri,rlmt(:,-1,is),wcrmt(:,:,is),rho,np,grfmt) 35else 36 allocate(rfmt1(np)) 37 call rfsht(nr,nri,rho,rfmt1) 38 call gradrfmt(nr,nri,rlmt(:,-1,is),wcrmt(:,:,is),rfmt1,np,grfmt) 39end if 40do i=1,3 41 call rbsht(nr,nri,grfmt(:,i),gvrho(:,i)) 42end do 43grho(1:np)=sqrt(gvrho(1:np,1)**2+gvrho(1:np,2)**2+gvrho(1:np,3)**2) 44! grad^2 rho in spherical coordinates 45if (tsh) then 46 call grad2rfmt(nr,nri,rlmt(:,-1,is),rlmt(:,-2,is),wcrmt(:,:,is),rho,rfmt2) 47else 48 call grad2rfmt(nr,nri,rlmt(:,-1,is),rlmt(:,-2,is),wcrmt(:,:,is),rfmt1,rfmt2) 49end if 50call rbsht(nr,nri,rfmt2,g2rho) 51! (grad rho).(grad |grad rho|) 52call rfsht(nr,nri,grho,rfmt2) 53call gradrfmt(nr,nri,rlmt(:,-1,is),wcrmt(:,:,is),rfmt2,np,grfmt) 54g3rho(1:np)=0.d0 55do i=1,3 56 call rbsht(nr,nri,grfmt(:,i),rfmt2) 57 g3rho(1:np)=g3rho(1:np)+gvrho(1:np,i)*rfmt2(1:np) 58end do 59deallocate(grfmt,gvrho,rfmt2) 60if (.not.tsh) deallocate(rfmt1) 61end subroutine 62!EOC 63 64