Add sp mod (#230)

* Replace Numerial Recipes LU-decomp routines with LAPACK ones * no verbose Spack install * add lapack dep to cmake/PackageConfig.cmake.in * Update LAPACK logic * update spack package for lapack * Add test of output cmake config * Update Linux.yml * debug Linux.yml * Update Linux.yml * Add sp_mod.F and use in src/CMakeLists.txt * Update fftpack.F for use in sp_mod (dummy arrays) * use sp_mod (incl. resolve arg mismatches) * Remove arg mismatch and allow invalid boz flags
NOAA-EMC · Mar 4, 2024 · e10f624 · e10f624
1 parent ce1d621
commit e10f624
Show file tree

Hide file tree

Showing 22 changed files with 179 additions and 90 deletions.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -67,7 +67,7 @@ elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$")
   set(fortran_d_flags "-fdefault-real-8")
   set(fortran_8_flags "-fdefault-integer-8 -fdefault-real-8")
   if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10)
-    set(CMAKE_Fortran_FLAGS "-w -fallow-argument-mismatch -fallow-invalid-boz ${CMAKE_Fortran_FLAGS}")
+    set(CMAKE_Fortran_FLAGS "-w ${CMAKE_Fortran_FLAGS}")
   endif()
 endif()
 

diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
@@ -14,35 +14,22 @@ ip_mercator_grid_mod.F90 ip_polar_stereo_grid_mod.F90
 ip_rot_equid_cylind_egrid_mod.F90 ip_rot_equid_cylind_grid_mod.F90
 ip_constants_mod.F90 ip_grids_mod.F90 ip_grid_factory_mod.F90
 ip_interpolators_mod.F90 earth_radius_mod.F90 polfix_mod.F90
-fftpack.F ncpus.F spanaly.f spdz2uv.f speps.f spfft1.f spffte.f
-spfftpt.f splaplac.f splat.F splegend.f sppad.f spsynth.f sptezd.f sptez.f
-sptezmd.f sptezm.f sptezmv.f sptezv.f sptgpm.f sptgpmv.f sptgps.f sptgpsv.f
-sptgpt.f sptgptv.f sptrand.f sptran.f sptranf0.f sptranf1.f sptranf.f sptranfv.f
-sptranv.f sptrun.f sptrung.f sptrungv.f sptrunm.f sptrunmv.f sptruns.f
-sptrunsv.f sptrunv.f spuv2dz.f spwget.f)
-
-if(BUILD_DEPRECATED)
-  set(fortran_src ${fortran_src} spfft.f spgradq.f spgradx.f spgrady.f sptgpmd.f
-  sptgpsd.f sptgptd.f sptgptsd.f sptgptvd.f sptrund.f sptrunl.f spvar.f)
-endif()
+sp_mod.F)
 
 # Set compiler flags.
 if(CMAKE_BUILD_TYPE MATCHES "Debug")
   # Bounds checking is turned on for all files for the "Debug" build in the
   # main CMakeLists.txt.
-  # Need to turn off bounds checking for fftpack.F, sptranf.f, and sptranfv.f
-  # in order to pass tests.
-  foreach(filename fftpack.F sptranf.f sptranfv.f)
-    if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel|IntelLLVM)$")
-      set_source_files_properties(${filename} PROPERTIES COMPILE_FLAGS -check=nobounds)
-    elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$")
-      if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 6)
-        set_source_files_properties(${filename} PROPERTIES COMPILE_FLAGS -fcheck=no-bounds)
-      else()
-        set_source_files_properties(${filename} PROPERTIES COMPILE_FLAGS -fno-bounds-check)
-      endif()
+  # Need to turn off bounds checking because of fftpack.F, sptranf.f, and sptranfv.f.
+  if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel|IntelLLVM)$")
+    set_source_files_properties(sp_mod.F PROPERTIES COMPILE_FLAGS -check=nobounds)
+  elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$")
+    if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 6)
+      set_source_files_properties(sp_mod.F PROPERTIES COMPILE_FLAGS -fcheck=no-bounds)
+    else()
+      set_source_files_properties(sp_mod.F PROPERTIES COMPILE_FLAGS -fno-bounds-check)
     endif()
