














































c
c
C $Header$




































































 


































































































































































 


















































































































































































































 



















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                







































c
c

c

c
c
c
c
c
c
c
c
c

c

c

      subroutine Exact__linear_extrap_one_bndry(cctk_dim,cctk_gsh,cctk_l
     &sh,cctk_lbnd,cctk_ubnd,cctk_tile_min,cctk_tile_max,cctk_ash,cctk_a
     &lignment,cctk_alignment_offset,cctk_from,cctk_to,cctk_bbox,cctk_de
     &lta_time,cctk_time,cctk_delta_space,cctk_origin_space,cctk_levfac,
     &cctk_levoff,cctk_levoffdenom,cctk_timefac,cctk_convlevel,cctk_conv
     &fac,cctk_nghostzones,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cct
     &k_ash3, slicet,slicetmp1t,slicetmp1x,slicetmp1y,slicetmp1z,slicetm
     &p2t,slicetmp2x,slicetmp2y,slicetmp2z,slicex,slicey,slicez, Bertott
     &i___Lambda,Kasner_generalized___p1,Kasner_generalized___p2,Kasner_
     &like___q,Lemaitre___Lambda,Lemaitre___R0,Lemaitre___epsilon0,Lemai
     &tre___kappa,Schwarzschild_Lemaitre___Lambda,Schwarzschild_Lemaitre
     &___mass,anti_de_Sitter_Lambda___scale,constant_density_star___mass
     &,constant_density_star___radius,de_Sitter_Lambda___scale,de_Sitter
     &___scale,decoded_exact_model, active_slicing_handle,alp,alp_p,alp_
     &p_p,betax,betax_p,betax_p_p,betay,betay_p,betay_p_p,betaz,betaz_p,
     &betaz_p_p,coarse_dx,coarse_dy,coarse_dz,conformal_state,dtalp,dtal
     &p_p,dtalp_p_p,dtbetax,dtbetax_p,dtbetax_p_p,dtbetay,dtbetay_p,dtbe
     &tay_p_p,dtbetaz,dtbetaz_p,dtbetaz_p_p,dtlapse_state,dtshift_state,
     &gxx,gxx_p,gxx_p_p,gxy,gxy_p,gxy_p_p,gxz,gxz_p,gxz_p_p,gyy,gyy_p,gy
     &y_p_p,gyz,gyz_p,gyz_p_p,gzz,gzz_p,gzz_p_p,kxx,kxx_p,kxx_p_p,kxy,kx
     &y_p,kxy_p_p,kxz,kxz_p,kxz_p_p,kyy,kyy_p,kyy_p_p,kyz,kyz_p,kyz_p_p,
     &kzz,kzz_p,kzz_p_p,psi,psix,psixx,psixy,psixz,psiy,psiyy,psiyz,psiz
     &,psizz,r,shift_state,x,y,z,var)

      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)
      ;  characTer*8, intent(IN) :: slicet
      characTer*8, intent(IN) :: slicetmp1t
      characTer*8, intent(IN) :: slicetmp1x
      characTer*8, intent(IN) :: slicetmp1y
      characTer*8, intent(IN) :: slicetmp1z
      characTer*8, intent(IN) :: slicetmp2t
      characTer*8, intent(IN) :: slicetmp2x
      characTer*8, intent(IN) :: slicetmp2y
      characTer*8, intent(IN) :: slicetmp2z
      characTer*8, intent(IN) :: slicex
      characTer*8, intent(IN) :: slicey
      characTer*8, intent(IN) :: slicez
      characTer*8, intent(IN) :: bertotti___lambda
      characTer*8, intent(IN) :: kasner_generalized___p1
      characTer*8, intent(IN) :: kasner_generalized___p2
      characTer*8, intent(IN) :: kasner_like___q
      characTer*8, intent(IN) :: lemaitre___lambda
      characTer*8, intent(IN) :: lemaitre___r0
      characTer*8, intent(IN) :: lemaitre___epsilon0
      characTer*8, intent(IN) :: lemaitre___kappa
      characTer*8, intent(IN) :: schwarzschild_lemaitre___lambda
      characTer*8, intent(IN) :: schwarzschild_lemaitre___mass
      characTer*8, intent(IN) :: anti_de_sitter_lambda___scale
      characTer*8, intent(IN) :: constant_density_star___mass
      characTer*8, intent(IN) :: constant_density_star___radius
      characTer*8, intent(IN) :: de_sitter_lambda___scale
      characTer*8, intent(IN) :: de_sitter___scale
      characTer*8, intent(IN) :: decoded_exact_model
      characTer*8, intent(IN) :: active_slicing_handle
      characTer*8, intent(IN) :: alp
      characTer*8, intent(IN) :: alp_p
      characTer*8, intent(IN) :: alp_p_p
      characTer*8, intent(IN) :: betax
      characTer*8, intent(IN) :: betax_p
      characTer*8, intent(IN) :: betax_p_p
      characTer*8, intent(IN) :: betay
      characTer*8, intent(IN) :: betay_p
      characTer*8, intent(IN) :: betay_p_p
      characTer*8, intent(IN) :: betaz
      characTer*8, intent(IN) :: betaz_p
      characTer*8, intent(IN) :: betaz_p_p
      characTer*8, intent(IN) :: coarse_dx
      characTer*8, intent(IN) :: coarse_dy
      characTer*8, intent(IN) :: coarse_dz
      characTer*8, intent(IN) :: conformal_state
      characTer*8, intent(IN) :: dtalp
      characTer*8, intent(IN) :: dtalp_p
      characTer*8, intent(IN) :: dtalp_p_p
      characTer*8, intent(IN) :: dtbetax
      characTer*8, intent(IN) :: dtbetax_p
      characTer*8, intent(IN) :: dtbetax_p_p
      characTer*8, intent(IN) :: dtbetay
      characTer*8, intent(IN) :: dtbetay_p
      characTer*8, intent(IN) :: dtbetay_p_p
      characTer*8, intent(IN) :: dtbetaz
      characTer*8, intent(IN) :: dtbetaz_p
      characTer*8, intent(IN) :: dtbetaz_p_p
      characTer*8, intent(IN) :: dtlapse_state
      characTer*8, intent(IN) :: dtshift_state
      characTer*8, intent(IN) :: gxx
      characTer*8, intent(IN) :: gxx_p
      characTer*8, intent(IN) :: gxx_p_p
      characTer*8, intent(IN) :: gxy
      characTer*8, intent(IN) :: gxy_p
      characTer*8, intent(IN) :: gxy_p_p
      characTer*8, intent(IN) :: gxz
      characTer*8, intent(IN) :: gxz_p
      characTer*8, intent(IN) :: gxz_p_p
      characTer*8, intent(IN) :: gyy
      characTer*8, intent(IN) :: gyy_p
      characTer*8, intent(IN) :: gyy_p_p
      characTer*8, intent(IN) :: gyz
      characTer*8, intent(IN) :: gyz_p
      characTer*8, intent(IN) :: gyz_p_p
      characTer*8, intent(IN) :: gzz
      characTer*8, intent(IN) :: gzz_p
      characTer*8, intent(IN) :: gzz_p_p
      characTer*8, intent(IN) :: kxx
      characTer*8, intent(IN) :: kxx_p
      characTer*8, intent(IN) :: kxx_p_p
      characTer*8, intent(IN) :: kxy
      characTer*8, intent(IN) :: kxy_p
      characTer*8, intent(IN) :: kxy_p_p
      characTer*8, intent(IN) :: kxz
      characTer*8, intent(IN) :: kxz_p
      characTer*8, intent(IN) :: kxz_p_p
      characTer*8, intent(IN) :: kyy
      characTer*8, intent(IN) :: kyy_p
      characTer*8, intent(IN) :: kyy_p_p
      characTer*8, intent(IN) :: kyz
      characTer*8, intent(IN) :: kyz_p
      characTer*8, intent(IN) :: kyz_p_p
      characTer*8, intent(IN) :: kzz
      characTer*8, intent(IN) :: kzz_p
      characTer*8, intent(IN) :: kzz_p_p
      characTer*8, intent(IN) :: psi
      characTer*8, intent(IN) :: psix
      characTer*8, intent(IN) :: psixx
      characTer*8, intent(IN) :: psixy
      characTer*8, intent(IN) :: psixz
      characTer*8, intent(IN) :: psiy
      characTer*8, intent(IN) :: psiyy
      characTer*8, intent(IN) :: psiyz
      characTer*8, intent(IN) :: psiz
      characTer*8, intent(IN) :: psizz
      characTer*8, intent(IN) :: r
      characTer*8, intent(IN) :: shift_state
      characTer*8, intent(IN) :: x
      characTer*8, intent(IN) :: y
      characTer*8, intent(IN) :: z

      integer nx,ny,nz

      REAL*8 var(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3))

