From 2669341adf79d62cd2b5790cdd6ea69691821189 Mon Sep 17 00:00:00 2001 From: allen Date: Thu, 21 Oct 1999 08:30:55 +0000 Subject: Getting rid of Fortran files git-svn-id: http://svn.cactuscode.org/arrangements/CactusBase/CartGrid3D/trunk@73 c78560ca-4b45-4335-b268-5f3340f3cb52 --- src/CartGrid3D.F77 | 293 ---------------------------------------------- src/ParamCheck.F77 | 69 ----------- src/SymmetryCondition.F77 | 80 ------------- 3 files changed, 442 deletions(-) delete mode 100644 src/CartGrid3D.F77 delete mode 100644 src/ParamCheck.F77 delete mode 100644 src/SymmetryCondition.F77 (limited to 'src') diff --git a/src/CartGrid3D.F77 b/src/CartGrid3D.F77 deleted file mode 100644 index d580037..0000000 --- a/src/CartGrid3D.F77 +++ /dev/null @@ -1,293 +0,0 @@ - /*@@ - @file CartGrid3D.F77 - @date Thu Feb 18 - @author Gabrielle Allen - @desc - Set up coordinates for a 3D Cartesian grid - @enddesc - @@*/ - -#define CARTGRID3D_DEBUG - -#include "cctk.h" -#include "cctk_arguments.h" -#include "cctk_parameters.h" - - - subroutine CartGrid3D(CCTK_FARGUMENTS) - - implicit none - - 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 - CCTK_REAL lowerx,upperx,lowery,uppery,lowerz,upperz - CCTK_REAL olower,oupper - character*80 infoline - - iconv = 2**(cctk_convlevel-1) - -c -------------------------------------------------------------- -c -c BYRANGE -c -c User gives: minimum and maximum values of coordinates and -c the number of gridpoints on the coarse grid -c -c -------------------------------------------------------------- - - if (CCTK_Equals(type,'byrange') .eq. 1) then - - if (xyzmax .gt. 0) then - xmax1 = xyzmax - ymax1 = xyzmax - zmax1 = xyzmax - else - xmax1 = xmax - ymax1 = ymax - zmax1 = zmax - end if - - if (CCTK_EQUALS(domain,'octant')) then - -c Grid spacing on coarsest grid - - 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) - else - coarse_dx = xmax/(DBLE(cctk_gsh(1))-1.0d0) - coarse_dy = ymax/(DBLE(cctk_gsh(2))-1.0d0) - coarse_dz = zmax/(DBLE(cctk_gsh(3))-1.0d0) - end if - -c Grid spacing on this grid - this_dx = coarse_dx - this_dy = coarse_dy - this_dz = coarse_dz - -c Minimum coordinate values on this grid - 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 - else - x_origin = (-dble(cctk_nghostzones(1)))*this_dx - y_origin = (-dble(cctk_nghostzones(2)))*this_dy - z_origin = (-dble(cctk_nghostzones(3)))*this_dz - end if - - else if (CCTK_EQUALS(domain,'quadrant')) then - - print *,"FIXME" - - else if (CCTK_Equals(domain,'bitant') .eq. 1) then - - print *,"FIXME" - - else if (CCTK_Equals(domain,'full') .eq. 1) then - -c Set minimum values of coordinates - x_origin = xmin - y_origin = ymin - z_origin = zmin - -c dx,dy,dz on the coarsest grid of each GH - coarse_dx = (xmax-xmin)/max(cctk_gsh(1)-1,1) - coarse_dy = (ymax-ymin)/max(cctk_gsh(2)-1,1) - coarse_dz = (zmax-zmin)/max(cctk_gsh(3)-1,1) - - end if - -c dx,dy,dz on the grid we are on - this_dx = coarse_dx*iconv - this_dy = coarse_dy*iconv - this_dz = coarse_dz*iconv - -c ----------------------------------------------------------- -c -c BYSPACING -c -c User gives: grid spacing on the coarsest GH and -c the number of gridpoints on the coarsest GH -c -c ----------------------------------------------------------- - - else if (CCTK_Equals(type,'byspacing') .eq. 1) then - -c Dx, Dy, Dx on the coarsest grid - - if (dxyz .gt. 0) then - coarse_dx = dxyz - coarse_dy = dxyz - coarse_dz = dxyz - else - coarse_dx = dx - coarse_dy = dy - coarse_dz = dz - end if - -c dx, dy, dz on the grid we are on - this_dx = coarse_dx*iconv - this_dy = coarse_dy*iconv - this_dz = coarse_dz*iconv - - if (CCTK_Equals(domain,'bitant') .eq. 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 - else - x_origin = (- cctk_gsh(1)/2)*this_dx - y_origin = (- cctk_gsh(2)/2)*this_dy - z_origin = (-dble(cctk_nghostzones(3)))*this_dz - end if - - else if (CCTK_Equals(domain,'quadrant') .eq. 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 - else - x_origin = (-dble(cctk_nghostzones(1)))*this_dx - y_origin = (-dble(cctk_nghostzones(2)))*this_dy - z_origin = (- cctk_gsh(3)/2)*this_dz - end if - - else if (CCTK_Equals(domain,'octant') .eq. 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 - else - x_origin = (-dble(cctk_nghostzones(1)))*this_dx - y_origin = (-dble(cctk_nghostzones(2)))*this_dy - z_origin = (-dble(cctk_nghostzones(3)))*this_dz - end if - - else if (CCTK_Equals(domain,'full').eq.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 - else - x_origin = (- cctk_gsh(1)/2)*this_dx - y_origin = (- cctk_gsh(2)/2)*this_dy - z_origin = (- cctk_gsh(3)/2)*this_dz - end if - - end if - - -c -------------------------------------------------------------- -c -c BOX (-0.5 to 0.5) -c -c User gives: number of gridpoints on the coarse grid -c -c -------------------------------------------------------------- - - elseif (CCTK_Equals(type,'box') .eq. 1) then - -c Coordinates are all -0.5 to 0.5 - x_origin = -0.5 - y_origin = -0.5 - z_origin = -0.5 - -c dx,dy,dz on the coarsest grid of each GH - coarse_dx = 1.d0/max(cctk_gsh(1)-1,1) - coarse_dy = 1.d0/max(cctk_gsh(2)-1,1) - coarse_dz = 1.d0/max(cctk_gsh(3)-1,1) - -c dx,dy,dz on the grid we are on - this_dx = coarse_dx*iconv - this_dy = coarse_dy*iconv - this_dz = coarse_dz*iconv - -c Special cases - 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 - - end if - - -c Set spatial coordinates -c ----------------------- - do i=1,cctk_lsh(1) - do j=1,cctk_lsh(2) - do k=1,cctk_lsh(3) - 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 - - cctk_delta_space(1) = this_dx - cctk_delta_space(2) = this_dy - cctk_delta_space(3) = this_dz - - cctk_origin_space(1) = x_origin - cctk_origin_space(2) = y_origin - cctk_origin_space(3) = z_origin - - lowerx = x_origin - upperx = x_origin+this_dx*(cctk_gsh(1)-1) - call CCTK_RegisterCoordRange(cctkGH,lowerx,upperx,"x") - lowery = y_origin - uppery = y_origin+this_dy*(cctk_gsh(2)-1) - call CCTK_RegisterCoordRange(cctkGH,lowery,uppery,"y") - lowerz = z_origin - upperz = z_origin+this_dz*(cctk_gsh(3)-1) - call CCTK_RegisterCoordRange(cctkGH,lowerz,upperz,"z") - - write(infoline,'(1X,3(A,G12.7,2X))') - & 'dx=>',cctk_delta_space(1), - & 'dy=>',cctk_delta_space(2), - & 'dz=>',cctk_delta_space(3) - call CCTK_INFO(infoline) - - write(infoline,'(1X,3(A,F6.3,A,F6.3,A,2X))') - & 'x=>[',lowerx,',',upperx,']', - & 'y=>[',lowery,',',uppery,']', - & 'z=>[',lowerz,',',upperz,']' - call CCTK_INFO(infoline) - - -#ifdef CCTK_DEBUG - write(*,*) - write(*,*) " CartGrid3D" - write(*,*) " ----------" - write(*,100) coarse_dx,coarse_dy,coarse_dz - 100 format(2X,"Dx,Dy,Dz on coarse grid ",f6.3,f6.3,f6.3) - write(*,101) cctk_delta_space(1),cctk_delta_space(2),cctk_delta_space(3) - 101 format(2X,"Dx,Dy,Dz on this grid ",f6.3,f6.3,f6.3) - write(*,*) " Convergence level = ",cctk_convlevel - write(*,102) x_origin,y_origin,z_origin - 102 format(2X,"Minimum global coords ",f6.3,f6.3,f6.3) - write(*,103) x_origin+this_dx*(cctk_gsh(1)-1), - & y_origin+this_dy*(cctk_gsh(2)-1),z_origin+this_dz*(cctk_gsh(3)-1) - 103 format(2X,"Maximum global coords ",f6.3,f6.3,f6.3) - write(*,104) x(1,1,1),y(1,1,1),z(1,1,1) - 104 format(2X,"Minimum local coords ",f6.3,f6.3,f6.3) - write(*,105) x(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)), - & y(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),z(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) - 105 format(2X,"Maximum local coords ",f6.3,f6.3,f6.3) -#endif - - end - - - diff --git a/src/ParamCheck.F77 b/src/ParamCheck.F77 deleted file mode 100644 index 73073e5..0000000 --- a/src/ParamCheck.F77 +++ /dev/null @@ -1,69 +0,0 @@ - /*@@ - @file ParamCheck.F - @date Tue Feb 23 1999 - @author Gabrielle Allen - @desc - Check parameters for CartGrid3D - @enddesc - @@*/ - -#include "cctk.h" -#include "cctk_arguments.h" -#include "cctk_parameters.h" - - - subroutine ParamCheck_CartGrid3D(CCTK_FARGUMENTS) - - implicit none - - DECLARE_CCTK_FARGUMENTS - DECLARE_CCTK_PARAMETERS - - integer CCTK_Equals - integer iflag - - iflag = 0 - - if (CCTK_Equals(type,'byrange') .eq. 1) then - - if (CCTK_Equals(domain,'octant') .eq. 1) then - iflag = iflag +1 - else if (CCTK_Equals(domain,'quadrant') .eq. 1) then - iflag = iflag +1 - else if (CCTK_Equals(domain,'bitant') .eq. 1) then - iflag = iflag +1 - else if (CCTK_Equals(domain,'full') .eq. 1) then - iflag = iflag +1 - end if - - else if (CCTK_Equals(type,'byspacing') .eq. 1) then - - if (CCTK_Equals(domain,'bitant') .eq. 1) then - iflag = iflag + 1 - else if (CCTK_Equals(domain,'quadrant') .eq. 1) then - iflag = iflag + 1 - else if (CCTK_Equals(domain,'octant') .eq. 1) then - iflag = iflag + 1 - else if (CCTK_Equals(domain,'full').eq.1) then - iflag = iflag + 1 - end if - - else if (CCTK_Equals(type,'box') .eq. 1) then - - iflag = iflag + 1 - - if (CCTK_Equals(domain,"full").eq.0) - & call CCTK_PARAMWARN("No symmetries can be used with box grid") - - end if - -c No grid was set up -c ------------------ - if (iflag.ne.1) then - call CCTK_PARAMWARN("No grid set up in CartGrid3D") - end if - - end - - - diff --git a/src/SymmetryCondition.F77 b/src/SymmetryCondition.F77 deleted file mode 100644 index 20e7aa5..0000000 --- a/src/SymmetryCondition.F77 +++ /dev/null @@ -1,80 +0,0 @@ - -#include "cctk.h" - -/*@@ - @routine SymmetryCondition - @date Mon Mar 15 15:51:57 1999 - @author Gerd Lanfermann - @desc - Routine performs the symmetry boundary operations. - @enddesc - @calls - @calledby - @history - - @endhistory -@@*/ - - - subroutine SymmetryCondition(nxyz,var,nghostzones,sym,doSym) - - implicit none - - integer i,j,k - INTEGER nxyz(3) - CCTK_REAL var(nxyz(1),nxyz(2),nxyz(3)) - INTEGER nghostzones - INTEGER sym(6) - INTEGER doSym(6) - - INTEGER sw - -c Apply symmetry if -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(2) .eq. 1 .or. doSym(4) .eq. 1 .or. doSym(6) .eq. 1) then - call CCTKi_NotYetImplemented("Right hand side boundary conditions") - end if - - if (doSym(1) .eq. 1) then - - do sw=1, nghostzones - 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(3) .eq. 1) then - - do sw=1, nghostzones - do i=1,nxyz(1) - do k=1,nxyz(3) - var(i,sw,k) = sym(3)*var(i,nghostzones+sw,k) - end do - end do - end do - - end if - - if (doSym(5).eq.1) then - - do sw=1, nghostzones - do i=1,nxyz(1) - do j=1,nxyz(2) - var(i,j,sw) = sym(5)*var(i,j,nghostzones+sw) - end do - end do - end do - - end if - - return - end - - -- cgit v1.2.3