diff options
author | diener <diener@4ec1db94-0e4f-0410-ada3-8bed251432c9> | 2007-10-09 11:00:41 +0000 |
---|---|---|
committer | diener <diener@4ec1db94-0e4f-0410-ada3-8bed251432c9> | 2007-10-09 11:00:41 +0000 |
commit | e0b8a997bc1cbb959cb739c37ad14344f7f49873 (patch) | |
tree | 9e00350d8f3653811d1529fedf1f87dc1782a75c /src | |
parent | 3bf99c974faf66ca91519da304efeac9589c4f21 (diff) |
Add the option to use user defined regions for the elliptic smoothing
procedure. Works by setting the admbase variables to zero in these
regions before doing the smoothing. Needs some testing.
git-svn-id: http://svn.einsteintoolkit.org/cactus/EinsteinInitialData/NoExcision/trunk@12 4ec1db94-0e4f-0410-ada3-8bed251432c9
Diffstat (limited to 'src')
-rw-r--r-- | src/cg.F90 | 75 |
1 files changed, 75 insertions, 0 deletions
@@ -645,3 +645,78 @@ subroutine NoExcision_CGApplySym(CCTK_ARGUMENTS) end if end subroutine NoExcision_CGApplySym + + +subroutine NoExcision_Set_Zero(CCTK_ARGUMENTS) + + use NoExcision_mod + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_REAL :: cx, cy, cz, radx, rady, radz + CCTK_REAL, dimension(:,:,:), allocatable :: dist2 + integer :: n + CCTK_INT :: my_level, n_levels + + call NoExcision_levelinfo ( cctkGH, my_level, n_levels ) + + if ( my_level == n_levels-1 ) then + + allocate ( dist2(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) ) + + do n = 1, num_regions + + cx = centre_x(n) + cy = centre_y(n) + cz = centre_z(n) + + if (CCTK_EQUALS(region_shape(n), "sphere")) then + + radx = radius(n) + rady = radius(n) + radz = radius(n) + + else if (CCTK_EQUALS(region_shape(n), "ellipsoid")) then + + radx = radius_x(n) + rady = radius_y(n) + radz = radius_z(n) + + else + + call CCTK_WARN (0, "internal error") + + end if + + dist2 = ((x - cx) / radx)**2 + ((y - cy) / rady)**2 & + & + ((z - cz) / radz)**2 + + where ( dist2 <= one ) + + gxx = zero + gxy = zero + gxz = zero + gyy = zero + gyz = zero + gzz = zero + kxx = zero + kxy = zero + kxz = zero + kyy = zero + kyz = zero + kzz = zero + alp = zero + betax = zero + betay = zero + betaz = zero + + end where + + end do + + deallocate ( dist2 ) + + end if +end subroutine NoExcision_Set_Zero |