1 SUBROUTINE fourp (grpmn, grp, istore, istart, iend, ndim)
3 USE parallel_include_module
9 INTEGER,
INTENT(inout) :: istart
10 INTEGER,
INTENT(in) :: iend, istore, ndim
11 REAL(dp),
INTENT(in) :: grp(nuv,istore)
12 REAL(dp),
INTENT(inout) :: grpmn(0:mf,-nf:nf,ndim,nuv3)
16 INTEGER :: n, kv, ku, ip, iuv, m, ireflect, isym
17 REAL(dp),
ALLOCATABLE,
DIMENSION(:,:,:,:) :: g1, g2
18 REAL(dp),
ALLOCATABLE :: kernel(:), gcos(:),gsin(:)
19 REAL(dp) :: cosm, sinm, cosn, sinn, tfourpon, tfourpoff
29 CALL second0(tfourpon)
30 ALLOCATE (g1(istore,nu2,0:nf,ndim), g2(istore,nu2,0:nf,ndim),
31 1 kernel(istore), gcos(istore), gsin(istore), stat=m)
32 IF (m .ne. 0) stop
'Allocation error in fourp'
39 cosn = p5*onp*cosv(n,kv)
40 sinn = p5*onp*sinv(n,kv)
48 1 grp(iuv,ip) - grp(ireflect,ip)
49 ELSE IF (isym .EQ. 2)
THEN
51 1 grp(iuv,ip) + grp(ireflect,ip)
53 g1(ip,ku,n,isym)=g1(ip,ku,n,isym) + cosn*kernel(ip)
54 g2(ip,ku,n,isym)=g2(ip,ku,n,isym) + sinn*kernel(ip)
72 ELSE IF (isym .EQ. 2)
THEN
78 gcos(ip) = g1(ip,ku,n,isym)*sinm
79 gsin(ip) = g2(ip,ku,n,isym)*cosm
80 grpmn(m,n,isym,ip+istart) =
81 1 grpmn(m,n,isym,ip+istart) + gcos(ip) + gsin(ip)
84 IF (n.NE.0 .AND. m.NE.0)
THEN
86 grpmn(m,-n,isym,ip+istart) =
87 1 grpmn(m,-n,isym,ip+istart)
88 2 + gcos(ip) - gsin(ip)
98 DEALLOCATE (g1, g2, kernel, gcos, gsin, stat=m)
100 CALL second0(tfourpoff)
101 timer_vac(tfourp) = timer_vac(tfourp) + (tfourpoff-tfourpon)
102 fourp_time = timer_vac(tfourp)