diff options
author | allen <allen@c78560ca-4b45-4335-b268-5f3340f3cb52> | 1999-07-26 12:06:42 +0000 |
---|---|---|
committer | allen <allen@c78560ca-4b45-4335-b268-5f3340f3cb52> | 1999-07-26 12:06:42 +0000 |
commit | 4f3c1c295f3509bc6364bc478f012a65e2515126 (patch) | |
tree | 6b9926c6131462e71d5221ac7b9f056ddd6bbd08 /src | |
parent | f00078afdd65ccbbdb338982839288e2fc7f5c4b (diff) |
Two changes to CartGrid3D:
1) Changed fortran files to Fortran 77 . Unfortunately doesn't
compile with g77 which complains about the way that 3D arrays
are passed, although it is standard f77. Sometime the F77 routines
will be comnverted to C
2) Started to make CartGrid3D independent of dimension. Now the
calls to set and apply symmetries are independent of dimension.
This means that instead of
SetSymmetry(...,sx,sy,sz,....)
we now have the call
sym(1) = sx
sym(2) = sy
sym(3) = sz
SetCartSymmetry(...,sym,....)
(note the name change too).
git-svn-id: http://svn.cactuscode.org/arrangements/CactusBase/CartGrid3D/trunk@39 c78560ca-4b45-4335-b268-5f3340f3cb52
Diffstat (limited to 'src')
-rw-r--r-- | src/CartGrid3D.F77 (renamed from src/CartGrid3D.F) | 61 | ||||
-rw-r--r-- | src/ParamCheck.F77 (renamed from src/ParamCheck.F) | 31 | ||||
-rw-r--r-- | src/Symmetry.c | 48 | ||||
-rw-r--r-- | src/SymmetryCondition.F77 (renamed from src/SymmetryCondition.F) | 28 | ||||
-rw-r--r-- | src/make.code.defn | 6 |
5 files changed, 95 insertions, 79 deletions
diff --git a/src/CartGrid3D.F b/src/CartGrid3D.F77 index ca5b772..8ec5b7b 100644 --- a/src/CartGrid3D.F +++ b/src/CartGrid3D.F77 @@ -1,5 +1,5 @@ /*@@ - @file CartGrid3D.F + @file CartGrid3D.F77 @date Thu Feb 18 @author Gabrielle Allen @desc @@ -21,11 +21,11 @@ DECLARE_CCTK_FARGUMENTS DECLARE_CCTK_PARAMETERS - integer :: CCTK_Equals - integer :: iconv, i, j, k - CCTK_REAL :: x_origin,y_origin,z_origin - CCTK_REAL :: this_dx,this_dy,this_dz - CCTK_REAL :: xmax1,ymax1,zmax1 + integer CCTK_Equals + integer iconv, i, j, k + CCTK_REAL x_origin,y_origin,z_origin + CCTK_REAL this_dx,this_dy,this_dz + CCTK_REAL xmax1,ymax1,zmax1 iconv = 2**(cctk_convlevel-1) @@ -38,9 +38,9 @@ c the number of gridpoints on the coarse grid c c -------------------------------------------------------------- - if (CCTK_Equals(type,'byrange') == 1) then + if (CCTK_Equals(type,'byrange') .eq. 1) then - if (xyzmax > 0) then + if (xyzmax .gt. 0) then xmax1 = xyzmax ymax1 = xyzmax zmax1 = xyzmax @@ -50,11 +50,11 @@ c -------------------------------------------------------------- zmax1 = zmax end if - if (CCTK_Equals(symmetry,'octant') == 1) then + if (CCTK_EQUALS(symmetry,'octant')) then c Grid spacing on coarsest grid - if (no_origin==1) then + if (no_origin.eq.1) then coarse_dx = xmax/(DBLE(cctk_gsh(1))-1.5d0) coarse_dy = ymax/(DBLE(cctk_gsh(2))-1.5d0) coarse_dz = zmax/(DBLE(cctk_gsh(3))-1.5d0) @@ -70,7 +70,7 @@ c Grid spacing on this grid this_dz = coarse_dz/cctk_levfac(3) c Minimum coordinate values on this grid - if (no_origin==1) then + if (no_origin.eq.1) then x_origin = (0.5-dble(cctk_nghostzones(1)))*this_dx y_origin = (0.5-dble(cctk_nghostzones(2)))*this_dy z_origin = (0.5-dble(cctk_nghostzones(3)))*this_dz @@ -80,15 +80,15 @@ c Minimum coordinate values on this grid z_origin = (-dble(cctk_nghostzones(3)))*this_dz end if - else if (CCTK_Equals(symmetry,'quadrant') == 1) then + else if (CCTK_EQUALS(symmetry,'quadrant')) then print *,"FIXME" - else if (CCTK_Equals(symmetry,'bitant') == 1) then + else if (CCTK_Equals(symmetry,'bitant') .eq. 1) then print *,"FIXME" - else if (CCTK_Equals(symmetry,'full') == 1) then + else if (CCTK_Equals(symmetry,'full') .eq. 1) then c Set minimum values of coordinates x_origin = xmin @@ -121,11 +121,11 @@ c the number of gridpoints on the coarsest GH c c ----------------------------------------------------------- - else if (CCTK_Equals(type,'byspacing') == 1) then + else if (CCTK_Equals(type,'byspacing') .eq. 1) then c Dx, Dy, Dx on the coarsest grid - if (dxyz > 0) then + if (dxyz .gt. 0) then coarse_dx = dxyz coarse_dy = dxyz coarse_dz = dxyz @@ -140,9 +140,9 @@ c dx, dy, dz on the grid we are on this_dy = coarse_dy*iconv/cctk_levfac(2) this_dz = coarse_dz*iconv/cctk_levfac(3) - if (CCTK_Equals(symmetry,'bitant') == 1) then + if (CCTK_Equals(symmetry,'bitant') .eq. 1) then - if (no_origin==1) then + if (no_origin.eq.1) then x_origin = (0.5 - cctk_gsh(1)/2)*this_dx y_origin = (0.5 - cctk_gsh(2)/2)*this_dy z_origin = (-dble(cctk_nghostzones(3))+0.5d0)*this_dz @@ -152,9 +152,9 @@ c dx, dy, dz on the grid we are on z_origin = (-dble(cctk_nghostzones(3)))*this_dz end if - else if (CCTK_Equals(symmetry,'quadrant') == 1) then + else if (CCTK_Equals(symmetry,'quadrant') .eq. 1) then - if (no_origin==1) then + if (no_origin.eq.1) then x_origin = (-dble(cctk_nghostzones(1))+0.5d0)*this_dx y_origin = (-dble(cctk_nghostzones(2))+0.5d0)*this_dy z_origin = (0.5D0 - cctk_gsh(3)/2)*this_dz @@ -164,9 +164,9 @@ c dx, dy, dz on the grid we are on z_origin = (- cctk_gsh(3)/2)*this_dz end if - else if (CCTK_Equals(symmetry,'octant') == 1) then + else if (CCTK_Equals(symmetry,'octant') .eq. 1) then - if (no_origin==1) then + if (no_origin.eq.1) then x_origin = (-dble(cctk_nghostzones(1))+0.5d0)*this_dx y_origin = (-dble(cctk_nghostzones(2))+0.5d0)*this_dy z_origin = (-dble(cctk_nghostzones(3))+0.5d0)*this_dz @@ -176,9 +176,9 @@ c dx, dy, dz on the grid we are on z_origin = (-dble(cctk_nghostzones(3)))*this_dz end if - else if (CCTK_Equals(symmetry,'full')==1) then + else if (CCTK_Equals(symmetry,'full').eq.1) then - if (no_origin==1) then + if (no_origin.eq.1) then x_origin = (0.5 - cctk_gsh(1)/2)*this_dx y_origin = (0.5 - cctk_gsh(2)/2)*this_dy z_origin = (0.5 - cctk_gsh(3)/2)*this_dz @@ -199,7 +199,7 @@ c User gives: number of gridpoints on the coarse grid c c -------------------------------------------------------------- - elseif (CCTK_Equals(type,'box') == 1) then + elseif (CCTK_Equals(type,'box') .eq. 1) then c Coordinates are all -0.5 to 0.5 x_origin = -0.5 @@ -217,9 +217,9 @@ c dx,dy,dz on the grid we are on this_dz = coarse_dz*iconv/cctk_levfac(3) c Special cases - if (cctk_gsh(1) == 1) x_origin = 0.0D0 - if (cctk_gsh(2) == 1) y_origin = 0.0D0 - if (cctk_gsh(3) == 1) z_origin = 0.0D0 + if (cctk_gsh(1) .eq. 1) x_origin = 0.0D0 + if (cctk_gsh(2) .eq. 1) y_origin = 0.0D0 + if (cctk_gsh(3) .eq. 1) z_origin = 0.0D0 write(*,'(1X,A,1X,3(A,G12.7,2X))') & 'Box grid: Setting ','dx=>',this_dx,'dy=>',this_dy, @@ -237,12 +237,11 @@ c ----------------------- x(i,j,k) = this_dx*(i+cctk_lbnd(1)-1) + x_origin y(i,j,k) = this_dy*(j+cctk_lbnd(2)-1) + y_origin z(i,j,k) = this_dz*(k+cctk_lbnd(3)-1) + z_origin + r(i,j,k)=sqrt(x(i,j,k)**2+y(i,j,k)**2+z(i,j,k)**2) end do end do end do - r = sqrt(x**2 + y**2 + z**2) - cctk_delta_space(1) = this_dx cctk_delta_space(2) = this_dy cctk_delta_space(3) = this_dz @@ -273,7 +272,7 @@ c ----------------------- 105 format(2X,"Maximum local coords ",f6.3,f6.3,f6.3) #endif - end subroutine CartGrid3D + end diff --git a/src/ParamCheck.F b/src/ParamCheck.F77 index e2d45d7..8de450e 100644 --- a/src/ParamCheck.F +++ b/src/ParamCheck.F77 @@ -19,37 +19,40 @@ DECLARE_CCTK_FARGUMENTS DECLARE_CCTK_PARAMETERS - integer :: CCTK_Equals,iflag=0 + integer CCTK_Equals + integer iflag - if (CCTK_Equals(type,'byrange') == 1) then + iflag = 0 - if (CCTK_Equals(symmetry,'octant') == 1) then + if (CCTK_Equals(type,'byrange') .eq. 1) then + + if (CCTK_Equals(symmetry,'octant') .eq. 1) then iflag = iflag +1 - else if (CCTK_Equals(symmetry,'quadrant') == 1) then + else if (CCTK_Equals(symmetry,'quadrant') .eq. 1) then iflag = iflag +1 - else if (CCTK_Equals(symmetry,'bitant') == 1) then + else if (CCTK_Equals(symmetry,'bitant') .eq. 1) then iflag = iflag +1 - else if (CCTK_Equals(symmetry,'full') == 1) then + else if (CCTK_Equals(symmetry,'full') .eq. 1) then iflag = iflag +1 end if - else if (CCTK_Equals(type,'byspacing') == 1) then + else if (CCTK_Equals(type,'byspacing') .eq. 1) then - if (CCTK_Equals(symmetry,'bitant') == 1) then + if (CCTK_Equals(symmetry,'bitant') .eq. 1) then iflag = iflag + 1 - else if (CCTK_Equals(symmetry,'quadrant') == 1) then + else if (CCTK_Equals(symmetry,'quadrant') .eq. 1) then iflag = iflag + 1 - else if (CCTK_Equals(symmetry,'octant') == 1) then + else if (CCTK_Equals(symmetry,'octant') .eq. 1) then iflag = iflag + 1 - else if (CCTK_Equals(symmetry,'full')==1) then + else if (CCTK_Equals(symmetry,'full').eq.1) then iflag = iflag + 1 end if - elseif (CCTK_Equals(type,'box') == 1) then + else if (CCTK_Equals(type,'box') .eq. 1) then iflag = iflag + 1 - if (CCTK_Equals(symmetry,"full")==0) + if (CCTK_Equals(symmetry,"full").eq.0) & call CCTK_PARAMWARN("No symmetries can be used with box grid") end if @@ -60,7 +63,7 @@ c ------------------ call CCTK_PARAMWARN("No grid set up in CartGrid3D") end if - end subroutine ParamCheck_CartGrid3D + end diff --git a/src/Symmetry.c b/src/Symmetry.c index df132ee..923a984 100644 --- a/src/Symmetry.c +++ b/src/Symmetry.c @@ -24,7 +24,7 @@ /*#define DEBUG_BOUND*/ /*@@ - @routine SetSymmetry + @routine SetCartSymmetry @date Mon Mar 15 15:10:58 1999 @author Gerd Lanfermann @desc @@ -42,7 +42,7 @@ @@*/ -void SetSymmetry(cGH *GH, int sx, int sy, int sz, const char *imp_gf) { +void SetCartSymmetry(cGH *GH, int *sym, const char *imp_gf) { DECLARE_CCTK_PARAMETERS @@ -72,7 +72,7 @@ void SetSymmetry(cGH *GH, int sx, int sy, int sz, const char *imp_gf) { if (CCTK_Equals(symmetry,"full")) { #ifdef DEBUG_BOUND - printf(" Registered full grid symmetries for -%s- in SetSymmetry\n",imp_gf); + printf(" Registered full grid symmetries for -%s- in SetCartSymmetry\n",imp_gf); #endif sGHex->GFSym[index][0] = GFSYM_NOSYM; @@ -82,30 +82,30 @@ void SetSymmetry(cGH *GH, int sx, int sy, int sz, const char *imp_gf) { } else if (CCTK_Equals(symmetry,"octant")) { #ifdef DEBUG_BOUND - printf(" Registered octant symmetries for -%s- in SetSymmetry\n",imp_gf); + printf(" Registered octant symmetries for -%s- in SetCartSymmetry\n",imp_gf); #endif - sGHex->GFSym[index][0] = sx; - sGHex->GFSym[index][1] = sy; - sGHex->GFSym[index][2] = sz; + sGHex->GFSym[index][0] = sym[0]; + sGHex->GFSym[index][1] = sym[1]; + sGHex->GFSym[index][2] = sym[2]; } else if (CCTK_Equals(symmetry,"quadrant")) { #ifdef DEBUG_BOUND - printf("Registered quadrant symmetries for -%s- in SetSymmetry\n",imp_gf); + printf("Registered quadrant symmetries for -%s- in SetCartSymmetry\n",imp_gf); #endif - sGHex->GFSym[index][0] = sx; - sGHex->GFSym[index][1] = sy; + sGHex->GFSym[index][0] = sym[0]; + sGHex->GFSym[index][1] = sym[1]; sGHex->GFSym[index][2] = GFSYM_NOSYM; } else if (CCTK_Equals(symmetry,"bitant")) { #ifdef DEBUG_BOUND - printf("Registered bitant symmetries for -%s- in SetSymmetry\n",imp_gf); + printf("Registered bitant symmetries for -%s- in SetCartSymmetry\n",imp_gf); #endif - sGHex->GFSym[index][2] = sz; + sGHex->GFSym[index][2] = sym[2]; sGHex->GFSym[index][0] = GFSYM_NOSYM; sGHex->GFSym[index][1] = GFSYM_NOSYM; } @@ -114,11 +114,11 @@ void SetSymmetry(cGH *GH, int sx, int sy, int sz, const char *imp_gf) { } -void FMODIFIER FORTRAN_NAME(SetSymmetry)(cGH *GH, int *sx, int *sy, int *sz, ONE_FORTSTRING_ARG) { +void FMODIFIER FORTRAN_NAME(SetCartSymmetry)(cGH *GH, int *sym, ONE_FORTSTRING_ARG) { ONE_FORTSTRING_CREATE(imp_gf) - SetSymmetry(GH, *sx, *sy, *sz, imp_gf); + SetCartSymmetry(GH, sym, imp_gf); free(imp_gf); } @@ -144,7 +144,7 @@ void FMODIFIER FORTRAN_NAME(SetSymmetry)(cGH *GH, int *sx, int *sy, int *sz, ON @@*/ -void ApplySymmetry(cGH *GH, char *imp_group) { +void ApplySymmetry(cGH *GH, char *name) { void FORTRAN_NAME(SymmetryCondition)(int *, CCTK_REAL *, int *, int *, int *); @@ -163,16 +163,16 @@ void ApplySymmetry(cGH *GH, char *imp_group) { #ifdef DEBUG_BOUND printf("\n In ApplySymmetry\n -----------\n"); - printf(" Applying boundary conditions to -%s-\n",imp_group); + printf(" Applying boundary conditions to -%s-\n",name); #endif /* Get the group number */ - groupnum = CCTK_GroupIndex(imp_group); + groupnum = CCTK_GroupIndex(name); if (groupnum < 0) { char *message=NULL; - message = (char *)malloc(300*sizeof(char)+sizeof(imp_group)); - sprintf(message,"Invalid group number decomposing %s",imp_group); + message = (char *)malloc(300*sizeof(char)+sizeof(name)); + sprintf(message,"Invalid group number decomposing %s",name); CCTK_WARN(0,message); free(message); } @@ -193,8 +193,8 @@ void ApplySymmetry(cGH *GH, char *imp_group) { (sGHex->GFSym[index][1]==GFSYM_UNSET)|| (sGHex->GFSym[index][2]==GFSYM_UNSET)) { char *message=NULL; - message = (char *)malloc(300*sizeof(char)+sizeof(imp_group)); - sprintf(message,"Cannot apply symmetry to -%s- without registered symmetries",imp_group); + message = (char *)malloc(300*sizeof(char)+sizeof(name)); + sprintf(message,"Cannot apply symmetry to -%s- without registered symmetries",name); CCTK_WARN(1,message); free(message); } @@ -229,11 +229,11 @@ void ApplySymmetry(cGH *GH, char *imp_group) { void FMODIFIER FORTRAN_NAME(ApplySymmetry)(cGH *GH, ONE_FORTSTRING_ARG) { - ONE_FORTSTRING_CREATE(imp_group) + ONE_FORTSTRING_CREATE(name) - ApplySymmetry(GH,imp_group); + ApplySymmetry(GH,name); - free(imp_group); + free(name); } diff --git a/src/SymmetryCondition.F b/src/SymmetryCondition.F77 index 0a53ffe..762ac72 100644 --- a/src/SymmetryCondition.F +++ b/src/SymmetryCondition.F77 @@ -20,6 +20,7 @@ implicit none + integer i,j,k INTEGER nxyz(3) CCTK_REAL var(nxyz(1),nxyz(2),nxyz(3)) INTEGER nghostzones @@ -33,18 +34,26 @@ c * the grid chunk has a physical boundary (bbox) c * its size in a direction is bigger than one (sh) c * we actually want a symmetry (sx.ne.ESYM_UNSET) - if (doSym(1) == 1) then + if (doSym(1) .eq. 1) then do sw=1, nghostzones - var(sw,:,:) = sym(1)*var(nghostzones+sw,:,:) + do j=1,nxyz(2) + do k=1,nxyz(3) + var(sw,j,k) = sym(1)*var(nghostzones+sw,j,k) + end do + end do end do end if - if (doSym(2) == 1) then + if (doSym(2) .eq. 1) then - do sw=1, nghostzones - var(:,sw,:) = sym(2)*var(:,nghostzones+sw,:) + do sw=1, nghostzones + do i=1,nxyz(1) + do k=1,nxyz(3) + var(i,sw,k) = sym(2)*var(i,nghostzones+sw,k) + end do + end do end do end if @@ -52,11 +61,16 @@ c * we actually want a symmetry (sx.ne.ESYM_UNSET) if (doSym(3).eq.1) then do sw=1, nghostzones - var(:,:,sw) = sym(3)*var(:,:,nghostzones+sw) + do i=1,nxyz(1) + do j=1,nxyz(2) + var(i,j,sw) = sym(3)*var(i,j,nghostzones+sw) + end do + end do end do end if - end subroutine + return + end diff --git a/src/make.code.defn b/src/make.code.defn index 6d823eb..d0bbdcf 100644 --- a/src/make.code.defn +++ b/src/make.code.defn @@ -2,12 +2,12 @@ # $Header$ # Source files in this directory -SRCS = CartGrid3D.F\ +SRCS = CartGrid3D.F77\ GHExtension.c\ - ParamCheck.F\ + ParamCheck.F77\ Startup.c\ Symmetry.c\ - SymmetryCondition.F + SymmetryCondition.F77 # Subdirectories containing source files SUBDIRS = |