diff options
Diffstat (limited to 'src/qlm_interpolate.F90')
| -rw-r--r-- | src/qlm_interpolate.F90 | 688 |
1 files changed, 398 insertions, 290 deletions
diff --git a/src/qlm_interpolate.F90 b/src/qlm_interpolate.F90 index 82ec27e..8317de7 100644 --- a/src/qlm_interpolate.F90 +++ b/src/qlm_interpolate.F90 @@ -29,6 +29,8 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) integer, parameter :: sk = kind(interpolator) CCTK_REAL, parameter :: one = 1 + CCTK_REAL, parameter :: poison_value = -42 + integer :: len_coordsystem integer :: len_interpolator integer :: len_interpolator_options @@ -54,14 +56,17 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) integer :: ind_kxx, ind_kxy, ind_kxz, ind_kyy, ind_kyz, ind_kzz integer :: ind_alpha integer :: ind_betax, ind_betay, ind_betaz + integer :: ind_ttt + integer :: ind_ttx, ind_tty, ind_ttz + integer :: ind_txx, ind_txy, ind_txz, ind_tyy, ind_tyz, ind_tzz integer :: coord_type CCTK_POINTER :: coords(3) - CCTK_INT :: inputs(16) - CCTK_INT :: output_types(88) - CCTK_POINTER :: outputs(88) - CCTK_INT :: operand_indices(88) - CCTK_INT :: operation_codes(88) + CCTK_INT :: inputs(26) + CCTK_INT :: output_types(98) + CCTK_POINTER :: outputs(98) + CCTK_INT :: operand_indices(98) + CCTK_INT :: operation_codes(98) integer :: npoints character :: msg*1000 @@ -82,6 +87,10 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) call CCTK_WARN (0, "The shift must have storage") end if +!!$ if (stress_energy_state==0) then +!!$ call CCTK_WARN (0, "The stress-energy tensor must have storage") +!!$ end if + ! Get coordinate system @@ -137,22 +146,45 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) ! TODO: check the excision mask ! Get variable indices - call CCTK_VarIndex (ind_gxx , "ADMBase::gxx" ) - call CCTK_VarIndex (ind_gxy , "ADMBase::gxy" ) - call CCTK_VarIndex (ind_gxz , "ADMBase::gxz" ) - call CCTK_VarIndex (ind_gyy , "ADMBase::gyy" ) - call CCTK_VarIndex (ind_gyz , "ADMBase::gyz" ) - call CCTK_VarIndex (ind_gzz , "ADMBase::gzz" ) - call CCTK_VarIndex (ind_kxx , "ADMBase::kxx" ) - call CCTK_VarIndex (ind_kxy , "ADMBase::kxy" ) - call CCTK_VarIndex (ind_kxz , "ADMBase::kxz" ) - call CCTK_VarIndex (ind_kyy , "ADMBase::kyy" ) - call CCTK_VarIndex (ind_kyz , "ADMBase::kyz" ) - call CCTK_VarIndex (ind_kzz , "ADMBase::kzz" ) - call CCTK_VarIndex (ind_alpha, "ADMBase::alp" ) - call CCTK_VarIndex (ind_betax, "ADMBase::betax") - call CCTK_VarIndex (ind_betay, "ADMBase::betay") - call CCTK_VarIndex (ind_betaz, "ADMBase::betaz") + call CCTK_VarIndex (ind_gxx , "ADMBase::gxx" ) + call CCTK_VarIndex (ind_gxy , "ADMBase::gxy" ) + call CCTK_VarIndex (ind_gxz , "ADMBase::gxz" ) + call CCTK_VarIndex (ind_gyy , "ADMBase::gyy" ) + call CCTK_VarIndex (ind_gyz , "ADMBase::gyz" ) + call CCTK_VarIndex (ind_gzz , "ADMBase::gzz" ) + call CCTK_VarIndex (ind_kxx , "ADMBase::kxx" ) + call CCTK_VarIndex (ind_kxy , "ADMBase::kxy" ) + call CCTK_VarIndex (ind_kxz , "ADMBase::kxz" ) + call CCTK_VarIndex (ind_kyy , "ADMBase::kyy" ) + call CCTK_VarIndex (ind_kyz , "ADMBase::kyz" ) + call CCTK_VarIndex (ind_kzz , "ADMBase::kzz" ) + call CCTK_VarIndex (ind_alpha, "ADMBase::alp" ) + call CCTK_VarIndex (ind_betax, "ADMBase::betax" ) + call CCTK_VarIndex (ind_betay, "ADMBase::betay" ) + call CCTK_VarIndex (ind_betaz, "ADMBase::betaz" ) + if (stress_energy_state /= 0) then + call CCTK_VarIndex (ind_ttt , "TmunuBase::eTtt") + call CCTK_VarIndex (ind_ttx , "TmunuBase::eTtx") + call CCTK_VarIndex (ind_tty , "TmunuBase::eTty") + call CCTK_VarIndex (ind_ttz , "TmunuBase::eTtz") + call CCTK_VarIndex (ind_txx , "TmunuBase::eTxx") + call CCTK_VarIndex (ind_txy , "TmunuBase::eTxy") + call CCTK_VarIndex (ind_txz , "TmunuBase::eTxz") + call CCTK_VarIndex (ind_tyy , "TmunuBase::eTyy") + call CCTK_VarIndex (ind_tyz , "TmunuBase::eTyz") + call CCTK_VarIndex (ind_tzz , "TmunuBase::eTzz") + else + ind_ttt = -1 + ind_ttx = -1 + ind_tty = -1 + ind_ttz = -1 + ind_txx = -1 + ind_txy = -1 + ind_txz = -1 + ind_tyy = -1 + ind_tyz = -1 + ind_tzz = -1 + end if @@ -170,7 +202,11 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) ind_gxx, ind_gxy, ind_gxz, ind_gyy, ind_gyz, ind_gzz, & ind_kxx, ind_kxy, ind_kxz, ind_kyy, ind_kyz, ind_kzz, & ind_alpha, & - ind_betax, ind_betay, ind_betaz /) + ind_betax, ind_betay, ind_betaz, & + ind_ttt, & + ind_ttx, ind_tty, ind_ttz, & + ind_txx, ind_txy, ind_txz, ind_tyy, ind_tyz, ind_tzz /) + call CCTK_NumVars (nvars) if (nvars < 0) call CCTK_WARN (0, "internal error") if (any(inputs /= -1 .and. (inputs < 0 .or. inputs >= nvars))) then @@ -193,7 +229,10 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) 06, 07, 08, 09, 10, 11, & 06, 07, 08, 09, 10, 11, & 12, & ! alp - 13, 14, 15 /) ! beta^i + 13, 14, 15, & ! beta^i + 16, & ! T_tt + 17, 18, 19, & ! T_ti + 20, 21, 22, 23, 24, 25 /) ! T_ij operation_codes = (/ & 0, 0, 0, 0, 0, 0, & ! g_ij @@ -211,7 +250,10 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) 2, 2, 2, 2, 2, 2, & 3, 3, 3, 3, 3, 3, & 0, & ! alp - 0, 0, 0 /) ! beta^i + 0, 0, 0, & ! beta^i + 0, & ! T_tt + 0, 0, 0, & ! T_ti + 0, 0, 0, 0, 0, 0 /) ! T_ij output_types(:) = CCTK_VARIABLE_REAL if (hn > 0) then @@ -231,7 +273,10 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) P(qlm_dkxxy), P(qlm_dkxyy), P(qlm_dkxzy), P(qlm_dkyyy), P(qlm_dkyzy), P(qlm_dkzzy), & P(qlm_dkxxz), P(qlm_dkxyz), P(qlm_dkxzz), P(qlm_dkyyz), P(qlm_dkyzz), P(qlm_dkzzz), & P(qlm_alpha), & - P(qlm_betax), P(qlm_betay), P(qlm_betaz) /) + P(qlm_betax), P(qlm_betay), P(qlm_betaz), & + P(qlm_ttt), & + P(qlm_ttx), P(qlm_tty), P(qlm_ttz), & + P(qlm_txx), P(qlm_txy), P(qlm_txz), P(qlm_tyy), P(qlm_tyz), P(qlm_tzz) /) else outputs(:) = CCTK_NullPointer() end if @@ -245,95 +290,104 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) #if 0 ! Poison the output variables -#define poison -42 - qlm_gxx = poison - qlm_gxy = poison - qlm_gxz = poison - qlm_gyy = poison - qlm_gyz = poison - qlm_gzz = poison - qlm_dgxxx = poison - qlm_dgxyx = poison - qlm_dgxzx = poison - qlm_dgyyx = poison - qlm_dgyzx = poison - qlm_dgzzx = poison - qlm_dgxxy = poison - qlm_dgxyy = poison - qlm_dgxzy = poison - qlm_dgyyy = poison - qlm_dgyzy = poison - qlm_dgzzy = poison - qlm_dgxxz = poison - qlm_dgxyz = poison - qlm_dgxzz = poison - qlm_dgyyz = poison - qlm_dgyzz = poison - qlm_dgzzz = poison - qlm_ddgxxxx = poison - qlm_ddgxyxx = poison - qlm_ddgxzxx = poison - qlm_ddgyyxx = poison - qlm_ddgyzxx = poison - qlm_ddgzzxx = poison - qlm_ddgxxxy = poison - qlm_ddgxyxy = poison - qlm_ddgxzxy = poison - qlm_ddgyyxy = poison - qlm_ddgyzxy = poison - qlm_ddgzzxy = poison - qlm_ddgxxxz = poison - qlm_ddgxyxz = poison - qlm_ddgxzxz = poison - qlm_ddgyyxz = poison - qlm_ddgyzxz = poison - qlm_ddgzzxz = poison - qlm_ddgxxyy = poison - qlm_ddgxyyy = poison - qlm_ddgxzyy = poison - qlm_ddgyyyy = poison - qlm_ddgyzyy = poison - qlm_ddgzzyy = poison - qlm_ddgxxyz = poison - qlm_ddgxyyz = poison - qlm_ddgxzyz = poison - qlm_ddgyyyz = poison - qlm_ddgyzyz = poison - qlm_ddgzzyz = poison - qlm_ddgxxzz = poison - qlm_ddgxyzz = poison - qlm_ddgxzzz = poison - qlm_ddgyyzz = poison - qlm_ddgyzzz = poison - qlm_ddgzzzz = poison - qlm_kxx = poison - qlm_kxy = poison - qlm_kxz = poison - qlm_kyy = poison - qlm_kyz = poison - qlm_kzz = poison - qlm_dkxxx = poison - qlm_dkxyx = poison - qlm_dkxzx = poison - qlm_dkyyx = poison - qlm_dkyzx = poison - qlm_dkzzx = poison - qlm_dkxxy = poison - qlm_dkxyy = poison - qlm_dkxzy = poison - qlm_dkyyy = poison - qlm_dkyzy = poison - qlm_dkzzy = poison - qlm_dkxxz = poison - qlm_dkxyz = poison - qlm_dkxzz = poison - qlm_dkyyz = poison - qlm_dkyzz = poison - qlm_dkzzz = poison - qlm_alpha = poison - qlm_betax = poison - qlm_betay = poison - qlm_betaz = poison + call poison (qlm_gxx ) + call poison (qlm_gxy ) + call poison (qlm_gxz ) + call poison (qlm_gyy ) + call poison (qlm_gyz ) + call poison (qlm_gzz ) + call poison (qlm_dgxxx ) + call poison (qlm_dgxyx ) + call poison (qlm_dgxzx ) + call poison (qlm_dgyyx ) + call poison (qlm_dgyzx ) + call poison (qlm_dgzzx ) + call poison (qlm_dgxxy ) + call poison (qlm_dgxyy ) + call poison (qlm_dgxzy ) + call poison (qlm_dgyyy ) + call poison (qlm_dgyzy ) + call poison (qlm_dgzzy ) + call poison (qlm_dgxxz ) + call poison (qlm_dgxyz ) + call poison (qlm_dgxzz ) + call poison (qlm_dgyyz ) + call poison (qlm_dgyzz ) + call poison (qlm_dgzzz ) + call poison (qlm_ddgxxxx) + call poison (qlm_ddgxyxx) + call poison (qlm_ddgxzxx) + call poison (qlm_ddgyyxx) + call poison (qlm_ddgyzxx) + call poison (qlm_ddgzzxx) + call poison (qlm_ddgxxxy) + call poison (qlm_ddgxyxy) + call poison (qlm_ddgxzxy) + call poison (qlm_ddgyyxy) + call poison (qlm_ddgyzxy) + call poison (qlm_ddgzzxy) + call poison (qlm_ddgxxxz) + call poison (qlm_ddgxyxz) + call poison (qlm_ddgxzxz) + call poison (qlm_ddgyyxz) + call poison (qlm_ddgyzxz) + call poison (qlm_ddgzzxz) + call poison (qlm_ddgxxyy) + call poison (qlm_ddgxyyy) + call poison (qlm_ddgxzyy) + call poison (qlm_ddgyyyy) + call poison (qlm_ddgyzyy) + call poison (qlm_ddgzzyy) + call poison (qlm_ddgxxyz) + call poison (qlm_ddgxyyz) + call poison (qlm_ddgxzyz) + call poison (qlm_ddgyyyz) + call poison (qlm_ddgyzyz) + call poison (qlm_ddgzzyz) + call poison (qlm_ddgxxzz) + call poison (qlm_ddgxyzz) + call poison (qlm_ddgxzzz) + call poison (qlm_ddgyyzz) + call poison (qlm_ddgyzzz) + call poison (qlm_ddgzzzz) + call poison (qlm_kxx ) + call poison (qlm_kxy ) + call poison (qlm_kxz ) + call poison (qlm_kyy ) + call poison (qlm_kyz ) + call poison (qlm_kzz ) + call poison (qlm_dkxxx ) + call poison (qlm_dkxyx ) + call poison (qlm_dkxzx ) + call poison (qlm_dkyyx ) + call poison (qlm_dkyzx ) + call poison (qlm_dkzzx ) + call poison (qlm_dkxxy ) + call poison (qlm_dkxyy ) + call poison (qlm_dkxzy ) + call poison (qlm_dkyyy ) + call poison (qlm_dkyzy ) + call poison (qlm_dkzzy ) + call poison (qlm_dkxxz ) + call poison (qlm_dkxyz ) + call poison (qlm_dkxzz ) + call poison (qlm_dkyyz ) + call poison (qlm_dkyzz ) + call poison (qlm_dkzzz ) + call poison (qlm_alpha ) + call poison (qlm_betax ) + call poison (qlm_betay ) + call poison (qlm_betaz ) + call poison (qlm_ttt ) + call poison (qlm_ttx ) + call poison (qlm_tty ) + call poison (qlm_ttz ) + call poison (qlm_txx ) + call poison (qlm_txy ) + call poison (qlm_txz ) + call poison (qlm_tyy ) + call poison (qlm_tyz ) + call poison (qlm_tzz ) #endif @@ -368,187 +422,220 @@ subroutine qlm_interpolate (CCTK_ARGUMENTS, hn) ! Unpack the variables if (hn > 0) then - call unpack (qlm_gxx , ni, nj) - call unpack (qlm_gxy , ni, nj) - call unpack (qlm_gxz , ni, nj) - call unpack (qlm_gyy , ni, nj) - call unpack (qlm_gyz , ni, nj) - call unpack (qlm_gzz , ni, nj) - call unpack (qlm_dgxxx , ni, nj) - call unpack (qlm_dgxyx , ni, nj) - call unpack (qlm_dgxzx , ni, nj) - call unpack (qlm_dgyyx , ni, nj) - call unpack (qlm_dgyzx , ni, nj) - call unpack (qlm_dgzzx , ni, nj) - call unpack (qlm_dgxxy , ni, nj) - call unpack (qlm_dgxyy , ni, nj) - call unpack (qlm_dgxzy , ni, nj) - call unpack (qlm_dgyyy , ni, nj) - call unpack (qlm_dgyzy , ni, nj) - call unpack (qlm_dgzzy , ni, nj) - call unpack (qlm_dgxxz , ni, nj) - call unpack (qlm_dgxyz , ni, nj) - call unpack (qlm_dgxzz , ni, nj) - call unpack (qlm_dgyyz , ni, nj) - call unpack (qlm_dgyzz , ni, nj) - call unpack (qlm_dgzzz , ni, nj) - call unpack (qlm_ddgxxxx , ni, nj) - call unpack (qlm_ddgxyxx , ni, nj) - call unpack (qlm_ddgxzxx , ni, nj) - call unpack (qlm_ddgyyxx , ni, nj) - call unpack (qlm_ddgyzxx , ni, nj) - call unpack (qlm_ddgzzxx , ni, nj) - call unpack (qlm_ddgxxxy , ni, nj) - call unpack (qlm_ddgxyxy , ni, nj) - call unpack (qlm_ddgxzxy , ni, nj) - call unpack (qlm_ddgyyxy , ni, nj) - call unpack (qlm_ddgyzxy , ni, nj) - call unpack (qlm_ddgzzxy , ni, nj) - call unpack (qlm_ddgxxxz , ni, nj) - call unpack (qlm_ddgxyxz , ni, nj) - call unpack (qlm_ddgxzxz , ni, nj) - call unpack (qlm_ddgyyxz , ni, nj) - call unpack (qlm_ddgyzxz , ni, nj) - call unpack (qlm_ddgzzxz , ni, nj) - call unpack (qlm_ddgxxyy , ni, nj) - call unpack (qlm_ddgxyyy , ni, nj) - call unpack (qlm_ddgxzyy , ni, nj) - call unpack (qlm_ddgyyyy , ni, nj) - call unpack (qlm_ddgyzyy , ni, nj) - call unpack (qlm_ddgzzyy , ni, nj) - call unpack (qlm_ddgxxyz , ni, nj) - call unpack (qlm_ddgxyyz , ni, nj) - call unpack (qlm_ddgxzyz , ni, nj) - call unpack (qlm_ddgyyyz , ni, nj) - call unpack (qlm_ddgyzyz , ni, nj) - call unpack (qlm_ddgzzyz , ni, nj) - call unpack (qlm_ddgxxzz , ni, nj) - call unpack (qlm_ddgxyzz , ni, nj) - call unpack (qlm_ddgxzzz , ni, nj) - call unpack (qlm_ddgyyzz , ni, nj) - call unpack (qlm_ddgyzzz , ni, nj) - call unpack (qlm_ddgzzzz , ni, nj) - call unpack (qlm_kxx , ni, nj) - call unpack (qlm_kxy , ni, nj) - call unpack (qlm_kxz , ni, nj) - call unpack (qlm_kyy , ni, nj) - call unpack (qlm_kyz , ni, nj) - call unpack (qlm_kzz , ni, nj) - call unpack (qlm_dkxxx , ni, nj) - call unpack (qlm_dkxyx , ni, nj) - call unpack (qlm_dkxzx , ni, nj) - call unpack (qlm_dkyyx , ni, nj) - call unpack (qlm_dkyzx , ni, nj) - call unpack (qlm_dkzzx , ni, nj) - call unpack (qlm_dkxxy , ni, nj) - call unpack (qlm_dkxyy , ni, nj) - call unpack (qlm_dkxzy , ni, nj) - call unpack (qlm_dkyyy , ni, nj) - call unpack (qlm_dkyzy , ni, nj) - call unpack (qlm_dkzzy , ni, nj) - call unpack (qlm_dkxxz , ni, nj) - call unpack (qlm_dkxyz , ni, nj) - call unpack (qlm_dkxzz , ni, nj) - call unpack (qlm_dkyyz , ni, nj) - call unpack (qlm_dkyzz , ni, nj) - call unpack (qlm_dkzzz , ni, nj) - call unpack (qlm_alpha , ni, nj) - call unpack (qlm_betax , ni, nj) - call unpack (qlm_betay , ni, nj) - call unpack (qlm_betaz , ni, nj) + call unpack (qlm_gxx , ni, nj) + call unpack (qlm_gxy , ni, nj) + call unpack (qlm_gxz , ni, nj) + call unpack (qlm_gyy , ni, nj) + call unpack (qlm_gyz , ni, nj) + call unpack (qlm_gzz , ni, nj) + call unpack (qlm_dgxxx , ni, nj) + call unpack (qlm_dgxyx , ni, nj) + call unpack (qlm_dgxzx , ni, nj) + call unpack (qlm_dgyyx , ni, nj) + call unpack (qlm_dgyzx , ni, nj) + call unpack (qlm_dgzzx , ni, nj) + call unpack (qlm_dgxxy , ni, nj) + call unpack (qlm_dgxyy , ni, nj) + call unpack (qlm_dgxzy , ni, nj) + call unpack (qlm_dgyyy , ni, nj) + call unpack (qlm_dgyzy , ni, nj) + call unpack (qlm_dgzzy , ni, nj) + call unpack (qlm_dgxxz , ni, nj) + call unpack (qlm_dgxyz , ni, nj) + call unpack (qlm_dgxzz , ni, nj) + call unpack (qlm_dgyyz , ni, nj) + call unpack (qlm_dgyzz , ni, nj) + call unpack (qlm_dgzzz , ni, nj) + call unpack (qlm_ddgxxxx, ni, nj) + call unpack (qlm_ddgxyxx, ni, nj) + call unpack (qlm_ddgxzxx, ni, nj) + call unpack (qlm_ddgyyxx, ni, nj) + call unpack (qlm_ddgyzxx, ni, nj) + call unpack (qlm_ddgzzxx, ni, nj) + call unpack (qlm_ddgxxxy, ni, nj) + call unpack (qlm_ddgxyxy, ni, nj) + call unpack (qlm_ddgxzxy, ni, nj) + call unpack (qlm_ddgyyxy, ni, nj) + call unpack (qlm_ddgyzxy, ni, nj) + call unpack (qlm_ddgzzxy, ni, nj) + call unpack (qlm_ddgxxxz, ni, nj) + call unpack (qlm_ddgxyxz, ni, nj) + call unpack (qlm_ddgxzxz, ni, nj) + call unpack (qlm_ddgyyxz, ni, nj) + call unpack (qlm_ddgyzxz, ni, nj) + call unpack (qlm_ddgzzxz, ni, nj) + call unpack (qlm_ddgxxyy, ni, nj) + call unpack (qlm_ddgxyyy, ni, nj) + call unpack (qlm_ddgxzyy, ni, nj) + call unpack (qlm_ddgyyyy, ni, nj) + call unpack (qlm_ddgyzyy, ni, nj) + call unpack (qlm_ddgzzyy, ni, nj) + call unpack (qlm_ddgxxyz, ni, nj) + call unpack (qlm_ddgxyyz, ni, nj) + call unpack (qlm_ddgxzyz, ni, nj) + call unpack (qlm_ddgyyyz, ni, nj) + call unpack (qlm_ddgyzyz, ni, nj) + call unpack (qlm_ddgzzyz, ni, nj) + call unpack (qlm_ddgxxzz, ni, nj) + call unpack (qlm_ddgxyzz, ni, nj) + call unpack (qlm_ddgxzzz, ni, nj) + call unpack (qlm_ddgyyzz, ni, nj) + call unpack (qlm_ddgyzzz, ni, nj) + call unpack (qlm_ddgzzzz, ni, nj) + call unpack (qlm_kxx , ni, nj) + call unpack (qlm_kxy , ni, nj) + call unpack (qlm_kxz , ni, nj) + call unpack (qlm_kyy , ni, nj) + call unpack (qlm_kyz , ni, nj) + call unpack (qlm_kzz , ni, nj) + call unpack (qlm_dkxxx , ni, nj) + call unpack (qlm_dkxyx , ni, nj) + call unpack (qlm_dkxzx , ni, nj) + call unpack (qlm_dkyyx , ni, nj) + call unpack (qlm_dkyzx , ni, nj) + call unpack (qlm_dkzzx , ni, nj) + call unpack (qlm_dkxxy , ni, nj) + call unpack (qlm_dkxyy , ni, nj) + call unpack (qlm_dkxzy , ni, nj) + call unpack (qlm_dkyyy , ni, nj) + call unpack (qlm_dkyzy , ni, nj) + call unpack (qlm_dkzzy , ni, nj) + call unpack (qlm_dkxxz , ni, nj) + call unpack (qlm_dkxyz , ni, nj) + call unpack (qlm_dkxzz , ni, nj) + call unpack (qlm_dkyyz , ni, nj) + call unpack (qlm_dkyzz , ni, nj) + call unpack (qlm_dkzzz , ni, nj) + call unpack (qlm_alpha , ni, nj) + call unpack (qlm_betax , ni, nj) + call unpack (qlm_betay , ni, nj) + call unpack (qlm_betaz , ni, nj) + if (stress_energy_state /= 0) then + call unpack (qlm_ttt , ni, nj) + call unpack (qlm_ttx , ni, nj) + call unpack (qlm_tty , ni, nj) + call unpack (qlm_ttz , ni, nj) + call unpack (qlm_txx , ni, nj) + call unpack (qlm_txy , ni, nj) + call unpack (qlm_txz , ni, nj) + call unpack (qlm_tyy , ni, nj) + call unpack (qlm_tyz , ni, nj) + call unpack (qlm_tzz , ni, nj) + else + qlm_ttt = 0 + qlm_ttx = 0 + qlm_tty = 0 + qlm_ttz = 0 + qlm_txx = 0 + qlm_txy = 0 + qlm_txz = 0 + qlm_tyy = 0 + qlm_tyz = 0 + qlm_tzz = 0 + end if #if 0 ! Check for poison - if (any(qlm_gxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_gxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_gxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_gyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_gyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_gzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxyx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxzx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgyyx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgyzx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgzzx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxzy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgyyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgyzy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgzzy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgxzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgyyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgyzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dgzzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxxxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxyxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxzxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyyxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyzxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgzzxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxxxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxyxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxzxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyyxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyzxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgzzxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxxxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxyxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxzxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyyxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyzxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgzzxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxxyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxyyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxzyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyyyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyzyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgzzyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxxyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxyyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxzyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyyyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyzyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgzzyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxxzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxyzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgxzzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyyzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgyzzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_ddgzzzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_kxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_kxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_kxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_kyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_kyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_kzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxxx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxyx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxzx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkyyx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkyzx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkzzx == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxxy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxzy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkyyy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkyzy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkzzy == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxxz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkxzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkyyz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkyzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_dkzzz == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_alpha == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_betax == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_betay == poison)) call CCTK_WARN (0, "poison found") - if (any(qlm_betaz == poison)) call CCTK_WARN (0, "poison found") + call poison_check (qlm_gxx , "qlm_gxx ") + call poison_check (qlm_gxy , "qlm_gxy ") + call poison_check (qlm_gxz , "qlm_gxz ") + call poison_check (qlm_gyy , "qlm_gyy ") + call poison_check (qlm_gyz , "qlm_gyz ") + call poison_check (qlm_gzz , "qlm_gzz ") + call poison_check (qlm_dgxxx , "qlm_dgxxx ") + call poison_check (qlm_dgxyx , "qlm_dgxyx ") + call poison_check (qlm_dgxzx , "qlm_dgxzx ") + call poison_check (qlm_dgyyx , "qlm_dgyyx ") + call poison_check (qlm_dgyzx , "qlm_dgyzx ") + call poison_check (qlm_dgzzx , "qlm_dgzzx ") + call poison_check (qlm_dgxxy , "qlm_dgxxy ") + call poison_check (qlm_dgxyy , "qlm_dgxyy ") + call poison_check (qlm_dgxzy , "qlm_dgxzy ") + call poison_check (qlm_dgyyy , "qlm_dgyyy ") + call poison_check (qlm_dgyzy , "qlm_dgyzy ") + call poison_check (qlm_dgzzy , "qlm_dgzzy ") + call poison_check (qlm_dgxxz , "qlm_dgxxz ") + call poison_check (qlm_dgxyz , "qlm_dgxyz ") + call poison_check (qlm_dgxzz , "qlm_dgxzz ") + call poison_check (qlm_dgyyz , "qlm_dgyyz ") + call poison_check (qlm_dgyzz , "qlm_dgyzz ") + call poison_check (qlm_dgzzz , "qlm_dgzzz ") + call poison_check (qlm_ddgxxxx, "qlm_ddgxxxx") + call poison_check (qlm_ddgxyxx, "qlm_ddgxyxx") + call poison_check (qlm_ddgxzxx, "qlm_ddgxzxx") + call poison_check (qlm_ddgyyxx, "qlm_ddgyyxx") + call poison_check (qlm_ddgyzxx, "qlm_ddgyzxx") + call poison_check (qlm_ddgzzxx, "qlm_ddgzzxx") + call poison_check (qlm_ddgxxxy, "qlm_ddgxxxy") + call poison_check (qlm_ddgxyxy, "qlm_ddgxyxy") + call poison_check (qlm_ddgxzxy, "qlm_ddgxzxy") + call poison_check (qlm_ddgyyxy, "qlm_ddgyyxy") + call poison_check (qlm_ddgyzxy, "qlm_ddgyzxy") + call poison_check (qlm_ddgzzxy, "qlm_ddgzzxy") + call poison_check (qlm_ddgxxxz, "qlm_ddgxxxz") + call poison_check (qlm_ddgxyxz, "qlm_ddgxyxz") + call poison_check (qlm_ddgxzxz, "qlm_ddgxzxz") + call poison_check (qlm_ddgyyxz, "qlm_ddgyyxz") + call poison_check (qlm_ddgyzxz, "qlm_ddgyzxz") + call poison_check (qlm_ddgzzxz, "qlm_ddgzzxz") + call poison_check (qlm_ddgxxyy, "qlm_ddgxxyy") + call poison_check (qlm_ddgxyyy, "qlm_ddgxyyy") + call poison_check (qlm_ddgxzyy, "qlm_ddgxzyy") + call poison_check (qlm_ddgyyyy, "qlm_ddgyyyy") + call poison_check (qlm_ddgyzyy, "qlm_ddgyzyy") + call poison_check (qlm_ddgzzyy, "qlm_ddgzzyy") + call poison_check (qlm_ddgxxyz, "qlm_ddgxxyz") + call poison_check (qlm_ddgxyyz, "qlm_ddgxyyz") + call poison_check (qlm_ddgxzyz, "qlm_ddgxzyz") + call poison_check (qlm_ddgyyyz, "qlm_ddgyyyz") + call poison_check (qlm_ddgyzyz, "qlm_ddgyzyz") + call poison_check (qlm_ddgzzyz, "qlm_ddgzzyz") + call poison_check (qlm_ddgxxzz, "qlm_ddgxxzz") + call poison_check (qlm_ddgxyzz, "qlm_ddgxyzz") + call poison_check (qlm_ddgxzzz, "qlm_ddgxzzz") + call poison_check (qlm_ddgyyzz, "qlm_ddgyyzz") + call poison_check (qlm_ddgyzzz, "qlm_ddgyzzz") + call poison_check (qlm_ddgzzzz, "qlm_ddgzzzz") + call poison_check (qlm_kxx , "qlm_kxx ") + call poison_check (qlm_kxy , "qlm_kxy ") + call poison_check (qlm_kxz , "qlm_kxz ") + call poison_check (qlm_kyy , "qlm_kyy ") + call poison_check (qlm_kyz , "qlm_kyz ") + call poison_check (qlm_kzz , "qlm_kzz ") + call poison_check (qlm_dkxxx , "qlm_dkxxx ") + call poison_check (qlm_dkxyx , "qlm_dkxyx ") + call poison_check (qlm_dkxzx , "qlm_dkxzx ") + call poison_check (qlm_dkyyx , "qlm_dkyyx ") + call poison_check (qlm_dkyzx , "qlm_dkyzx ") + call poison_check (qlm_dkzzx , "qlm_dkzzx ") + call poison_check (qlm_dkxxy , "qlm_dkxxy ") + call poison_check (qlm_dkxyy , "qlm_dkxyy ") + call poison_check (qlm_dkxzy , "qlm_dkxzy ") + call poison_check (qlm_dkyyy , "qlm_dkyyy ") + call poison_check (qlm_dkyzy , "qlm_dkyzy ") + call poison_check (qlm_dkzzy , "qlm_dkzzy ") + call poison_check (qlm_dkxxz , "qlm_dkxxz ") + call poison_check (qlm_dkxyz , "qlm_dkxyz ") + call poison_check (qlm_dkxzz , "qlm_dkxzz ") + call poison_check (qlm_dkyyz , "qlm_dkyyz ") + call poison_check (qlm_dkyzz , "qlm_dkyzz ") + call poison_check (qlm_dkzzz , "qlm_dkzzz ") + call poison_check (qlm_alpha , "qlm_alpha ") + call poison_check (qlm_betax , "qlm_betax ") + call poison_check (qlm_betay , "qlm_betay ") + call poison_check (qlm_betaz , "qlm_betaz ") + call poison_check (qlm_ttt , "qlm_ttt ") + call poison_check (qlm_ttx , "qlm_ttx ") + call poison_check (qlm_tty , "qlm_tty ") + call poison_check (qlm_ttz , "qlm_ttz ") + call poison_check (qlm_txx , "qlm_txx ") + call poison_check (qlm_txy , "qlm_txy ") + call poison_check (qlm_txz , "qlm_txz ") + call poison_check (qlm_tyy , "qlm_tyy ") + call poison_check (qlm_tyz , "qlm_tyz ") + call poison_check (qlm_tzz , "qlm_tzz ") #endif end if @@ -599,4 +686,25 @@ contains a = b end subroutine copy + subroutine poison (arr) + CCTK_REAL, intent(out) :: arr(:,:) + arr = poison_value + end subroutine poison + + subroutine poison_check (arr, name) + CCTK_REAL, intent(in) :: arr(:,:) + character(*), intent(in) :: name + character*1000 :: msg +!!$ integer :: i, j + if (any(arr==poison_value)) then + write (msg, '("Poison found in ",a)') trim(name) + call CCTK_WARN (CCTK_WARN_ALERT, msg) +!!$ do j=1,size(arr,2) +!!$ do i=1,size(arr,1) +!!$ print '(2i6)', i,j +!!$ end do +!!$ end do + end if + end subroutine poison_check + end subroutine qlm_interpolate |