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