-  endforeach()
+  endif()
 endif()
 
 # Build _4, _d, and/or _8 depending on options provided to CMake
@@ -68,6 +55,9 @@ foreach(kind ${kinds})
 
   # Set compiler flags.
   target_compile_definitions(${lib_name} PRIVATE "LSIZE=${kind_definition}")
+  if(BUILD_DEPRECATED)
+    target_compile_definitions(${lib_name} PRIVATE BUILD_DEPRECATED)
+  endif()
   set_target_properties(${lib_name} PROPERTIES COMPILE_FLAGS "${fortran_${kind}_flags}")
   set_target_properties(${lib_name} PROPERTIES Fortran_MODULE_DIRECTORY "${module_dir}")
   target_include_directories(${lib_name}

diff --git a/src/fftpack.F b/src/fftpack.F
@@ -33,8 +33,10 @@ SUBROUTINE dcrft(init,x,ldx,y,ldy,n,m,isign,scale,
      &                 table,n1,wrk,n2,z,nz)
 
       implicit none
-      integer init,ldx,ldy,n,m,isign,n1,n2,nz,i,j
-      real x(2*ldx,*),y(ldy,*),scale,table(44002),wrk,z
+      integer init,ldx,ldy,n,m,isign,n1,n2,i,j
+      real x(2*ldx,*),y(ldy,*),scale,table(44002),wrk(*)
+      real, optional :: z
+      integer, optional :: nz
 
       IF (init.ne.0) THEN
         CALL rffti(n,table)
@@ -79,8 +81,10 @@ SUBROUTINE scrft(init,x,ldx,y,ldy,n,m,isign,scale,
      &                 table,n1,wrk,n2,z,nz)
 
       implicit none
-      integer init,ldx,ldy,n,m,isign,n1,n2,nz,i,j
-      real x(2*ldx,*),y(ldy,*),scale,table(44002),wrk,z
+      integer init,ldx,ldy,n,m,isign,n1,n2,i,j
+      real x(2*ldx,*),y(ldy,*),scale,table(44002),wrk(*)
+      real, optional :: z
+      integer, optional :: nz
 
       IF (init.ne.0) THEN
         CALL rffti(n,table)
@@ -159,8 +163,10 @@ SUBROUTINE drcft(init,x,ldx,y,ldy,n,m,isign,scale,
      &                 table,n1,wrk,n2,z,nz)
 
       implicit none
-      integer init,ldx,ldy,n,m,isign,n1,n2,nz,i,j
-      real x(ldx,*),y(2*ldy,*),scale,table(44002),wrk,z
+      integer init,ldx,ldy,n,m,isign,n1,n2,i,j
+      real x(ldx,*),y(2*ldy,*),scale,table(44002),wrk(*)
+      real, optional :: z
+      integer, optional :: nz
 
       IF (init.ne.0) THEN
         CALL rffti(n,table)
@@ -208,8 +214,10 @@ SUBROUTINE srcft(init,x,ldx,y,ldy,n,m,isign,scale,
      &                 table,n1,wrk,n2,z,nz)
 
       implicit none
-      integer init,ldx,ldy,n,m,isign,n1,n2,nz,i,j
-      real x(ldx,*),y(2*ldy,*),scale,table(44002),wrk,z
+      integer init,ldx,ldy,n,m,isign,n1,n2,i,j
+      real x(ldx,*),y(2*ldy,*),scale,table(44002),wrk(*)
+      real, optional :: z
+      integer, optional :: nz
 
       IF (init.ne.0) THEN
         CALL rffti(n,table)
@@ -280,7 +288,7 @@ SUBROUTINE scfft(isign,n,scale,x,y,table,work,isys)
 C>
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RFFTF (N,R,WSAVE)
-      DIMENSION       R(1)       ,WSAVE(1)
+      DIMENSION       R(*)       ,WSAVE(*)
       IF (N .EQ. 1) RETURN
       CALL RFFTF1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
       RETURN
@@ -294,7 +302,7 @@ SUBROUTINE RFFTF (N,R,WSAVE)
 C>
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RFFTB (N,R,WSAVE)
-      DIMENSION       R(1)       ,WSAVE(1)
+      DIMENSION       R(*)       ,WSAVE(*)
       IF (N .EQ. 1) RETURN
       CALL RFFTB1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
       RETURN
@@ -307,7 +315,7 @@ SUBROUTINE RFFTB (N,R,WSAVE)
 C>
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RFFTI (N,WSAVE)
-      DIMENSION       WSAVE(1)
+      DIMENSION       WSAVE(*)
       IF (N .EQ. 1) RETURN
       CALL RFFTI1 (N,WSAVE(N+1),WSAVE(2*N+1))
       RETURN
@@ -323,7 +331,7 @@ SUBROUTINE RFFTI (N,WSAVE)
 C>
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RFFTB1 (N,C,CH,WA,IFAC)
-      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(*)
+      REAL       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
       NF = IFAC(2)
       NA = 0
       L1 = 1
@@ -392,7 +400,7 @@ SUBROUTINE RFFTB1 (N,C,CH,WA,IFAC)
 C>
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RFFTF1 (N,C,CH,WA,IFAC)
-      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(*)
+      REAL       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
       NF = IFAC(2)
       NA = 1
       L2 = N
@@ -459,7 +467,7 @@ SUBROUTINE RFFTF1 (N,C,CH,WA,IFAC)
 C>
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RFFTI1 (N,WA,IFAC)
-      DIMENSION       WA(1)      ,IFAC(*)    ,NTRYH(4)
+      REAL       WA(*)      ,IFAC(*)    ,NTRYH(4)
       DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
       NL = N
       NF = 0
@@ -529,7 +537,7 @@ SUBROUTINE RFFTI1 (N,WA,IFAC)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADB2 (IDO,L1,CC,CH,WA1)
       DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
-     1                WA1(1)
+     1                WA1(*)
       DO 101 K=1,L1
          CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K)
          CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K)