C     Grid parameters.

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

C     Linear extrapolation from the interiors to the boundaries.
C     Does not support octant or quadrant.

C     6 faces.

      if (cctk_bbox(1).eq.1 .and. nx.ge.4 ) then 
         var(1,:,:) = 2.d0 * var(2,:,:) - var(3,:,:)
      endif
      if (cctk_bbox(3).eq.1 .and. ny.ge.4 ) then 
         var(:,1,:) = 2.d0 * var(:,2,:) - var(:,3,:)
      endif
      if (cctk_bbox(5).eq.1 .and. nz.ge.4 ) then 
         var(:,:,1) = 2.d0 * var(:,:,2) - var(:,:,3)
      endif
      if (cctk_bbox(2).eq.1 .and. nx.ge.4 ) then 
         var(nx,:,:) = 2.d0 * var(nx-1,:,:) - var(nx-2,:,:)
      endif
      if (cctk_bbox(4).eq.1 .and. ny.ge.4 ) then 
         var(:,ny,:) = 2.d0 * var(:,ny-1,:) - var(:,ny-2,:)
      endif
      if (cctk_bbox(6).eq.1 .and. nz.ge.4 ) then 
         var(:,:,nz) = 2.d0 * var(:,:,nz-1) - var(:,:,nz-2)
      endif

