














































c










































































 


































































































































































 































































































































































































 



















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                







































      subroutine InitComplex3D(cctk_dim,cctk_gsh,cctk_lsh,cctk_lbnd,cctk
     &_ubnd,cctk_tile_min,cctk_tile_max,cctk_ash,cctk_alignment,cctk_ali
     &gnment_offset,cctk_from,cctk_to,cctk_bbox,cctk_delta_time,cctk_tim
     &e,cctk_delta_space,cctk_origin_space,cctk_levfac,cctk_levoff,cctk_
     &levoffdenom,cctk_timefac,cctk_convlevel,cctk_convfac,cctk_nghostzo
     &nes,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cctk_ash3, X0carrays
     &1d,X0carrays2d,X0carrays3d,X1carrays2d,X1carrays3d,X2carrays3d,aco
     &mp1d,acomp2d,acomp3d,comp3d,comp3d_p,imaginary_part,real_part,scom
     &p)

      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)
      INTEGER X0carrays1d
      INTEGER X0carrays2d
      INTEGER X0carrays3d
      INTEGER X1carrays2d
      INTEGER X1carrays3d
      INTEGER X2carrays3d
      COMPLEX*16 acomp1d (X0carrays1d)
      integer, parameter :: cctki_use_acomp1d = kind(acomp1d)
      COMPLEX*16 acomp2d (X0carrays2d,X1carrays2d)
      integer, parameter :: cctki_use_acomp2d = kind(acomp2d)
      COMPLEX*16 acomp3d (X0carrays3d,X1carrays3d,X2carrays3d)
      integer, parameter :: cctki_use_acomp3d = kind(acomp3d)
      COMPLEX*16 comp3d (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_comp3d = kind(comp3d)
      COMPLEX*16 comp3d_p (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_comp3d_p = kind(comp3d_p)
      REAL*8 imaginary_part
      integer, parameter :: cctki_use_imaginary_part = kind(imaginary_pa
     &rt)
      REAL*8 real_part
      integer, parameter :: cctki_use_real_part = kind(real_part)
      COMPLEX*16 scomp
      integer, parameter :: cctki_use_scomp = kind(scomp)

      integer grouplbnd(3), grouplsh(3)
      integer i0,j0,k0
      integer nx,ny,nz
      integer i,j,k
      integer ierr

      i0 = cctk_lbnd(1)
      j0 = cctk_lbnd(2)
      k0 = cctk_lbnd(3)
      nx = cctk_lsh(1)
      ny = cctk_lsh(2)
      nz = cctk_lsh(3)

      do k=1,nz
        do j=1,ny
          do i=1, nx

            comp3d_p(i,j,k) = dcmplx(sqrt(dble(i0+i)**2+
     &                       	          dble(j0+j)**2+
     &	                     	          dble(k0+k)**2
     &                                   )
     &                              ,
     &                               dble(i0+i)**2+
     &                               dble(j0+j)**2+
     &	                     	     dble(k0+k)**2
     &                              )

	    comp3d(i,j,k) = comp3d_p(i,j,k)

          end do
        end do
      end do

      call CCTK_GrouplbndGN (ierr, cctkGH, 3, grouplbnd, "TestComplex::c
     &arrays3d")
      if (ierr .ne. 0) call CCTK_Error(46,"Complex3D.F77","TestComplex",
     &"Group not found")
      i0 = grouplbnd(1)-1
      j0 = grouplbnd(2)-1
      k0 = grouplbnd(3)-1

      call CCTK_GrouplshGN (ierr, cctkGH, 3, grouplsh, "TestComplex::car
     &rays3d")
      if (ierr .ne. 0) call CCTK_Error(52,"Complex3D.F77","TestComplex",
     &"Group not found")
      nx = grouplsh(1)
      ny = grouplsh(2)
      nz = grouplsh(3)

      do k=1,nz
         do j=1,ny
            do i=1,nx
               acomp3d(i,j,k) = dcmplx(i0+i+j0+j,j0+j+k0+k)
            end do
         end do
      end do

      call CCTK_GrouplbndGN (ierr, cctkGH, 2, grouplbnd, "TestComplex::c
     &arrays2d")
      if (ierr .ne. 0) call CCTK_Error(66,"Complex3D.F77","TestComplex",
     &"Group not found")
      i0 = grouplbnd(1)-1
      j0 = grouplbnd(2)-1

      call CCTK_GrouplshGN (ierr, cctkGH, 2, grouplsh, "TestComplex::car
     &rays2d")
      if (ierr .ne. 0) call CCTK_Error(71,"Complex3D.F77","TestComplex",
     &"Group not found")
      nx = grouplsh(1)
      ny = grouplsh(2)

      do j=1,ny
         do i=1,nx
            acomp2d(i,j) = dcmplx(i0+i,j0+j)
         end do
      end do

      call CCTK_GrouplbndGN (ierr, cctkGH, 1, grouplbnd, "TestComplex::c
     &arrays1d")
      if (ierr .ne. 0) call CCTK_Error(82,"Complex3D.F77","TestComplex",
     &"Group not found")
      i0 = grouplbnd(1)-1

      call CCTK_GrouplshGN (ierr, cctkGH, 1, grouplsh, "TestComplex::car
     &rays1d")
      if (ierr .ne. 0) call CCTK_Error(86,"Complex3D.F77","TestComplex",
     &"Group not found")
      nx = grouplsh(1)

      do i=1,nx
         acomp1d(i) = dcmplx(1,i0+i)
      end do

      scomp = dcmplx(1,2)

      end


      subroutine EvolveComplex3D(cctk_dim,cctk_gsh,cctk_lsh,cctk_lbnd,cc
     &tk_ubnd,cctk_tile_min,cctk_tile_max,cctk_ash,cctk_alignment,cctk_a
     &lignment_offset,cctk_from,cctk_to,cctk_bbox,cctk_delta_time,cctk_t
     &ime,cctk_delta_space,cctk_origin_space,cctk_levfac,cctk_levoff,cct
     &k_levoffdenom,cctk_timefac,cctk_convlevel,cctk_convfac,cctk_nghost
     &zones,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cctk_ash3, X0carra
     &ys1d,X0carrays2d,X0carrays3d,X1carrays2d,X1carrays3d,X2carrays3d,a
     &comp1d,acomp2d,acomp3d,comp3d,comp3d_p,imaginary_part,real_part,sc
     &omp)

      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)
      INTEGER X0carrays1d
      INTEGER X0carrays2d
      INTEGER X0carrays3d
      INTEGER X1carrays2d
      INTEGER X1carrays3d
      INTEGER X2carrays3d
      COMPLEX*16 acomp1d (X0carrays1d)
      integer, parameter :: cctki_use_acomp1d = kind(acomp1d)
      COMPLEX*16 acomp2d (X0carrays2d,X1carrays2d)
      integer, parameter :: cctki_use_acomp2d = kind(acomp2d)
      COMPLEX*16 acomp3d (X0carrays3d,X1carrays3d,X2carrays3d)
      integer, parameter :: cctki_use_acomp3d = kind(acomp3d)
      COMPLEX*16 comp3d (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_comp3d = kind(comp3d)
      COMPLEX*16 comp3d_p (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_comp3d_p = kind(comp3d_p)
      REAL*8 imaginary_part
      integer, parameter :: cctki_use_imaginary_part = kind(imaginary_pa
     &rt)
      REAL*8 real_part
      integer, parameter :: cctki_use_real_part = kind(real_part)
      COMPLEX*16 scomp
      integer, parameter :: cctki_use_scomp = kind(scomp)

      integer nx,ny,nz
      integer i,j,k

      nx = cctk_lsh(1)
      ny = cctk_lsh(2)
      nz = cctk_lsh(3)

c
      comp3d = comp3d_p

      do k=2,nz-1
        do j=2,ny-1
          do i=2,nx-1

            comp3d(i,j,k) = 1.0/6.0*(
     &          comp3d_p(i-1,j,k)+comp3d_p(i+1,j,k)+
     &          comp3d_p(i,j-1,k)+comp3d_p(i,j+1,k)+
     &          comp3d_p(i,j,k-1)+comp3d_p(i,j,k+1)
     &      )

          end do
        end do
      end do

      end
