diff options
Diffstat (limited to 'src/EHFinder_Init.F90')
| -rw-r--r-- | src/EHFinder_Init.F90 | 108 |
1 files changed, 78 insertions, 30 deletions
diff --git a/src/EHFinder_Init.F90 b/src/EHFinder_Init.F90 index b7f2a25..c9dd60c 100644 --- a/src/EHFinder_Init.F90 +++ b/src/EHFinder_Init.F90 @@ -22,7 +22,9 @@ subroutine EHFinder_Init_F(CCTK_ARGUMENTS) CCTK_REAL :: cosa, sina, cosb, sinb, cosc, sinc CCTK_REAL :: last_time CCTK_REAL :: theta, dtheta, thetamin, thetamax, r_el + CCTK_REAL :: phi, dphi, phimin, phimax CCTK_INT, dimension(1) :: lsh, lbnd + CCTK_INT, dimension(2) :: lsh2, lbnd2 ! Get the size of the local grid. nx = cctk_lsh(1) @@ -52,41 +54,76 @@ subroutine EHFinder_Init_F(CCTK_ARGUMENTS) if ( evolve_generators .gt. 0 ) then - call CCTK_GrouplbndGN ( status, cctkGH, 1, lbnd, 'ehfinder::xg' ) - if ( status .lt. 0 ) then - call CCTK_WARN ( 0, 'cannot get lower bounds for generator arrays' ) - end if - call CCTK_GrouplshGN ( status, cctkGH, 1, lsh, 'ehfinder::xg' ) - if ( status .lt. 0 ) then - call CCTK_WARN ( 0, 'cannot get local size for generator arrays' ) - end if - - if ( CCTK_EQUALS( generator_distribution, 'line' ) ) then - - if ( CCTK_EQUALS( domain, 'full' ) ) then + if ( CCTK_EQUALS( domain, 'full' ) ) then + thetamin = zero; thetamax = pi + phimin = zero; phimax = 2*pi + else if ( CCTK_EQUALS( domain, 'bitant') ) then + if ( CCTK_EQUALS( bitant_plane, 'xy' ) ) then + thetamin = zero; thetamax = half * pi + phimin = zero; phimax = 2*pi + else if ( CCTK_EQUALS( bitant_plane, 'xz' ) ) then thetamin = zero; thetamax = pi - else if ( CCTK_EQUALS( domain, 'bitant') ) then - if ( CCTK_EQUALS( bitant_plane, 'xy' ) ) then - thetamin = zero; thetamax = half * pi - else - thetamin = zero; thetamax = pi - end if - else if ( CCTK_EQUALS( domain, 'quadrant' ) ) then - if ( CCTK_EQUALS( quadrant_direction, 'x' ) .or. & - CCTK_EQUALS( quadrant_direction, 'y' ) ) then - thetamin = zero; thetamax = half * pi - else - thetamin = zero; thetamax = pi - end if - else if ( CCTK_EQUALS( domain, 'octant' ) ) then + phimin = zero; phimax = pi + else + thetamin = zero; thetamax = pi + phimin = -half * pi; phimax = half * pi + end if + else if ( CCTK_EQUALS( domain, 'quadrant' ) ) then + if ( CCTK_EQUALS( quadrant_direction, 'x' ) ) then thetamin = zero; thetamax = half * pi + phimin = zero; phimax = pi + else if ( CCTK_EQUALS( quadrant_direction, 'y' ) ) then + thetamin = zero; thetamax = half * pi + phimin = -half * pi; phimax = half * pi + else + thetamin = zero; thetamax = pi + phimin = zero; phimax = half * pi end if + else if ( CCTK_EQUALS( domain, 'octant' ) ) then + thetamin = zero; thetamax = half * pi + phimin = zero; phimax = half * pi + end if + if ( CCTK_EQUALS( generator_distribution, 'line' ) ) then + + call CCTK_GrouplbndGN ( status, cctkGH, 1, lbnd, 'ehfinder::xg' ) + if ( status .lt. 0 ) then + call CCTK_WARN ( 0, 'cannot get lower bounds for generator arrays' ) + end if + call CCTK_GrouplshGN ( status, cctkGH, 1, lsh, 'ehfinder::xg' ) + if ( status .lt. 0 ) then + call CCTK_WARN ( 0, 'cannot get local size for generator arrays' ) + end if + if ( number_of_generators .eq. 1 ) then theta = half * ( thetamax - thetamin ) + thetamin else dtheta = ( thetamax - thetamin ) / ( number_of_generators - 1 ) end if + + else if ( CCTK_EQUALS( generator_distribution, '2D array' ) ) then + + call CCTK_GrouplbndGN ( status, cctkGH, 2, lbnd2, 'ehfinder::xg2' ) + if ( status .lt. 0 ) then + call CCTK_WARN ( 0, 'cannot get lower bounds for generator arrays' ) + end if + call CCTK_GrouplshGN ( status, cctkGH, 2, lsh2, 'ehfinder::xg2' ) + if ( status .lt. 0 ) then + call CCTK_WARN ( 0, 'cannot get local size for generator arrays' ) + end if + + if ( number_of_generators_theta .eq. 1 ) then + theta = half * ( thetamax - thetamin ) + thetamin + else + dtheta = ( thetamax - thetamin ) / ( number_of_generators_theta - 1 ) + end if + + if ( number_of_generators_phi .eq. 1 ) then + phi = half * ( phimax - phimin ) + phimin + else + dphi = ( phimax - phimin ) / ( number_of_generators_phi - 1 ) + end if + end if end if @@ -103,10 +140,21 @@ subroutine EHFinder_Init_F(CCTK_ARGUMENTS) if ( evolve_generators .gt. 0 ) then if ( CCTK_EQUALS( generator_distribution, 'line' ) ) then do i = 1, lsh(1) - theta = thetamin + dtheta * ( i + lbnd(1) - 1 ) - xg(i,l) = initial_rad(l) * sin(theta) + translate_x(l) - yg(i,l) = translate_y(l) - zg(i,l) = initial_rad(l) * cos(theta) + translate_z(l) + theta = thetamin + dtheta * ( i + lbnd(1) - 1 ) + xg(i,l) = initial_rad(l) * sin(theta) + translate_x(l) + yg(i,l) = translate_y(l) + zg(i,l) = initial_rad(l) * cos(theta) + translate_z(l) + end do + else if ( CCTK_EQUALS( generator_distribution, '2D array' ) ) then + do j = 1, lsh2(2) + phi = phimin + dphi * ( j + lbnd2(2) - 1 ) + do i = 1, lsh2(1) + theta = thetamin + dtheta * ( i + lbnd2(1) - 1 ) + xg2(i,j,l) = initial_rad(l) * sin(theta) * cos(phi) + translate_x(l) + yg2(i,j,l) = initial_rad(l) * sin(theta) * sin(phi) + translate_x(l) + zg2(i,j,l) = initial_rad(l) * cos(theta) + translate_z(l) + print*,xg2(i,j,l),yg2(i,j,l),zg2(i,j,l) + end do end do end if end if |