C     12 edges.
C     4 round face x=min.
      if ( cctk_bbox(1).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(3).eq.1 .and. ny.ge.4 ) then 
         var(1,1,:) = 2.d0 * var(2,2,:) - var(3,3,:)
      end if

      if ( cctk_bbox(1).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(4).eq.1 .and. ny.ge.4 ) then 
         var(1,ny,:) = 2.d0 * var(2,ny-1,:) - var(2,ny-2,:)
      end if

      if ( cctk_bbox(1).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(5).eq.1 .and. nz.ge.4 ) then 
         var(1,:,1) = 2.d0 * var(2,:,2) - var(3,:,3)
      end if

      if ( cctk_bbox(1).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(6).eq.1 .and. nz.ge.4 ) then 
         var(1,:,nz) = 2.d0 * var(2,:,nz-1) - var(3,:,nz-2)
      end if

C     4 around face x=max.
      if ( cctk_bbox(2).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(3).eq.1 .and. ny.ge.4 ) then 
         var(nx,1,:) = 2.d0 * var(nx-1,2,:) - var(nx-2,3,:)
      end if

      if ( cctk_bbox(2).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(4).eq.1 .and. ny.ge.4 ) then 
         var(nx,ny,:) = 2.d0 * var(nx-1,ny-1,:) - var(nx-2,ny-2,:)
      end if

      if ( cctk_bbox(2).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(5).eq.1 .and. nz.ge.4 ) then 
         var(nx,:,1) = 2.d0 * var(nx-1,:,2) - var(nx-2,:,3)
      end if

      if ( cctk_bbox(2).eq.1 .and. nx.ge.4 
     $     .and. cctk_bbox(6).eq.1 .and. nz.ge.4 ) then 
         var(nx,:,nz) = 2.d0 * var(nx-1,:,nz-1) - var(nx-2,:,nz-2)
      end if

