aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-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.c48
-rw-r--r--src/SymmetryCondition.F77 (renamed from src/SymmetryCondition.F)28
-rw-r--r--src/make.code.defn6
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 =
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-28 09:34:56 +0000