























































































































 


































































































































































 

























































































































































































 



















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                







































      integer function Coordinates_Startup()

      implicit none

      integer ierr

c

      print *
      print *,"CORRECTLY REGISTERING COORDINATE SYSTEM"
      print *,"---------------------------------------"

      print *
      print *,"CCTK_CoordRegisterSystem(ierr,3,<testcart3d>)"
      call CCTKi_CoordRegisterSystem(ierr,3,"TestCoordinates","testcart3
     &d")
      print *,"ierr=",ierr

      print *	
      print *,"CCTK_CoordRegisterSystem(ierr,3,<testspher3d>)"
      call CCTKi_CoordRegisterSystem(ierr,3,"TestCoordinates","testspher
     &3d")
      print *,"ierr=",ierr

      print *
      print *,"INCORRECTLY REGISTERING COORDINATE SYSTEM"
      print *,"-----------------------------------------"

      print *
      print *,"Registering duplicate system with same dimension..."
      print *,"CCTK_CoordRegisterSystem(ierr,3,<testcart3d>)"
      call CCTKi_CoordRegisterSystem(ierr,3,"TestCoordinates","testcart3
     &d")
      print *,"ierr=",ierr
	
      print *
      print *,"Registering duplicate system with different dimension..."
     &
      print *,"CCTK_CoordRegisterSystem(ierr,2,<testcart3d>)"
      call CCTKi_CoordRegisterSystem(ierr,2,"TestCoordinates","testcart3
     &d")
      print *,"ierr=",ierr
	
      print *
      print *,"Registering with wrong dimension ..."
      print *,"CCTK_CoordRegisterSystem(ierr,0,<newone>)"
      call CCTKi_CoordRegisterSystem(ierr,0,"TestCoordinates","newone")
      print *,"ierr=",ierr
	
      print *
      print *,"Registering with empty name ..."
      print *,"CCTK_CoordRegisterSystem(ierr,0,<>)"
      call CCTKi_CoordRegisterSystem(ierr,0,"TestCoordinates"," ")
      print *,"ierr=",ierr
	
      Coordinates_Startup = 0
	
      return 
      end



      subroutine Coordinates_Setup(cctk_dim,cctk_gsh,cctk_lsh,cctk_lbnd,
     &cctk_ubnd,cctk_tile_min,cctk_tile_max,cctk_ash,cctk_alignment,cctk
     &_alignment_offset,cctk_from,cctk_to,cctk_bbox,cctk_delta_time,cctk
     &_time,cctk_delta_space,cctk_origin_space,cctk_levfac,cctk_levoff,c
     &ctk_levoffdenom,cctk_timefac,cctk_convlevel,cctk_convfac,cctk_ngho
     &stzones,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cctk_ash3, r,x,y
     &,z)

      implicit none


      INTEGER cctk_dim
      integer, parameter :: cctki_use_cctk_dim = kind(cctk_dim)
      INTEGER cctk_gsh (cctk_dim)
      integer, parameter :: cctki_use_cctk_gsh = kind(cctk_gsh)
      INTEGER cctk_lsh (cctk_dim)
      integer, parameter :: cctki_use_cctk_lsh = kind(cctk_lsh)
      INTEGER cctk_lbnd (cctk_dim)
      integer, parameter :: cctki_use_cctk_lbnd = kind(cctk_lbnd)
      INTEGER cctk_ubnd (cctk_dim)
      integer, parameter :: cctki_use_cctk_ubnd = kind(cctk_ubnd)
      INTEGER cctk_tile_min (cctk_dim)
      integer, parameter :: cctki_use_cctk_tile_min = kind(cctk_tile_min
     &)
      INTEGER cctk_tile_max (cctk_dim)
      integer, parameter :: cctki_use_cctk_tile_max = kind(cctk_tile_max
     &)
      INTEGER cctk_ash (cctk_dim)
      integer, parameter :: cctki_use_cctk_ash = kind(cctk_ash)
      INTEGER cctk_alignment
      integer, parameter :: cctki_use_cctk_alignment = kind(cctk_alignme
     &nt)
      INTEGER cctk_alignment_offset
      integer, parameter :: cctki_use_cctk_alignment_offset = kind(cctk_
     &alignment_offset)
      INTEGER cctk_from (cctk_dim)
      integer, parameter :: cctki_use_cctk_from = kind(cctk_from)
      INTEGER cctk_to (cctk_dim)
      integer, parameter :: cctki_use_cctk_to = kind(cctk_to)
      INTEGER cctk_bbox (2*cctk_dim)
      integer, parameter :: cctki_use_cctk_bbox = kind(cctk_bbox)
      REAL*8 cctk_delta_time
      integer, parameter :: cctki_use_cctk_delta_time = kind(cctk_delta_
     &time)
      REAL*8 cctk_time
      integer, parameter :: cctki_use_cctk_time = kind(cctk_time)
      REAL*8 cctk_delta_space (cctk_dim)
      integer, parameter :: cctki_use_cctk_delta_space = kind(cctk_delta
     &_space)
      REAL*8 cctk_origin_space (cctk_dim)
      integer, parameter :: cctki_use_cctk_origin_space = kind(cctk_orig
     &in_space)
      INTEGER cctk_levfac (cctk_dim)
      integer, parameter :: cctki_use_cctk_levfac = kind(cctk_levfac)
      INTEGER cctk_levoff (cctk_dim)
      integer, parameter :: cctki_use_cctk_levoff = kind(cctk_levoff)
      INTEGER cctk_levoffdenom (cctk_dim)
      integer, parameter :: cctki_use_cctk_levoffdenom = kind(cctk_levof
     &fdenom)
      INTEGER cctk_timefac
      integer, parameter :: cctki_use_cctk_timefac = kind(cctk_timefac)
      INTEGER cctk_convlevel
      integer, parameter :: cctki_use_cctk_convlevel = kind(cctk_convlev
     &el)
      INTEGER cctk_convfac
      integer, parameter :: cctki_use_cctk_convfac = kind(cctk_convfac)
      INTEGER cctk_nghostzones (cctk_dim)
      integer, parameter :: cctki_use_cctk_nghostzones = kind(cctk_nghos
     &tzones)
      INTEGER cctk_iteration
      integer, parameter :: cctki_use_cctk_iteration = kind(cctk_iterati
     &on)
      integer*8 cctkGH
      integer, parameter :: cctki_use_cctkGH = kind(cctkGH)
      INTEGER cctk_ash1
      integer, parameter :: cctki_use_cctk_ash1 = kind(cctk_ash1)
      INTEGER cctk_ash2
      integer, parameter :: cctki_use_cctk_ash2 = kind(cctk_ash2)
      INTEGER cctk_ash3
      integer, parameter :: cctki_use_cctk_ash3 = kind(cctk_ash3)
      REAL*8 r (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_r = kind(r)
      REAL*8 x (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_x = kind(x)
      REAL*8 y (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_y = kind(y)
      REAL*8 z (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_z = kind(z)

      integer i,j,k,ierr
      REAL*8 lower,upper

      do k=cctk_lbnd(3),cctk_ubnd(3)
	 do j=cctk_lbnd(2),cctk_ubnd(2)
	    do i=cctk_lbnd(1),cctk_ubnd(1)
	       x(i,j,k) = i
	       y(i,j,k) = j
	       z(i,j,k) = k
            end do
         end do
      end do

      do k=cctk_lbnd(3),cctk_ubnd(3)
	 do j=cctk_lbnd(2),cctk_ubnd(2)
	    do i=cctk_lbnd(1),cctk_ubnd(1)
	       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

      print *
      print *,"REGISTERING COORDINATES"
      print *,"-----------------------"
      print *,"CCTK_CoordRegisterData(ierr,1,<coordinates::x>,<x>,<testc
     &art3d>)"
      call CCTK_CoordRegisterData(ierr,1,"coordinates::x","x","testcart3
     &d")
      print *,"ierr = ",ierr
      print *,"CCTK_CoordRegisterData(ierr,2,<coordinates::y>,<y>,<testc
     &art3d>)"
      call CCTK_CoordRegisterData(ierr,2,"coordinates::y","y","testcart3
     &d")
      print *,"ierr = ",ierr

      print *
      print *,"WRONGLY REGISTERING A COORDINATE"
      print *,"--------------------------------"
	
      print *,"Registering for a non-existent system ..."
      print *,"CCTK_CoordRegisterData(ierr,1,<coordinates::x>,<new>,<sil
     &ly>)"
      call CCTK_CoordRegisterData(ierr,1,"coordinates::x","new","silly")
     &
      print *,"ierr = ",ierr

      print *,"Registering outside dimension ..."
      print *,"CCTK_CoordRegisterData(ierr,4,<coordinates::x>,<new>,<tes
     &tcart3d>)"
      call CCTK_CoordRegisterData(ierr,4,"coordinates::x","new","testcar
     &t3d")
      print *,"ierr = ",ierr

      print *,"Registering for the same direction ..."
      print *,"CCTK_CoordRegisterData(ierr,1,<coordinates::x>,<new>,<tes
     &tcart3d>)"
      call CCTK_CoordRegisterData(ierr,1,"coordinates::x","new","testcar
     &t3d")
      print *,"ierr = ",ierr

      print *,"Registering with the same name ..."
      print *,"CCTK_CoordRegisterData(ierr,3,<coordinates::x>,<x>,<testc
     &art3d>)"
      call CCTK_CoordRegisterData(ierr,3,"coordinates::x","x","testcart3
     &d")
      print *,"ierr = ",ierr

      print *,"Registering something not a grid variable ..."
      print *,"CCTK_CoordRegisterData(ierr,3,<coordinates::silly>,<z>,<t
     &estcart3d>)"
      call CCTK_CoordRegisterData(ierr,3,"coordinates::silly","z","testc
     &art3d")
      print *,"ierr = ",ierr


      print *
      print *,"CORRECTLY REGISTERING COORDINATE RANGE"
      print *,"--------------------------------------"

c
      lower = 1.0
      upper = cctk_gsh(1)
      print *
      print *,"CCTK_CoordRegisterRange(ierr,cctkGH,lower,upper,1,<>,<tes
     &tcart3d>)"
      call CCTK_CoordRegisterRange(ierr,cctkGH,lower,upper,1,"","testcar
     &t3d")
      print *,"ierr=",ierr

c
      lower = 1.0
      upper = cctk_gsh(2)
      print *
      print *,"CCTK_CoordRegisterRange(ierr,cctkGH,lower,upper,-1,<y>,<t
     &estcart3d>)"
      call CCTK_CoordRegisterRange(ierr,cctkGH,lower,upper,-1,"y","testc
     &art3d")
      print *,"ierr=",ierr

      print *
      print *,"WRONGLY REGISTERING COORDINATE RANGE"
      print *,"------------------------------------"

c
      print *,"Registering with the same direction ..."
      lower = -1.0
      upper = 1.0
      print *,"CCTK_CoordRegisterRange(ierr,cctkGH,lower,upper,1,<>,<tes
     &tcart3d>)"
      call CCTK_CoordRegisterRange(ierr,cctkGH,lower,upper,1,"","testcar
     &t3d")
      print *,"ierr=",ierr

      end



      subroutine Coordinates_Query(cctk_dim,cctk_gsh,cctk_lsh,cctk_lbnd,
     &cctk_ubnd,cctk_tile_min,cctk_tile_max,cctk_ash,cctk_alignment,cctk
     &_alignment_offset,cctk_from,cctk_to,cctk_bbox,cctk_delta_time,cctk
     &_time,cctk_delta_space,cctk_origin_space,cctk_levfac,cctk_levoff,c
     &ctk_levoffdenom,cctk_timefac,cctk_convlevel,cctk_convfac,cctk_ngho
     &stzones,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cctk_ash3, r,x,y
     &,z)

      implicit none


      INTEGER cctk_dim
      integer, parameter :: cctki_use_cctk_dim = kind(cctk_dim)
      INTEGER cctk_gsh (cctk_dim)
      integer, parameter :: cctki_use_cctk_gsh = kind(cctk_gsh)
      INTEGER cctk_lsh (cctk_dim)
      integer, parameter :: cctki_use_cctk_lsh = kind(cctk_lsh)
      INTEGER cctk_lbnd (cctk_dim)
      integer, parameter :: cctki_use_cctk_lbnd = kind(cctk_lbnd)
      INTEGER cctk_ubnd (cctk_dim)
      integer, parameter :: cctki_use_cctk_ubnd = kind(cctk_ubnd)
      INTEGER cctk_tile_min (cctk_dim)
      integer, parameter :: cctki_use_cctk_tile_min = kind(cctk_tile_min
     &)
      INTEGER cctk_tile_max (cctk_dim)
      integer, parameter :: cctki_use_cctk_tile_max = kind(cctk_tile_max
     &)
      INTEGER cctk_ash (cctk_dim)
      integer, parameter :: cctki_use_cctk_ash = kind(cctk_ash)
      INTEGER cctk_alignment
      integer, parameter :: cctki_use_cctk_alignment = kind(cctk_alignme
     &nt)
      INTEGER cctk_alignment_offset
      integer, parameter :: cctki_use_cctk_alignment_offset = kind(cctk_
     &alignment_offset)
      INTEGER cctk_from (cctk_dim)
      integer, parameter :: cctki_use_cctk_from = kind(cctk_from)
      INTEGER cctk_to (cctk_dim)
      integer, parameter :: cctki_use_cctk_to = kind(cctk_to)
      INTEGER cctk_bbox (2*cctk_dim)
      integer, parameter :: cctki_use_cctk_bbox = kind(cctk_bbox)
      REAL*8 cctk_delta_time
      integer, parameter :: cctki_use_cctk_delta_time = kind(cctk_delta_
     &time)
      REAL*8 cctk_time
      integer, parameter :: cctki_use_cctk_time = kind(cctk_time)
      REAL*8 cctk_delta_space (cctk_dim)
      integer, parameter :: cctki_use_cctk_delta_space = kind(cctk_delta
     &_space)
      REAL*8 cctk_origin_space (cctk_dim)
      integer, parameter :: cctki_use_cctk_origin_space = kind(cctk_orig
     &in_space)
      INTEGER cctk_levfac (cctk_dim)
      integer, parameter :: cctki_use_cctk_levfac = kind(cctk_levfac)
      INTEGER cctk_levoff (cctk_dim)
      integer, parameter :: cctki_use_cctk_levoff = kind(cctk_levoff)
      INTEGER cctk_levoffdenom (cctk_dim)
      integer, parameter :: cctki_use_cctk_levoffdenom = kind(cctk_levof
     &fdenom)
      INTEGER cctk_timefac
      integer, parameter :: cctki_use_cctk_timefac = kind(cctk_timefac)
      INTEGER cctk_convlevel
      integer, parameter :: cctki_use_cctk_convlevel = kind(cctk_convlev
     &el)
      INTEGER cctk_convfac
      integer, parameter :: cctki_use_cctk_convfac = kind(cctk_convfac)
      INTEGER cctk_nghostzones (cctk_dim)
      integer, parameter :: cctki_use_cctk_nghostzones = kind(cctk_nghos
     &tzones)
      INTEGER cctk_iteration
      integer, parameter :: cctki_use_cctk_iteration = kind(cctk_iterati
     &on)
      integer*8 cctkGH
      integer, parameter :: cctki_use_cctkGH = kind(cctkGH)
      INTEGER cctk_ash1
      integer, parameter :: cctki_use_cctk_ash1 = kind(cctk_ash1)
      INTEGER cctk_ash2
      integer, parameter :: cctki_use_cctk_ash2 = kind(cctk_ash2)
      INTEGER cctk_ash3
      integer, parameter :: cctki_use_cctk_ash3 = kind(cctk_ash3)
      REAL*8 r (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_r = kind(r)
      REAL*8 x (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_x = kind(x)
      REAL*8 y (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_y = kind(y)
      REAL*8 z (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_z = kind(z)

      integer dim,index,ierr,dir
      REAL*8 lower,upper

      print *
      print *,"WRONGLY QUERYING DIMENSION"
      print *,"----------------------------"

      print *
      print *,"Wrong system name"
      print *,"CCTK_CoordSystemDim(dim,<silly>)"
      call CCTK_CoordSystemDim(dim,"silly")
      print *,"dim=",dim

      print *
      print *,"CORRECTLY QUERYING DIMENSION"
      print *,"----------------------------"

      print *
      print *,"CCTK_CoordSystemDim(dim,<testcart3d>)"
      call CCTK_CoordSystemDim(dim,"testcart3d")
      print *,"dim=",dim

      print *
      print *,"CCTK_CoordSystemDim(dim,<testspher3d>)"
      call CCTK_CoordSystemDim(dim,"testspher3d")
      print *,"dim=",dim

      print *
      print *,"CORRECTLY QUERYING INDEX"
      print *,"------------------------"

      print *
      print *,"CCTK_CoordIndex(index,1,<>,<testcart3d>)"
      call CCTK_CoordIndex(index,1,"","testcart3d")
      print *,"index=",index

      print *
      print *,"CCTK_CoordIndex(index,2,<>,<testcart3d>)"
      call CCTK_CoordIndex(index,2,"","testcart3d")
      print *,"index=",index

      print *
      print *,"CCTK_CoordIndex(index,-1,<x>,<testcart3d>)"
      call CCTK_CoordIndex(index,-1,"x","testcart3d")
      print *,"index=",index

      print *
      print *,"CCTK_CoordIndex(index,-1,<y>,<testcart3d>)"
      call CCTK_CoordIndex(index,-1,"y","testcart3d")
      print *,"index=",index

      print *
      print *,"WRONGLY QUERYING INDEX"
      print *,"----------------------"
     
      print *
      print *,"Wrong system name ..."
      print *,"CCTK_CoordIndex(index,1,<>,<silly>)"
      call CCTK_CoordIndex(index,1,"","silly")
      print *,"index=",index
      
      print *
      print *,"Direction out of range ..."
      print *,"CCTK_CoordIndex(index,4,<>,<testcart3d>)"
      call CCTK_CoordIndex(index,4,"","testcart3d")
      print *,"index=",index

      print *
      print *,"Wrong coordinate name ..."
      print *,"CCTK_CoordIndex(index,-1,<silly>,<testcart3d>)"
      call CCTK_CoordIndex(index,-1,"silly","testcart3d")
      print *,"index=",index

      print *
      print *,"Unregistered coordinate ..."
      print *,"CCTK_CoordIndex(index,3,<>,<testcart3d>)"
      call CCTK_CoordIndex(index,3,"","testcart3d")
      print *,"index=",index


      print *
      print *,"WRONGLY QUERYING RANGE"
      print *,"----------------------"

      print *,"Wrong system name ..."
      print *,"CCTK_CoordRange(ierr,cctkGH,lower,upper,1,<>,<silly>)"
      call CCTK_CoordRange(ierr,cctkGH,lower,upper,1,"","silly")
      print *,"ierr=",ierr
      print *,"lower=",lower
      print *,"upper=",upper

      print *
      print *,"Wrong direction ..."
      print *,"CCTK_CoordRange(ierr,cctkGH,lower,upper,34,<>,<cartgrid3d
     &>)"
      call CCTK_CoordRange(ierr,cctkGH,lower,upper,1,"","cartgrid3d")
      print *,"ierr=",ierr
      print *,"lower=",lower
      print *,"upper=",upper

      print *
      print *,"Range not registered ..."
      call CCTK_CoordRange(ierr,cctkGH,lower,upper,3,"","cartgrid3d")
      print *,"CCTK_CoordRange(ierr,cctkGH,lower,upper,3,<>,<cartgrid3d>
     &)"
      print *,"ierr=",ierr
      print *,"lower=",lower
      print *,"upper=",upper


      print *
      print *,"CORRECTLY QUERYING RANGE"
      print *,"------------------------"

      print *
      print *,"CCTK_CoordRange(ierr,cctkGH,lower,upper,1,<>,<testcart3d>
     &)"
      call CCTK_CoordRange(ierr,cctkGH,lower,upper,1,"","testcart3d")
      print *,"ierr=",ierr
      print *,"lower=",lower
      print *,"upper=",upper

      print *
      print *,"CCTK_CoordRange(ierr,cctkGH,lower,upper,2,<>,<testcart3d>
     &)"
      call CCTK_CoordRange(ierr,cctkGH,lower,upper,2,"","testcart3d")
      print *,"ierr=",ierr
      print *,"lower=",lower
      print *,"upper=",upper


      print *
      print *,"INCORRECTLY QUERYING COORDINATE DIRECTION"
      print *,"-----------------------------------------"

      print *
      print *,"Wrong system name ..."
      print *,"CCTK_CoordDir(dir,<x>,<silly>)"
      call CCTK_CoordDir(dir,"x","silly")
      print *,"dir=",dir

      print *
      print *,"Wrong coordinate name ..."
      print *,"CCTK_CoordDir(dir,<silly>,<testcart3d>)"
      call CCTK_CoordDir(dir,"silly","testcart3d")
      print *,"dir=",dir

      print *
      print *,"CORRECTLY QUERYING COORDINATE DIRECTION"
      print *,"---------------------------------------"

      print *
      print *,"CCTK_CoordDir(dir,<x>,<testcart3d>)"
      call CCTK_CoordDir(dir,"x","testcart3d")
      print *,"dir=",dir

      end