C     Remaining 2 in y=min.
      if ( cctk_bbox(3).eq.1 .and. ny.ge.4
     $     .and. cctk_bbox(5).eq.1 .and. nz.ge.4 ) then
         var(:,1,1) = 2.d0 * var(:,2,2) - var(:,3,3)
      end if

      if ( cctk_bbox(3).eq.1 .and. ny.ge.4
     $     .and. cctk_bbox(6).eq.1 .and. nz.ge.4 ) then 
         var(:,1,nz) = 2.d0 * var(:,2,nz-1) - var(:,2,nz-2)
      end if

C     Remaining 2 in y=ymax.      
      if ( cctk_bbox(4).eq.1 .and. ny.ge.4
     $     .and. cctk_bbox(5).eq.1 .and. nz.ge.4 ) then
         var(:,ny,1) = 2.d0 * var(:,ny-1,2) - var(:,ny-2,3)  
      end if

      if ( cctk_bbox(4).eq.1 .and. ny.ge.4
     $     .and. cctk_bbox(6).eq.1 .and. nz.ge.4 ) then 
         var(:,ny,nz) = 2.d0 * var(:,ny-1,nz-1) - var(:,ny-2,nz-2)
      end if

C     8 corners.

      if (nx.ge.4 .and. ny.ge.4 .and. nz.ge.4) then
         if (cctk_bbox(1).eq.1 .and. cctk_bbox(3).eq.1 .and. cctk_bbox(5
     &).eq.1) then
            var(1,1,1) = 2.d0*var(2,2,2) - var(3,3,3)
         end if
         if (cctk_bbox(1).eq.1 .and. cctk_bbox(3).eq.1 .and. cctk_bbox(6
     &).eq.1) then
            var(1,1,nz) = 2.d0*var(2,2,nz-1) - var(3,3,nz-2)
         end if
         if (cctk_bbox(1).eq.1 .and. cctk_bbox(4).eq.1 .and. cctk_bbox(5
     &).eq.1) then
            var(1,ny,1) = 2.d0*var(2,ny-1,2) - var(3,ny-2,3)
         end if
         if (cctk_bbox(1).eq.1 .and. cctk_bbox(4).eq.1 .and. cctk_bbox(6
     &).eq.1) then
            var(1,ny,nz) = 2.d0*var(2,ny-1,nz-1) - var(3,ny-2,nz-2)
         end if
        if (cctk_bbox(2).eq.1 .and. cctk_bbox(3).eq.1 .and. cctk_bbox(5)
     &.eq.1) then
            var(nx,1,1) = 2.d0*var(nx-1,2,2) - var(nx-2,3,3)
         end if
         if (cctk_bbox(2).eq.1 .and. cctk_bbox(3).eq.1 .and. cctk_bbox(6
     &).eq.1) then
            var(nx,1,nz) = 2.d0*var(nx-1,2,nz-1) - var(nx-2,3,nz-2)
         end if
         if (cctk_bbox(2).eq.1 .and. cctk_bbox(4).eq.1 .and. cctk_bbox(5
     &).eq.1) then
            var(nx,ny,1) = 2.d0*var(nx-1,ny-1,2) - var(nx-2,ny-2,3)
         end if
         if (cctk_bbox(2).eq.1 .and. cctk_bbox(4).eq.1 .and. cctk_bbox(6
     &).eq.1) then
            var(nx,ny,nz) = 2.d0*var(nx-1,ny-1,nz-1) - var(nx-2,ny-2,nz-
     &2)
         end if
      end if


      return
      end
