From 71e7810fb0fb22bfbf172ee2ef646a43aba4dd08 Mon Sep 17 00:00:00 2001 From: Christopher Subich Date: Mon, 30 Oct 2023 10:54:47 -0400 Subject: [PATCH] Adjust interpv templates for vscode compatibility The mock-template code that uses the C preprocessor to define multiple versions of Interp/Extrap functions is incompatible with Fortran linting, crashing the linter (see https://github.com/fortran-lang/fortls/issues/236) because it tries to process the Fortran syntax without invoking the preprocessor. This code adjusts the templates to hold just the subroutine body, leaving the `end subroutine` statement for the enclosing Fortran file. This change fixes the linter crash, although it still doesn't properly understand the subroutines. --- src/interpv/Extrap1D_Abort.F90 | 50 +++++++++++++++++++ src/interpv/Extrap1D_Abort_Body.inc | 20 ++++---- src/interpv/Extrap1D_Fixed.F90 | 50 +++++++++++++++++++ src/interpv/Extrap1D_Fixed_Body.inc | 20 ++++---- src/interpv/Extrap1D_LapseRate.F90 | 50 +++++++++++++++++++ src/interpv/Extrap1D_LapseRate_Body.inc | 20 ++++---- src/interpv/Extrap1D_Surface.F90 | 28 +++++++++++ src/interpv/Extrap1D_SurfaceWind.F90 | 28 +++++++++++ src/interpv/Extrap1D_SurfaceWind_Body.inc | 20 ++++---- src/interpv/Extrap1D_Surface_Body.inc | 20 ++++---- src/interpv/Interp1D_CubicLagrange.F90 | 50 +++++++++++++++++++ src/interpv/Interp1D_CubicLagrange_Body.inc | 20 ++++---- src/interpv/Interp1D_CubicWithDerivs.F90 | 50 +++++++++++++++++++ src/interpv/Interp1D_CubicWithDerivs_Body.inc | 20 ++++---- src/interpv/Interp1D_FindPos.F90 | 12 +++++ src/interpv/Interp1D_FindPos_Body.inc | 10 ++-- src/interpv/Interp1D_Linear.F90 | 50 +++++++++++++++++++ src/interpv/Interp1D_Linear_Body.inc | 20 ++++---- src/interpv/Interp1D_NearestNeighbour.F90 | 50 +++++++++++++++++++ .../Interp1D_NearestNeighbour_Body.inc | 20 ++++---- src/interpv/Interp1D_PreX_Shell.inc | 16 +++--- 21 files changed, 521 insertions(+), 103 deletions(-) diff --git a/src/interpv/Extrap1D_Abort.F90 b/src/interpv/Extrap1D_Abort.F90 index 1242894f..3604c6d9 100644 --- a/src/interpv/Extrap1D_Abort.F90 +++ b/src/interpv/Extrap1D_Abort.F90 @@ -17,31 +17,81 @@ !version that accepts real(single) arguments, with the extended interface subroutine Extrap1D_Abort_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Extrap1D_Abort_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Extrap1D_Abort_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Extrap1D_Abort_Body.inc" #undef real48 +end subroutine !version that accepts real(single) arguments subroutine Extrap1D_Abort & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 single #define DestnFunc Extrap1D_Abort_X #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Extrap1D_Abort8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 double #define DestnFunc Extrap1D_Abort_X8 #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine diff --git a/src/interpv/Extrap1D_Abort_Body.inc b/src/interpv/Extrap1D_Abort_Body.inc index 8ee01822..94861070 100644 --- a/src/interpv/Extrap1D_Abort_Body.inc +++ b/src/interpv/Extrap1D_Abort_Body.inc @@ -1,19 +1,19 @@ !!!s/r Extrap1D_Abort - Abort if an extrapolation is required !subroutine Extrap1D_Abort_X & !subroutine Extrap1D_Abort_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: stateDerivSource, ! stateDerivDestn, flux, numExtArraysIn, numExtArraysOut, ExtArraysIn, ! ExtArraysOut @@ -93,4 +93,4 @@ !$OMP END parallel do -end subroutine ! Extrap1D_Abort_X +! end subroutine ! Extrap1D_Abort_X diff --git a/src/interpv/Extrap1D_Fixed.F90 b/src/interpv/Extrap1D_Fixed.F90 index 026ce34e..c695922a 100644 --- a/src/interpv/Extrap1D_Fixed.F90 +++ b/src/interpv/Extrap1D_Fixed.F90 @@ -17,31 +17,81 @@ !version that accepts real(single) arguments, with the extended interface subroutine Extrap1D_Fixed_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Extrap1D_Fixed_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Extrap1D_Fixed_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Extrap1D_Fixed_Body.inc" #undef real48 +end subroutine !version that accepts real(single) arguments subroutine Extrap1D_Fixed & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 single #define DestnFunc Extrap1D_Fixed_X #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Extrap1D_Fixed8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 double #define DestnFunc Extrap1D_Fixed_X8 #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine diff --git a/src/interpv/Extrap1D_Fixed_Body.inc b/src/interpv/Extrap1D_Fixed_Body.inc index 6d3a2766..baab8b1c 100644 --- a/src/interpv/Extrap1D_Fixed_Body.inc +++ b/src/interpv/Extrap1D_Fixed_Body.inc @@ -1,19 +1,19 @@ !!!s/r Extrap1D_Fixed - Extrapolate, to a fixed (selectable) value !subroutine Extrap1D_Fixed_X & !subroutine Extrap1D_Fixed_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: stateDerivSource, ! stateDerivDestn, flux, numExtArraysIn, numExtArraysOut, ExtArraysIn, ! ExtArraysOut @@ -100,4 +100,4 @@ !$OMP END parallel do -end subroutine ! Extrap1D_Fixed_X +! end subroutine ! Extrap1D_Fixed_X diff --git a/src/interpv/Extrap1D_LapseRate.F90 b/src/interpv/Extrap1D_LapseRate.F90 index bb2ebb79..23e98285 100644 --- a/src/interpv/Extrap1D_LapseRate.F90 +++ b/src/interpv/Extrap1D_LapseRate.F90 @@ -19,31 +19,81 @@ !version that accepts real(single) arguments, with the extended interface subroutine Extrap1D_LapseRate_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Extrap1D_LapseRate_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Extrap1D_LapseRate_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Extrap1D_LapseRate_Body.inc" #undef real48 +end subroutine !version that accepts real(single) arguments subroutine Extrap1D_LapseRate & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 single #define DestnFunc Extrap1D_LapseRate_X #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Extrap1D_LapseRate8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 double #define DestnFunc Extrap1D_LapseRate_X8 #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine diff --git a/src/interpv/Extrap1D_LapseRate_Body.inc b/src/interpv/Extrap1D_LapseRate_Body.inc index e48e26e5..5a391a5d 100644 --- a/src/interpv/Extrap1D_LapseRate_Body.inc +++ b/src/interpv/Extrap1D_LapseRate_Body.inc @@ -1,19 +1,19 @@ !!!s/r Extrap1D_LapseRate - Extrapolate, based on lapse rates !subroutine Extrap1D_LapseRate_X & !subroutine Extrap1D_LapseRate_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & +! (numInterpSets, srcNumLevels, destNumLevels, & +! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & +! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & +! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & +! extrapEnableDown, extrapEnableUp, & +! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) +! flux, numExtArraysIn, numExtArraysOut, & +! ExtArraysIn, ExtArraysOut & +! ) ! These are dummy arguments for this function: stateDerivSource, ! stateDerivDestn, flux, numExtArraysIn, numExtArraysOut, ExtArraysIn, ! ExtArraysOut @@ -118,4 +118,4 @@ !$OMP END parallel do -end subroutine ! Extrap1D_LapseRate_X +! end subroutine ! Extrap1D_LapseRate_X diff --git a/src/interpv/Extrap1D_Surface.F90 b/src/interpv/Extrap1D_Surface.F90 index 2cdc283e..ab9cf4af 100644 --- a/src/interpv/Extrap1D_Surface.F90 +++ b/src/interpv/Extrap1D_Surface.F90 @@ -21,12 +21,40 @@ !version that accepts real(single) arguments, with the extended interface subroutine Extrap1D_Surface_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Extrap1D_Surface_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Extrap1D_Surface_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Extrap1D_Surface_Body.inc" #undef real48 +end subroutine diff --git a/src/interpv/Extrap1D_SurfaceWind.F90 b/src/interpv/Extrap1D_SurfaceWind.F90 index de62fc64..74e447d4 100644 --- a/src/interpv/Extrap1D_SurfaceWind.F90 +++ b/src/interpv/Extrap1D_SurfaceWind.F90 @@ -21,12 +21,40 @@ !version that accepts real(single) arguments, with the extended interface subroutine Extrap1D_SurfaceWind_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Extrap1D_SurfaceWind_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Extrap1D_SurfaceWind_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Extrap1D_SurfaceWind_Body.inc" #undef real48 +end subroutine diff --git a/src/interpv/Extrap1D_SurfaceWind_Body.inc b/src/interpv/Extrap1D_SurfaceWind_Body.inc index e115b965..4c6b1be2 100644 --- a/src/interpv/Extrap1D_SurfaceWind_Body.inc +++ b/src/interpv/Extrap1D_SurfaceWind_Body.inc @@ -3,19 +3,19 @@ ! vector (i.e. the wind) ! subroutine Extrap1DWind_Surface_X & ! subroutine Extrap1DWind_Surface_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: stateSource, stateDerivSource, ! stateDerivDestn, extrapGuideDown, extrapGuideUp ! @@ -178,4 +178,4 @@ ! copy result to return parameter ExtArraysOut(:, iY_DESTINATION:iY_DESTINATION+destnumlevels-1) = v -end subroutine ! Extrap1D_Surface_X +! end subroutine ! Extrap1D_Surface_X diff --git a/src/interpv/Extrap1D_Surface_Body.inc b/src/interpv/Extrap1D_Surface_Body.inc index c5e184c9..0927a1ea 100644 --- a/src/interpv/Extrap1D_Surface_Body.inc +++ b/src/interpv/Extrap1D_Surface_Body.inc @@ -2,19 +2,19 @@ ! surface ! subroutine Extrap1D_Surface_X & ! subroutine Extrap1D_Surface_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: stateDerivSource, ! stateDerivDestn, extrapGuideDown, extrapGuideUp ! @@ -137,4 +137,4 @@ end do ! vt !$OMP END parallel do -end subroutine ! Extrap1D_Surface_X +! end subroutine ! Extrap1D_Surface_X diff --git a/src/interpv/Interp1D_CubicLagrange.F90 b/src/interpv/Interp1D_CubicLagrange.F90 index 79d0d49d..2b42b1d4 100644 --- a/src/interpv/Interp1D_CubicLagrange.F90 +++ b/src/interpv/Interp1D_CubicLagrange.F90 @@ -19,31 +19,81 @@ !version that accepts real(single) arguments, with the extended interface subroutine Interp1D_CubicLagrange_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Interp1D_CubicLagrange_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Interp1D_CubicLagrange_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Interp1D_CubicLagrange_Body.inc" #undef real48 +end subroutine !version that accepts real(single) arguments subroutine Interp1D_CubicLagrange & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 single #define DestnFunc Interp1D_CubicLagrange_X #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Interp1D_CubicLagrange8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 double #define DestnFunc Interp1D_CubicLagrange_X8 #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine diff --git a/src/interpv/Interp1D_CubicLagrange_Body.inc b/src/interpv/Interp1D_CubicLagrange_Body.inc index 8f614b83..b95e28ec 100644 --- a/src/interpv/Interp1D_CubicLagrange_Body.inc +++ b/src/interpv/Interp1D_CubicLagrange_Body.inc @@ -1,19 +1,19 @@ !!!s/r Interp1D_CubicLagrange - interpolation: cubic Lagrange method !subroutine Interp1D_CubicLagrange_X & !subroutine Interp1D_CubicLagrange_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: stateDerivSource, ! stateDerivDestn, extrapGuideDown, extrapGuideUp, flux, numExtArraysIn, ! numExtArraysOut, ExtArraysIn, ExtArraysOut @@ -158,4 +158,4 @@ end do ! vt !$OMP END parallel do -end subroutine ! Interp1D_CubicLagrange_X +! end subroutine ! Interp1D_CubicLagrange_X diff --git a/src/interpv/Interp1D_CubicWithDerivs.F90 b/src/interpv/Interp1D_CubicWithDerivs.F90 index dca4fce4..b336b185 100644 --- a/src/interpv/Interp1D_CubicWithDerivs.F90 +++ b/src/interpv/Interp1D_CubicWithDerivs.F90 @@ -19,31 +19,81 @@ !version that accepts real(single) arguments, with the extended interface subroutine Interp1D_CubicWithDerivs_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Interp1D_CubicWithDerivs_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Interp1D_CubicWithDerivs_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Interp1D_CubicWithDerivs_Body.inc" #undef real48 +end subroutine !version that accepts real(single) arguments subroutine Interp1D_CubicWithDerivs & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 single #define DestnFunc Interp1D_CubicWithDerivs_X #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Interp1D_CubicWithDerivs8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define DestnFunc Interp1D_CubicWithDerivs_X8 #define real48 double #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine \ No newline at end of file diff --git a/src/interpv/Interp1D_CubicWithDerivs_Body.inc b/src/interpv/Interp1D_CubicWithDerivs_Body.inc index af8347b5..560c83a5 100644 --- a/src/interpv/Interp1D_CubicWithDerivs_Body.inc +++ b/src/interpv/Interp1D_CubicWithDerivs_Body.inc @@ -1,19 +1,19 @@ !!!s/r Interp1D_CubicWithDerivs - interpolation: cubic with derivatives supplied !subroutine Interp1D_CubicWithDerivs_X & !subroutine Interp1D_CubicWithDerivs_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: extrapGuideDown, extrapGuideUp, ! flux, numExtArraysIn, numExtArraysOut, ExtArraysIn, ExtArraysOut ! @@ -203,4 +203,4 @@ end do ! vt !$OMP END parallel do -end subroutine ! Interp1D_CubicWithDerivs_X +! end subroutine ! Interp1D_CubicWithDerivs_X diff --git a/src/interpv/Interp1D_FindPos.F90 b/src/interpv/Interp1D_FindPos.F90 index 456d8e51..caa40f49 100644 --- a/src/interpv/Interp1D_FindPos.F90 +++ b/src/interpv/Interp1D_FindPos.F90 @@ -21,12 +21,24 @@ !version that accepts real(single) arguments subroutine Interp1D_FindPos & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, posnDestInSrc, vLevelDestn & + ) #define real48 single #include "Interp1D_FindPos_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Interp1D_FindPos8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, posnDestInSrc, vLevelDestn & + ) #define real48 double #include "Interp1D_FindPos_Body.inc" #undef real48 +end subroutine diff --git a/src/interpv/Interp1D_FindPos_Body.inc b/src/interpv/Interp1D_FindPos_Body.inc index dc8559d5..c3399cee 100644 --- a/src/interpv/Interp1D_FindPos_Body.inc +++ b/src/interpv/Interp1D_FindPos_Body.inc @@ -2,11 +2,11 @@ ! occur !subroutine Interp1D_FindPos & !subroutine Interp1D_FindPos8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, posnDestInSrc, vLevelDestn & - ) + ! vLevelSource, posnDestInSrc, vLevelDestn & + ! ) ! !AUTHOR ! J.W. Blezius MAY 2002 first library to replace duplicate interpolation @@ -143,4 +143,4 @@ end do ! t !$OMP END parallel do -end subroutine ! Interp1D_FindPos +!end subroutine ! Interp1D_FindPos diff --git a/src/interpv/Interp1D_Linear.F90 b/src/interpv/Interp1D_Linear.F90 index 06fc4c18..ab66b94a 100644 --- a/src/interpv/Interp1D_Linear.F90 +++ b/src/interpv/Interp1D_Linear.F90 @@ -19,31 +19,81 @@ !version that accepts real(single) arguments, with the extended interface subroutine Interp1D_Linear_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Interp1D_Linear_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Interp1D_Linear_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Interp1D_Linear_Body.inc" #undef real48 +end subroutine !version that accepts real(single) arguments subroutine Interp1D_Linear & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 single #define DestnFunc Interp1D_Linear_X #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Interp1D_Linear8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 double #define DestnFunc Interp1D_Linear_X8 #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine diff --git a/src/interpv/Interp1D_Linear_Body.inc b/src/interpv/Interp1D_Linear_Body.inc index d62d5500..b4b43ac2 100644 --- a/src/interpv/Interp1D_Linear_Body.inc +++ b/src/interpv/Interp1D_Linear_Body.inc @@ -1,19 +1,19 @@ !!!s/r Interp1D_Linear - interpolation: linear method ! subroutine Interp1D_Linear_X & ! subroutine Interp1D_Linear_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: stateDerivSource, ! stateDerivDestn, extrapGuideDown, extrapGuideUp, flux, numExtArraysIn, ! numExtArraysOut, ExtArraysIn, ExtArraysOut @@ -113,4 +113,4 @@ end do ! vt !$OMP END parallel do -end subroutine ! Interp1D_Linear_X +! end subroutine ! Interp1D_Linear_X diff --git a/src/interpv/Interp1D_NearestNeighbour.F90 b/src/interpv/Interp1D_NearestNeighbour.F90 index 19d2cdf6..b8bc2c39 100644 --- a/src/interpv/Interp1D_NearestNeighbour.F90 +++ b/src/interpv/Interp1D_NearestNeighbour.F90 @@ -19,31 +19,81 @@ !version that accepts real(single) arguments, with the extended interface subroutine Interp1D_NearestNeighbour_X & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 single #include "Interp1D_NearestNeighbour_Body.inc" #undef real48 +end subroutine !version that accepts real(double) arguments, with the extended interface subroutine Interp1D_NearestNeighbour_X8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp, & + + flux, numExtArraysIn, numExtArraysOut, & + ExtArraysIn, ExtArraysOut & + ) #define real48 double #include "Interp1D_NearestNeighbour_Body.inc" #undef real48 +end subroutine !version that accepts real(single) arguments subroutine Interp1D_NearestNeighbour & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 single #define DestnFunc Interp1D_NearestNeighbour_X #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine !version that accepts real(double) arguments subroutine Interp1D_NearestNeighbour8 & + (numInterpSets, srcNumLevels, destNumLevels, & + src_ijDim, dst_ijDim, & + + vLevelSource, stateSource, stateDerivSource, & + + posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + + extrapEnableDown, extrapEnableUp, & + extrapGuideDown, extrapGuideUp & + ) #define real48 double #define DestnFunc Interp1D_NearestNeighbour_X8 #include "Interp1D_PreX_Shell.inc" #undef DestnFunc #undef real48 +end subroutine diff --git a/src/interpv/Interp1D_NearestNeighbour_Body.inc b/src/interpv/Interp1D_NearestNeighbour_Body.inc index 14713dc5..257228d5 100644 --- a/src/interpv/Interp1D_NearestNeighbour_Body.inc +++ b/src/interpv/Interp1D_NearestNeighbour_Body.inc @@ -1,19 +1,19 @@ !!!s/r Interp1D_NearestNeighbour - interpolation: nearest-neighbour method !subroutine Interp1D_NearestNeighbour_X & !subroutine Interp1D_NearestNeighbour_X8 & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp, & + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp, & - flux, numExtArraysIn, numExtArraysOut, & - ExtArraysIn, ExtArraysOut & - ) + ! flux, numExtArraysIn, numExtArraysOut, & + ! ExtArraysIn, ExtArraysOut & + ! ) ! These are dummy arguments for this function: stateDerivSource, ! stateDerivDestn, extrapEnableDown, extrapGuideUp, extrapGuideDown, ! extrapGuideUp, flux, numExtArraysIn, numExtArraysOut, ExtArraysIn, @@ -99,4 +99,4 @@ #undef levelBelow #undef levelAbove -end subroutine ! Interp1D_NearestNeighbour_X +! end subroutine ! Interp1D_NearestNeighbour_X diff --git a/src/interpv/Interp1D_PreX_Shell.inc b/src/interpv/Interp1D_PreX_Shell.inc index 13e54ba2..fd809a15 100644 --- a/src/interpv/Interp1D_PreX_Shell.inc +++ b/src/interpv/Interp1D_PreX_Shell.inc @@ -1,15 +1,15 @@ !!!s/r Shell - a general shell to support the pre-extension interface !subroutine RoutineWithOldInterface & - (numInterpSets, srcNumLevels, destNumLevels, & - src_ijDim, dst_ijDim, & + ! (numInterpSets, srcNumLevels, destNumLevels, & + ! src_ijDim, dst_ijDim, & - vLevelSource, stateSource, stateDerivSource, & + ! vLevelSource, stateSource, stateDerivSource, & - posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & + ! posnDestInSrc, vLevelDestn, stateDestn, stateDerivDestn, & - extrapEnableDown, extrapEnableUp, & - extrapGuideDown, extrapGuideUp & - ) + ! extrapEnableDown, extrapEnableUp, & + ! extrapGuideDown, extrapGuideUp & + ! ) ! !AUTHOR ! J.W. Blezius OCT 2003 support the old interface @@ -62,4 +62,4 @@ ExtArraysIn, ExtArraysOut & ) -end subroutine +! end subroutine