From 6b6a63df2cd875b410295b991923452b16be6c32 Mon Sep 17 00:00:00 2001 From: tradke Date: Fri, 31 Jan 2003 14:15:03 +0000 Subject: Replaced all the CCTK_InterpGV() calls by calls to the new interpolation API CCTK_InterpGridArrays(). Note that you now need to also compile in and activate a thorn which provides local interpolation operators (eg. LocalInterp from the CactusBase arrangement). Also evaluate the return code from CCTK_InterpGridArrays() and print a warning in case of an error. git-svn-id: http://svn.einsteintoolkit.org/cactus/EinsteinAnalysis/Extract/trunk@69 5301f0c2-dbc4-4cee-b2f5-8d7afba4d129 --- src/D3_to_D2.F | 395 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 213 insertions(+), 182 deletions(-) diff --git a/src/D3_to_D2.F b/src/D3_to_D2.F index a7d22b2..7bc7586 100644 --- a/src/D3_to_D2.F +++ b/src/D3_to_D2.F @@ -11,11 +11,10 @@ c ======================================================================== & dgyys,dgyzs,dgzzs,ADMmass_int1,ADMmass_int2, & momentum_int1,momentum_int2,momentum_int3, & spin_int1,spin_int2,spin_int3,Extract_temp3d) - + c ------------------------------------------------------------------------ c -c Project the 3-metric and its 1st radial derivatives onto a -c 2-sphere. +c Project the 3-metric and its 1st radial derivatives onto a 2-sphere. c c ------------------------------------------------------------------------ @@ -26,19 +25,21 @@ c ------------------------------------------------------------------------ IMPLICIT NONE + DECLARE_CCTK_FUNCTIONS + c Input variables CCTK_POINTER :: cctkGH - INTEGER,INTENT(IN) :: + INTEGER,INTENT(IN) :: & conformal_state,myproc,Psi_power CCTK_INT, INTENT(IN) :: & Nt,Np,do_momentum,do_spin,interpolation_order - CCTK_REAL,INTENT(IN) :: + CCTK_REAL,INTENT(IN) :: & origin(3),Dx,Dy,Dz,eta - CCTK_REAL,INTENT(IN),DIMENSION(:) :: + CCTK_REAL,INTENT(IN),DIMENSION(:) :: & theta,phi,x,y,z - CCTK_REAL,INTENT(IN),DIMENSION(:,:,:) :: + CCTK_REAL,INTENT(IN),DIMENSION(:,:,:) :: & Psi,g00,gxx,gxy,gxz,gyy,gyz,gzz, & hxx,hxy,hxz,hyy,hyz,hzz CCTK_REAL,INTENT(INOUT),DIMENSION(:,:,:) :: @@ -48,7 +49,7 @@ c Input variables c Output variables - CCTK_REAL,INTENT(OUT),DIMENSION(:,:) :: + CCTK_REAL,INTENT(OUT),DIMENSION(:,:) :: & Psis,g00s,gxxs,gxys,gxzs,gyys, & gyzs,gzzs,dPsis,dgxxs,dgxys,dgxzs,dgyys,dgyzs,dgzzs, & ADMmass_int1,ADMmass_int2, @@ -58,30 +59,34 @@ c Output variables c Local variables, passed on - LOGICAL :: + LOGICAL :: & err_flag - INTEGER :: + INTEGER :: & iorder,npoints,Nx,Ny,Nz - INTEGER,DIMENSION(Nt,Np) :: + INTEGER,DIMENSION(Nt,Np) :: & ib,jb,kb - CCTK_REAL,DIMENSION(Nt,Np) :: + CCTK_REAL,DIMENSION(Nt,Np) :: & xs,ys,zs,ux,uy,uz,xb,yb,zb c Local variables, here only - INTEGER :: - & i,j,interp_handle,coord_system_handle,ierror - INTEGER, DIMENSION(8) :: in_array_indices + INTEGER :: i, j, num_arrays, ierror + INTEGER :: interp_handle, param_table_handle, coord_system_handle + CCTK_POINTER, dimension(3) :: interp_coords + INTEGER, dimension(8) :: in_array_indices + CCTK_POINTER, dimension(8) :: out_arrays + CCTK_INT, dimension(8) :: out_array_type_codes + character(30) options_string c ------------------------------------------------------------------------ - + c Initial Stuff c ------------- Nx = SIZE(x) Ny = SIZE(y) Nz = SIZE(z) - + c Compute Cartesian coordinates on the surface c -------------------------------------------- @@ -98,7 +103,7 @@ c -------------------------------------------- c Only do interpolation on one processor c -------------------------------------- - SELECT CASE (myproc) + SELECT CASE (myproc) CASE (0) npoints = Np*Nt @@ -106,74 +111,76 @@ c -------------------------------------- CASE DEFAULT npoints = 0 - END SELECT + END SELECT -c Get the interpolator and coordinate system handle -c ------------------------------------------------- +c Get the interpolator, parameter table, and coordinate system handles +c -------------------------------------------------------------------- interp_handle = -1 + param_table_handle = -1 coord_system_handle = -1 - if (interpolation_order .eq. 1) then - call CCTK_InterpHandle (interp_handle, "first-order uniform cartesian") - else if (interpolation_order .eq. 2) then - call CCTK_InterpHandle (interp_handle, "second-order uniform cartesian") - else if (interpolation_order .eq. 3) then - call CCTK_InterpHandle (interp_handle, "third-order uniform cartesian") + call CCTK_InterpHandle (interp_handle,"Lagrange polynomial interpolation") + if (interp_handle .lt. 0) then + call CCTK_WARN(0,"Cannot get handle for interpolation ! Forgot to activate an implementation providing interpolation operators ??") endif - call CCTK_CoordSystemHandle (coord_system_handle, "cart3d") + options_string = "order = " // char(ichar('0') + interpolation_order) + call Util_TableCreateFromString (param_table_handle, options_string) + if (param_table_handle .lt. 0) then + call CCTK_WARN(0,"Cannot create parameter table for interpolator") + endif - if (interp_handle .lt. 0 .or. coord_system_handle .lt. 0) then - call CCTK_WARN (0, "Couldn't get handles for interpolation operator and/or coordinate system") + call CCTK_CoordSystemHandle (coord_system_handle, "cart3d") + if (coord_system_handle .lt. 0) then + call CCTK_WARN(0,"Cannot get handle for cart3d coordinate system ! Forgot to activate an implementation providing coordinates ??") endif -c Get indices of GFs to interpolate -c --------------------------------- - call CCTK_VarIndex(in_array_indices(1), "staticconformal::psi") - call CCTK_VarIndex(in_array_indices(2), "extract::g00") - call CCTK_VarIndex(in_array_indices(3), "admbase::gxx") - call CCTK_VarIndex(in_array_indices(4), "admbase::gxy") - call CCTK_VarIndex(in_array_indices(5), "admbase::gxz") - call CCTK_VarIndex(in_array_indices(6), "admbase::gyy") - call CCTK_VarIndex(in_array_indices(7), "admbase::gyz") - call CCTK_VarIndex(in_array_indices(8), "admbase::gzz") + +c fill in the input/output arrays for the interpolator +c ---------------------------------------------------- + interp_coords(1) = CCTK_PointerTo(xs) + interp_coords(2) = CCTK_PointerTo(ys) + interp_coords(3) = CCTK_PointerTo(zs) + + call CCTK_VarIndex(in_array_indices(1), "extract::g00") + call CCTK_VarIndex(in_array_indices(2), "admbase::gxx") + call CCTK_VarIndex(in_array_indices(3), "admbase::gxy") + call CCTK_VarIndex(in_array_indices(4), "admbase::gxz") + call CCTK_VarIndex(in_array_indices(5), "admbase::gyy") + call CCTK_VarIndex(in_array_indices(6), "admbase::gyz") + call CCTK_VarIndex(in_array_indices(7), "admbase::gzz") + call CCTK_VarIndex(in_array_indices(8), "staticconformal::psi") + + out_arrays(1) = CCTK_PointerTo(g00s) + out_arrays(2) = CCTK_PointerTo(gxxs) + out_arrays(3) = CCTK_PointerTo(gxys) + out_arrays(4) = CCTK_PointerTo(gxzs) + out_arrays(5) = CCTK_PointerTo(gyys) + out_arrays(6) = CCTK_PointerTo(gyzs) + out_arrays(7) = CCTK_PointerTo(gzzs) + out_arrays(8) = CCTK_PointerTo(Psis) + + out_array_type_codes = CCTK_VARIABLE_REAL c Project un-physical metric and conformal factor onto sphere c ------------------------------------------------------------ if (conformal_state > 0) then - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 8, 8, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), in_array_indices(2), - $ in_array_indices(3), in_array_indices(4), - $ in_array_indices(5), in_array_indices(6), - $ in_array_indices(7), in_array_indices(8), - $ Psis, g00s, gxxs, gxys, gxzs, gyys, gyzs, gzzs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL) + num_arrays = 8 else - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 7, 7, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(2), - $ in_array_indices(3), in_array_indices(4), - $ in_array_indices(5), in_array_indices(6), - $ in_array_indices(7), in_array_indices(8), - $ g00s, gxxs, gxys, gxzs, gyys, gyzs, gzzs, - $ CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL) + num_arrays = 7 end if + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ num_arrays, in_array_indices, + $ num_arrays, out_array_type_codes, out_arrays) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif + c Calculate radial derivatives and project onto sphere c ---------------------------------------------------- @@ -181,82 +188,96 @@ c ---------------------------------------------------- if (conformal_state > 0) then CALL met_rad_der(origin,Dx,Dy,Dz,x,y,z,Psi,Extract_temp3d) - CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ dPsis, - $ CCTK_VARIABLE_REAL) + CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") + + out_arrays(1) = CCTK_PointerTo(dPsis) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif end if CALL met_rad_der(origin,Dx,Dy,Dz,x,y,z,gxx,Extract_temp3d) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ dgxxs, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(dgxxs) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL met_rad_der(origin,Dx,Dy,Dz,x,y,z,gxy,Extract_temp3d) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ dgxys, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(dgxys) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL met_rad_der(origin,Dx,Dy,Dz,x,y,z,gxz,Extract_temp3d) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ dgxzs, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(dgxzs) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL met_rad_der(origin,Dx,Dy,Dz,x,y,z,gyy,Extract_temp3d) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ dgyys, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(dgyys) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL met_rad_der(origin,Dx,Dy,Dz,x,y,z,gyz,Extract_temp3d) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ dgyzs, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(dgyzs) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL met_rad_der(origin,Dx,Dy,Dz,x,y,z,gzz,Extract_temp3d) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ dgzzs, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(dgzzs) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif c Calculate integrands for ADM masses @@ -266,21 +287,22 @@ c Standard equation CALL ADMmass_integrand3D(origin,Dx,Dy,Dz,x,y,z,gxx,gxy, & gxz,gyy,gyz,gzz,Extract_temp3d,Psi,Psi_power,conformal_state) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ ADMmass_int1, - $ CCTK_VARIABLE_REAL) + out_arrays(1) = CCTK_PointerTo(ADMmass_int1) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif END IF c Conformal equation IF (do_ADMmass(2)) THEN ADMmass_int2 = -eta**2/2D0/3.1416D0*dPsis - ENDIF + ENDIF c Calculate integrands for momentum c --------------------------------- @@ -290,42 +312,46 @@ c --------------------------------- & gxx,gxy,gxz,gyy,gyz,gzz,hxx,hxy,hxz,hyy,hyz,hzz, & Extract_temp3d,Psi,Psi_power,conformal_state) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ momentum_int1, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(momentum_int1) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL momentum_integrand3D(origin,Dx,Dy,Dz,x,y,z, & gxx,gxy,gxz,gyy,gyz,gzz,hxx,hxy,hxz,hyy,hyz,hzz, & Extract_temp3d,Psi,Psi_power,conformal_state) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ momentum_int2, - $ CCTK_VARIABLE_REAL) + out_arrays(1) = CCTK_PointerTo(momentum_int2) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL momentum_integrand3D(origin,Dx,Dy,Dz,x,y,z, & gxx,gxy,gxz,gyy,gyz,gzz,hxx,hxy,hxz,hyy,hyz,hzz, & Extract_temp3d,Psi,Psi_power,conformal_state) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ momentum_int3, - $ CCTK_VARIABLE_REAL) + out_arrays(1) = CCTK_PointerTo(momentum_int3) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif END IF c Calculate integrands for spin @@ -336,41 +362,46 @@ c ----------------------------- & gxx,gxy,gxz,gyy,gyz,gzz,hxx,hxy,hxz,hyy,hyz,hzz, & Extract_temp3d,Psi,Psi_power,conformal_state) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ spin_int1, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(spin_int1) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL spin_integrand3D(origin,x,y,z, & gxx,gxy,gxz,gyy,gyz,gzz,hxx,hxy,hxz,hyy,hyz,hzz, & Extract_temp3d,Psi,Psi_power,conformal_state) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ spin_int2, - $ CCTK_VARIABLE_REAL) + out_arrays(1) = CCTK_PointerTo(spin_int2) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif CALL spin_integrand3D(origin,x,y,z, & gxx,gxy,gxz,gyy,gyz,gzz,hxx,hxy,hxz,hyy,hyz,hzz, & Extract_temp3d,Psi,Psi_power,conformal_state) CALL CCTK_SyncGroup(ierror,cctkGH,"extract::temps") - call CCTK_InterpGV (ierror, cctkGH, interp_handle, coord_system_handle, - $ npoints, 1, 1, - $ xs, ys, zs, - $ CCTK_VARIABLE_REAL, CCTK_VARIABLE_REAL, - $ CCTK_VARIABLE_REAL, - $ in_array_indices(1), - $ spin_int3, - $ CCTK_VARIABLE_REAL) + + out_arrays(1) = CCTK_PointerTo(spin_int3) + call CCTK_InterpGridArrays (ierror, cctkGH, 3, interp_handle, + $ param_table_handle, coord_system_handle, + $ npoints, CCTK_VARIABLE_REAL, interp_coords, + $ 1, in_array_indices(1), + $ 1, out_array_type_codes, out_arrays(1)) + if (ierror < 0) then + call CCTK_WARN (1, "interpolator call returned an error code"); + endif END IF -- cgit v1.2.3