@@ -568,7 +576,7 @@ SUBROUTINE RADB2 (IDO,L1,CC,CH,WA1)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADB3 (IDO,L1,CC,CH,WA1,WA2)
       DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
-     1                WA1(1)     ,WA2(1)
+     1                WA1(*)     ,WA2(*)
       DATA TAUR,TAUI /-.5,.866025403784439/
       DO 101 K=1,L1
          TR2 = CC(IDO,2,K)+CC(IDO,2,K)
@@ -618,7 +626,7 @@ SUBROUTINE RADB3 (IDO,L1,CC,CH,WA1,WA2)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
       DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
-     1                WA1(1)     ,WA2(1)     ,WA3(1)
+     1                WA1(*)     ,WA2(*)     ,WA3(*)
       DATA SQRT2 /1.414213562373095/
       DO 101 K=1,L1
          TR1 = CC(1,1,K)-CC(IDO,4,K)
@@ -689,7 +697,7 @@ SUBROUTINE RADB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
       DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
-     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
+     1                WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
       DATA TR11,TI11,TR12,TI12 /.309016994374947,.951056516295154,
      1-.809016994374947,.587785252292473/
       DO 101 K=1,L1
@@ -768,7 +776,7 @@ SUBROUTINE RADB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
       SUBROUTINE RADBG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
       DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
      1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
-     2                CH2(IDL1,IP)           ,WA(1)
+     2                CH2(IDL1,IP)           ,WA(*)
       DATA TPI/6.28318530717959/
       ARG = TPI/FLOAT(IP)
       DCP = COS(ARG)
@@ -945,7 +953,7 @@ SUBROUTINE RADBG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADF2 (IDO,L1,CC,CH,WA1)
       DIMENSION       CH(IDO,2,L1)           ,CC(IDO,L1,2)           ,
-     1                WA1(1)
+     1                WA1(*)
       DO 101 K=1,L1
          CH(1,1,K) = CC(1,K,1)+CC(1,K,2)
          CH(IDO,2,K) = CC(1,K,1)-CC(1,K,2)
@@ -983,7 +991,7 @@ SUBROUTINE RADF2 (IDO,L1,CC,CH,WA1)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADF3 (IDO,L1,CC,CH,WA1,WA2)
       DIMENSION       CH(IDO,3,L1)           ,CC(IDO,L1,3)           ,
-     1                WA1(1)     ,WA2(1)
+     1                WA1(*)     ,WA2(*)
       DATA TAUR,TAUI /-.5,.866025403784439/
       DO 101 K=1,L1
          CR2 = CC(1,K,2)+CC(1,K,3)
@@ -1030,7 +1038,7 @@ SUBROUTINE RADF3 (IDO,L1,CC,CH,WA1,WA2)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
       DIMENSION       CC(IDO,L1,4)           ,CH(IDO,4,L1)           ,
-     1                WA1(1)     ,WA2(1)     ,WA3(1)
+     1                WA1(*)     ,WA2(*)     ,WA3(*)
       DATA HSQT2 /.7071067811865475/
       DO 101 K=1,L1
          TR1 = CC(1,K,2)+CC(1,K,4)
@@ -1097,7 +1105,7 @@ SUBROUTINE RADF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
 C> @author Paul N. Swarztrauber, National Center for Atmospheric Research, Boulder, CO
       SUBROUTINE RADF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
       DIMENSION       CC(IDO,L1,5)           ,CH(IDO,5,L1)           ,
-     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
+     1                WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
       DATA TR11,TI11,TR12,TI12 /.309016994374947,.951056516295154,
      1-.809016994374947,.587785252292473/
       DO 101 K=1,L1
@@ -1172,7 +1180,7 @@ SUBROUTINE RADF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
       SUBROUTINE RADFG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
       DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
      1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
-     2                CH2(IDL1,IP)           ,WA(1)
+     2                CH2(IDL1,IP)           ,WA(*)
       DATA TPI/6.28318530717959/
       ARG = TPI/FLOAT(IP)
       DCP = COS(ARG)

diff --git a/src/ip_gaussian_grid_mod.F90 b/src/ip_gaussian_grid_mod.F90
@@ -16,6 +16,7 @@ module ip_gaussian_grid_mod
   use ip_grid_mod
   use earth_radius_mod
   use ip_constants_mod
+  use sp_mod
   implicit none
 
   private

diff --git a/src/sp_mod.F b/src/sp_mod.F
@@ -0,0 +1,63 @@
+      module sp_mod
+
+      contains
+
+#include "fftpack.F"
+#include "ncpus.F"
+#include "spanaly.f"
+#include "spdz2uv.f"
+#include "speps.f"
+#include "spfft1.f"
+#include "spffte.f"
+#include "spfftpt.f"
+#include "splaplac.f"
+#include "splat.F"
+#include "splegend.f"
+#include "sppad.f"
+#include "spsynth.f"
+#include "sptezd.f"
+#include "sptez.f"
+#include "sptezmd.f"
+#include "sptezm.f"
+#include "sptezmv.f"
+#include "sptezv.f"
+#include "sptgpm.f"
+#include "sptgpmv.f"
+#include "sptgps.f"
+#include "sptgpsv.f"
+#include "sptgpt.f"
+#include "sptgptv.f"
+#include "sptrand.f"
+#include "sptran.f"
+#include "sptranf0.f"
+#include "sptranf1.f"
+#include "sptranf.f"
+#include "sptranfv.f"
+#include "sptranv.f"
+#include "sptrun.f"
+#include "sptrung.f"
+#include "sptrungv.f"
+#include "sptrunm.f"
+#include "sptrunmv.f"
+#include "sptruns.f"
+#include "sptrunsv.f"
+#include "sptrunv.f"
+#include "spuv2dz.f"
+#include "spwget.f"
+
+#ifdef BUILD_DEPRECATED
+#include "spfft.f"
+#include "spgradq.f"
+#include "spgradx.f"
+#include "spgrady.f"
+#include "sptgpmd.f"
+#include "sptgpsd.f"
+#include "sptgptd.f"
+#include "sptgptsd.f"
+#include "sptgptvd.f"
+#include "sptrund.f"
+#include "sptrunl.f"
+#include "spvar.f"
+#endif
+
+      end module