diff --git a/ci/spack_gcc.yaml b/ci/spack_gcc.yaml index ad8965add..4598f28e9 100644 --- a/ci/spack_gcc.yaml +++ b/ci/spack_gcc.yaml @@ -11,13 +11,12 @@ spack: specs: - netcdf-c@4.9.2 - netcdf-fortran@4.6.1 - - bufr@11.7.0 + - bufr@12.1.0 - bacio@2.4.1 - w3emc@2.10.0 - - sp@2.5.0 - - ip@4.3.0 - - sigio@2.3.2 - - sfcio@1.4.1 + - ip@5.1.0 + - sigio@2.3.3 + - sfcio@1.4.2 - nemsio@2.5.4 - wrf-io@1.2.0 - ncio@1.1.2 diff --git a/ci/spack_intel.yaml b/ci/spack_intel.yaml index c3c74e407..4049e22d5 100644 --- a/ci/spack_intel.yaml +++ b/ci/spack_intel.yaml @@ -9,13 +9,12 @@ spack: specs: - netcdf-c@4.9.2 ~blosc build_system=cmake - netcdf-fortran@4.6.1 - - bufr@11.7.0 + - bufr@12.1.0 - bacio@2.4.1 - w3emc@2.10.0 - - sp@2.5.0 - - ip@4.3.0 - - sigio@2.3.2 - - sfcio@1.4.1 + - ip@5.1.0 + - sigio@2.3.3 + - sfcio@1.4.2 - nemsio@2.5.4 - wrf-io@1.2.0 - ncio@1.1.2 diff --git a/modulefiles/gsi_acorn.intel.lua b/modulefiles/gsi_acorn.intel.lua index 01c55b58b..313e08171 100644 --- a/modulefiles/gsi_acorn.intel.lua +++ b/modulefiles/gsi_acorn.intel.lua @@ -13,8 +13,7 @@ local netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" local bufr_ver=os.getenv("bufr_ver") or "12.1.0" local bacio_ver=os.getenv("bacio_ver") or "2.4.1" local w3emc_ver=os.getenv("w3emc_ver") or "2.9.2" -local sp_ver=os.getenv("sp_ver") or "2.3.3" -local ip_ver=os.getenv("ip_ver") or "3.3.3" +local ip_ver=os.getenv("ip_ver") or "5.1.0" local sigio_ver=os.getenv("sigio_ver") or "2.3.2" local sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" local nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" @@ -23,7 +22,6 @@ local ncio_ver=os.getenv("ncio_ver") or "1.1.2" local crtm_ver=os.getenv("crtm_ver") or "2.4.0.1" local ncdiag_ver=os.getenv("ncdiag_ver") or "1.1.1" -load(pathJoin("envvar", "1.0")) load(pathJoin("PrgEnv-intel", PrgEnv_intel_ver)) load(pathJoin("intel", intel_ver)) load(pathJoin("craype", craype_ver)) @@ -37,13 +35,22 @@ load(pathJoin("netcdf", netcdf_ver)) load(pathJoin("bufr", bufr_ver)) load(pathJoin("bacio", bacio_ver)) load(pathJoin("w3emc", w3emc_ver)) -load(pathJoin("sp", sp_ver)) -load(pathJoin("ip", ip_ver)) +--load(pathJoin("ip", ip_ver)) +-- Temporarily define IP's paths here. +-- TODO when testing is complete, request an official installation in https://github.com/NOAA-EMC/WCOSS2-requests/issues/11 +pushenv("ip_ROOT", pathJoin("/lfs/h2/emc/nceplibs/noscrub/hpc-stack/libs/hpc-stack/intel-19.1.3.304/ip", ip_ver)) +pushenv("IP_INC4", pathJoin("/lfs/h2/emc/nceplibs/noscrub/hpc-stack/libs/hpc-stack/intel-19.1.3.304/ip", ip_ver, "include_4")) +pushenv("IP_INCd", pathJoin("/lfs/h2/emc/nceplibs/noscrub/hpc-stack/libs/hpc-stack/intel-19.1.3.304/ip", ip_ver, "include_d")) +pushenv("IP_LIB4", pathJoin("/lfs/h2/emc/nceplibs/noscrub/hpc-stack/libs/hpc-stack/intel-19.1.3.304/ip", ip_ver, "lib64/libip_4.a")) +pushenv("IP_LIBd", pathJoin("/lfs/h2/emc/nceplibs/noscrub/hpc-stack/libs/hpc-stack/intel-19.1.3.304/ip", ip_ver, "lib64/libip_d.a")) +pushenv("ip_VERSION", ip_ver) + load(pathJoin("sigio", sigio_ver)) load(pathJoin("sfcio", sfcio_ver)) load(pathJoin("nemsio", nemsio_ver)) load(pathJoin("wrf_io", wrf_io_ver)) load(pathJoin("ncio", ncio_ver)) +--load(pathJoin("crtm", crtm_ver)) load(pathJoin("ncdiag",ncdiag_ver)) -- Lastly, load CRTM from the EMC location diff --git a/modulefiles/gsi_common.lua b/modulefiles/gsi_common.lua index cb49a4387..ced00cfde 100644 --- a/modulefiles/gsi_common.lua +++ b/modulefiles/gsi_common.lua @@ -5,18 +5,18 @@ Load common modules to build GSI on all machines local netcdf_c_ver=os.getenv("netcdf_c_ver") or "4.9.2" local netcdf_fortran_ver=os.getenv("netcdf_fortran_ver") or "4.6.1" -local bufr_ver=os.getenv("bufr_ver") or "11.7.0" +local bufr_ver=os.getenv("bufr_ver") or "12.1.0" local bacio_ver=os.getenv("bacio_ver") or "2.4.1" local w3emc_ver=os.getenv("w3emc_ver") or "2.10.0" -local sp_ver=os.getenv("sp_ver") or "2.5.0" -local ip_ver=os.getenv("ip_ver") or "4.3.0" -local sigio_ver=os.getenv("sigio_ver") or "2.3.2" -local sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" +local ip_ver=os.getenv("ip_ver") or "5.1.0" +local sigio_ver=os.getenv("sigio_ver") or "2.3.3" +local sfcio_ver=os.getenv("sfcio_ver") or "1.4.2" local nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" local wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" local ncio_ver=os.getenv("ncio_ver") or "1.1.2" local crtm_ver=os.getenv("crtm_ver") or "2.4.0.1" local ncdiag_ver=os.getenv("ncdiag_ver") or "1.1.2" +local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" load(pathJoin("netcdf-c", netcdf_c_ver)) load(pathJoin("netcdf-fortran", netcdf_fortran_ver)) @@ -24,7 +24,6 @@ load(pathJoin("netcdf-fortran", netcdf_fortran_ver)) load(pathJoin("bufr", bufr_ver)) load(pathJoin("bacio", bacio_ver)) load(pathJoin("w3emc", w3emc_ver)) -load(pathJoin("sp", sp_ver)) load(pathJoin("ip", ip_ver)) load(pathJoin("sigio", sigio_ver)) load(pathJoin("sfcio", sfcio_ver)) @@ -32,4 +31,5 @@ load(pathJoin("nemsio", nemsio_ver)) load(pathJoin("wrf-io", wrf_io_ver)) load(pathJoin("ncio", ncio_ver)) load(pathJoin("crtm", crtm_ver)) -load(pathJoin("gsi-ncdiag",ncdiag_ver)) +load(pathJoin("gsi-ncdiag", ncdiag_ver)) +load(pathJoin("prod_util", prod_util_ver)) diff --git a/modulefiles/gsi_discover.intel b/modulefiles/gsi_discover.intel deleted file mode 100644 index 4f4b04047..000000000 --- a/modulefiles/gsi_discover.intel +++ /dev/null @@ -1,20 +0,0 @@ -#%Module###################################################################### -proc ModulesHelp { } { - puts stderr "Set environment variables for NOAA-EMC/GSI" - puts stderr "This module initializes the environment " - puts stderr "for building and testing NOAA-EMC/GSI on NCCS Discover\n" -} -module-whatis "Initialize NOAA-EMC/GSI build/test environment" - -module load comp/intel-18.0.3.222 -module load lib/mkl-18.0.3.222 -module load mpi/sgi-mpt-2.17 -module load other/comp/gcc-9.1 -module load other/cmake-3.8.2 - -setenv BASEDIR /discover/nobackup/projects/gmao/share/gmao_ops/Baselibs/v5.1.3_build1/x86_64-unknown-linux-gnu/ifort_18.0.3.222-mpt_2.17 - -# Compiler flags specific to this platform -setenv CFLAGS "-xHOST" -setenv FFLAGS "-xHOST" - diff --git a/modulefiles/gsi_gaeac5.intel.lua b/modulefiles/gsi_gaeac5.intel.lua deleted file mode 100644 index f660a742b..000000000 --- a/modulefiles/gsi_gaeac5.intel.lua +++ /dev/null @@ -1,28 +0,0 @@ -help([[ -]]) - -prepend_path("MODULEPATH", "/ncrc/proj/epic/spack-stack/spack-stack-1.6.0/envs/gsi-addon-dev/install/modulefiles/Core") - -local stack_python_ver=os.getenv("stack_python_ver") or "3.11.6" -local stack_intel_ver=os.getenv("stack_intel_ver") or "2023.2.0" -local stack_cray_mpich_ver=os.getenv("stack_cray_mpich_ver") or "8.1.28" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" - -load(pathJoin("stack-intel", stack_intel_ver)) -load(pathJoin("stack-cray-mpich", stack_cray_mpich_ver)) -load(pathJoin("stack-python", stack_python_ver)) -load(pathJoin("cmake", cmake_ver)) - -load("gsi_common") -load(pathJoin("prod_util", prod_util_ver)) - -pushenv("GSI_BINARY_SOURCE_DIR", "/gpfs/f5/ufs-ard/world-shared/GSI_data/fix/gsi/20241022") - -setenv("CC","cc") -setenv("FC","ftn") -setenv("CXX","CC") -pushenv("CRAYPE_LINK_TYPE","dynamic") - -unload("cray-libsci") -whatis("Description: GSI environment on GaeaC5 with Intel Compilers") diff --git a/modulefiles/gsi_gaeac6.intel.lua b/modulefiles/gsi_gaeac6.intel.lua index bbf1a4918..5ec8db916 100644 --- a/modulefiles/gsi_gaeac6.intel.lua +++ b/modulefiles/gsi_gaeac6.intel.lua @@ -1,14 +1,12 @@ help([[ ]]) ---prepend_path("MODULEPATH", "/ncrc/proj/epic/spack-stack/spack-stack-1.6.0/envs/gsi-addon-dev/install/modulefiles/Core") -prepend_path("MODULEPATH", "/ncrc/proj/epic/spack-stack/c6/spack-stack-1.6.0/envs/gsi-addon/install/modulefiles/Core") +prepend_path("MODULEPATH", "/ncrc/proj/epic/spack-stack/c6/spack-stack-1.9.2/envs/ue-intel-2023.2.0/install/modulefiles/Core") -local stack_python_ver=os.getenv("stack_python_ver") or "3.11.6" +local stack_python_ver=os.getenv("stack_python_ver") or "3.11.7" local stack_intel_ver=os.getenv("stack_intel_ver") or "2023.2.0" -local stack_cray_mpich_ver=os.getenv("stack_cray_mpich_ver") or "8.1.29" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" +local stack_cray_mpich_ver=os.getenv("stack_cray_mpich_ver") or "8.1.30" +local cmake_ver=os.getenv("cmake_ver") or "3.27.9" load(pathJoin("stack-intel", stack_intel_ver)) load(pathJoin("stack-cray-mpich", stack_cray_mpich_ver)) @@ -16,7 +14,6 @@ load(pathJoin("stack-python", stack_python_ver)) load(pathJoin("cmake", cmake_ver)) load("gsi_common") -load(pathJoin("prod_util", prod_util_ver)) pushenv("GSI_BINARY_SOURCE_DIR", "/gpfs/f6/bil-fire8/world-shared/GSI_data/fix/gsi/20241022") diff --git a/modulefiles/gsi_hera.gnu.lua b/modulefiles/gsi_hera.gnu.lua deleted file mode 100644 index d115f839e..000000000 --- a/modulefiles/gsi_hera.gnu.lua +++ /dev/null @@ -1,25 +0,0 @@ -help([[ -]]) - -prepend_path("MODULEPATH", "/scratch4/NCEPDEV/stmp/role.epic/spack-stack/spack-stack-1.6.0/envs/gsi-addon-dev-rocky8/install/modulefiles/Core") - -local python_ver=os.getenv("python_ver") or "3.11.6" -local stack_gnu_ver=os.getenv("stack_gnu_ver") or "9.2.0" -local stack_openmpi_ver=os.getenv("stack_openmpi_ver") or "4.1.6" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" -local openblas_ver=os.getenv("openblas_ver") or "0.3.24" - -load(pathJoin("stack-gcc", stack_gnu_ver)) -load(pathJoin("stack-openmpi", stack_openmpi_ver)) -load(pathJoin("python", python_ver)) -load(pathJoin("cmake", cmake_ver)) - -load("gsi_common") - -load(pathJoin("prod_util", prod_util_ver)) -load(pathJoin("openblas", openblas_ver)) - -pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20241022") - -whatis("Description: GSI environment on Hera with GNU Compilers") diff --git a/modulefiles/gsi_hera.intel.lua b/modulefiles/gsi_hera.intel.lua index 527c61d28..7f2690ba5 100644 --- a/modulefiles/gsi_hera.intel.lua +++ b/modulefiles/gsi_hera.intel.lua @@ -1,21 +1,24 @@ help([[ ]]) -prepend_path("MODULEPATH", "/contrib/spack-stack/spack-stack-1.6.0/envs/gsi-addon-dev-rocky8/install/modulefiles/Core") +prepend_path("MODULEPATH", "/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.2.1/install/modulefiles/Core") -local python_ver=os.getenv("python_ver") or "3.11.6" -local stack_intel_ver=os.getenv("stack_intel_ver") or "2021.5.0" -local stack_impi_ver=os.getenv("stack_impi_ver") or "2021.5.1" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" +local stack_oneapi_ver=os.getenv("stack_oneapi_ver") or "2024.2.1" +local stack_intel_oneapi_mpi_ver=os.getenv("stack_intel_oneapi_mpi_ver") or "2021.13" +local mkl_ver=os.getenv("mkl_ver") or "2024.2.1" +local stack_python_ver=os.getenv("stack_python_ver") or "3.11.7" +local cmake_ver=os.getenv("cmake_ver") or "3.27.9" -load(pathJoin("stack-intel", stack_intel_ver)) -load(pathJoin("stack-intel-oneapi-mpi", stack_impi_ver)) -load(pathJoin("python", python_ver)) +load(pathJoin("stack-oneapi", stack_oneapi_ver)) +load(pathJoin("stack-intel-oneapi-mpi", stack_intel_oneapi_mpi_ver)) +load(pathJoin("mkl", mkl_ver)) +load(pathJoin("stack-python", stack_python_ver)) load(pathJoin("cmake", cmake_ver)) load("gsi_common") -load(pathJoin("prod_util", prod_util_ver)) + +unload("impi/2024.2.1") +load("impi/2022.1.2") pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") diff --git a/modulefiles/gsi_hercules.intel.lua b/modulefiles/gsi_hercules.intel.lua index 9c8d319b7..2d447e241 100644 --- a/modulefiles/gsi_hercules.intel.lua +++ b/modulefiles/gsi_hercules.intel.lua @@ -1,22 +1,26 @@ help([[ ]]) -prepend_path("MODULEPATH", "/work/noaa/epic/role-epic/spack-stack/hercules/spack-stack-1.6.0/envs/gsi-addon-env/install/modulefiles/Core") +prepend_path("MODULEPATH", "/apps/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.1.0/install/modulefiles/Core") -local stack_python_ver=os.getenv("stack_python_ver") or "3.11.6" -local stack_intel_ver=os.getenv("stack_intel_ver") or "2021.9.0" -local stack_impi_ver=os.getenv("stack_impi_ver") or "2021.9.0" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" +local stack_oneapi_ver=os.getenv("stack_oneapi_ver") or "2024.2.1" +local stack_intel_oneapi_mpi_ver=os.getenv("stack_intel_oneapi_mpi_ver") or "2021.13" +local intel_oneapi_mkl_ver=os.getenv("intel_oneapi_mkl_ver") or "2024.2.1" +local stack_python_ver=os.getenv("stack_python_ver") or "3.11.7" +local cmake_ver=os.getenv("cmake_ver") or "3.27.9" -load(pathJoin("stack-intel", stack_intel_ver)) -load(pathJoin("stack-intel-oneapi-mpi", stack_impi_ver)) -load(pathJoin("python", stack_python_ver)) +load(pathJoin("stack-oneapi", stack_oneapi_ver)) +load(pathJoin("stack-intel-oneapi-mpi", stack_intel_oneapi_mpi_ver)) +load(pathJoin("intel-oneapi-mkl", intel_oneapi_mkl_ver)) +load(pathJoin("stack-python", stack_python_ver)) load(pathJoin("cmake", cmake_ver)) load("gsi_common") -load(pathJoin("prod_util", prod_util_ver)) -load("intel-oneapi-mkl/2022.2.1") + +unload("intel-oneapi-mpi/2021.13.1") +load("intel-oneapi-mpi/2021.7.1") + +load("tar/1.34") pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") diff --git a/modulefiles/gsi_jet.intel.lua b/modulefiles/gsi_jet.intel.lua deleted file mode 100644 index ea9dd3820..000000000 --- a/modulefiles/gsi_jet.intel.lua +++ /dev/null @@ -1,25 +0,0 @@ -help([[ -]]) - -prepend_path("MODULEPATH", "/contrib/spack-stack/spack-stack-1.6.0/envs/gsi-addon-intel/install/modulefiles/Core") - -local python_ver=os.getenv("python_ver") or "3.11.6" -local stack_intel_ver=os.getenv("stack_intel_ver") or "2021.5.0" -local stack_impi_ver=os.getenv("stack_impi_ver") or "2021.5.1" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" - -load(pathJoin("stack-intel", stack_intel_ver)) -load(pathJoin("stack-intel-oneapi-mpi", stack_impi_ver)) -load(pathJoin("python", python_ver)) -load(pathJoin("cmake", cmake_ver)) - -load("gsi_common") -load(pathJoin("prod_util", prod_util_ver)) - -pushenv("CFLAGS", "-axSSE4.2,AVX,CORE-AVX2") -pushenv("FFLAGS", "-axSSE4.2,AVX,CORE-AVX2") - -pushenv("GSI_BINARY_SOURCE_DIR", "/lfs5/HFIP/hfv3gfs/glopara/FIX/fix/gsi/20241022") - -whatis("Description: GSI environment on Jet with Intel Compilers") diff --git a/modulefiles/gsi_orion.intel.lua b/modulefiles/gsi_orion.intel.lua index 3f6ececca..2a25dfe13 100644 --- a/modulefiles/gsi_orion.intel.lua +++ b/modulefiles/gsi_orion.intel.lua @@ -1,22 +1,21 @@ help([[ ]]) -prepend_path("MODULEPATH", "/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.6.0/envs/gsi-addon-env-rocky9/install/modulefiles/Core") +prepend_path("MODULEPATH", "/apps/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.1.0/install/modulefiles/Core") -local stack_python_ver=os.getenv("stack_python_ver") or "3.11.6" -local stack_intel_ver=os.getenv("stack_intel_ver") or "2021.9.0" -local stack_impi_ver=os.getenv("stack_impi_ver") or "2021.9.0" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" +local stack_oneapi_ver=os.getenv("stack_oneapi_ver") or "2024.2.1" +local stack_intel_oneapi_mpi_ver=os.getenv("stack_intel_oneapi_mpi_ver") or "2021.13" +local intel_oneapi_mkl_ver=os.getenv("intel_oneapi_mkl_ver") or "2024.2.1" +local stack_python_ver=os.getenv("stack_python_ver") or "3.11.7" +local cmake_ver=os.getenv("cmake_ver") or "3.27.9" -load(pathJoin("stack-intel", stack_intel_ver)) -load(pathJoin("stack-intel-oneapi-mpi", stack_impi_ver)) -load(pathJoin("python", stack_python_ver)) +load(pathJoin("stack-oneapi", stack_oneapi_ver)) +load(pathJoin("stack-intel-oneapi-mpi", stack_intel_oneapi_mpi_ver)) +load(pathJoin("intel-oneapi-mkl", intel_oneapi_mkl_ver)) +load(pathJoin("stack-python", stack_python_ver)) load(pathJoin("cmake", cmake_ver)) load("gsi_common") -load(pathJoin("prod_util", prod_util_ver)) -load("intel-oneapi-mkl/2022.2.1") pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") diff --git a/modulefiles/gsi_s4.intel.lua b/modulefiles/gsi_s4.intel.lua deleted file mode 100644 index 069b6f90c..000000000 --- a/modulefiles/gsi_s4.intel.lua +++ /dev/null @@ -1,25 +0,0 @@ -help([[ -]]) - -prepend_path("MODULEPATH", "/data/prod/jedi/spack-stack/spack-stack-1.6.0/envs/gsi-addon-env/install/modulefiles/Core") - -local python_ver=os.getenv("python_ver") or "3.11.6" -local stack_intel_ver=os.getenv("stack_intel_ver") or "2021.5.0" -local stack_impi_ver=os.getenv("stack_impi_ver") or "2021.5.0" -local cmake_ver=os.getenv("cmake_ver") or "3.23.1" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" - -load(pathJoin("stack-intel", stack_intel_ver)) -load(pathJoin("stack-intel-oneapi-mpi", stack_impi_ver)) -load(pathJoin("python", python_ver)) -load(pathJoin("cmake", cmake_ver)) - -load("gsi_common") -load(pathJoin("prod_util", prod_util_ver)) - -pushenv("CFLAGS", "-march=ivybridge") -pushenv("FFLAGS", "-march=ivybridge") - -pushenv("GSI_BINARY_SOURCE_DIR", "/data/prod/glopara/fix/gsi/20241022") - -whatis("Description: GSI environment on S4 with Intel Compilers") diff --git a/modulefiles/gsi_ursa.intel.lua b/modulefiles/gsi_ursa.intel.lua index ffa5b3980..b5943cf71 100644 --- a/modulefiles/gsi_ursa.intel.lua +++ b/modulefiles/gsi_ursa.intel.lua @@ -1,53 +1,21 @@ help([[ ]]) -prepend_path("MODULEPATH", "/contrib/spack-stack/spack-stack-1.9.1/envs/ue-oneapi-2024.2.1/install/modulefiles/Core") +prepend_path("MODULEPATH", "/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.2.1/install/modulefiles/Core") local stack_oneapi_ver=os.getenv("stack_oneapi_ver") or "2024.2.1" local stack_impi_ver=os.getenv("stack_impi_ver") or "2021.13" local oneapi_mkl_ver=os.getenv("oneapi_mkl_ver") or "2024.2.1" local stack_python_ver=os.getenv("stack_python_ver") or "3.11.7" local cmake_ver=os.getenv("cmake_ver") or "3.27.9" -local prod_util_ver=os.getenv("prod_util_ver") or "2.1.1" load(pathJoin("stack-oneapi", stack_oneapi_ver)) load(pathJoin("stack-intel-oneapi-mpi", stack_impi_ver)) load(pathJoin("intel-oneapi-mkl", oneapi_mkl_ver)) load(pathJoin("stack-python", stack_python_ver)) load(pathJoin("cmake", cmake_ver)) -load(pathJoin("prod_util", prod_util_ver)) ---load("gsi_common") --- ursa specific gsi_common -local netcdf_c_ver=os.getenv("netcdf_c_ver") or "4.9.2" -local netcdf_fortran_ver=os.getenv("netcdf_fortran_ver") or "4.6.1" -local bufr_ver=os.getenv("bufr_ver") or "12.1.0" -local bacio_ver=os.getenv("bacio_ver") or "2.4.1" -local w3emc_ver=os.getenv("w3emc_ver") or "2.10.0" -local sp_ver=os.getenv("sp_ver") or "2.5.0" -local ip_ver=os.getenv("ip_ver") or "5.1.0" -local sigio_ver=os.getenv("sigio_ver") or "2.3.3" -local sfcio_ver=os.getenv("sfcio_ver") or "1.4.2" -local nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" -local wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" -local ncio_ver=os.getenv("ncio_ver") or "1.1.2" -local crtm_ver=os.getenv("crtm_ver") or "2.4.0.1" -local ncdiag_ver=os.getenv("ncdiag_ver") or "1.1.2" - -load(pathJoin("netcdf-c", netcdf_c_ver)) -load(pathJoin("netcdf-fortran", netcdf_fortran_ver)) -load(pathJoin("bufr", bufr_ver)) -load(pathJoin("bacio", bacio_ver)) -load(pathJoin("w3emc", w3emc_ver)) -load(pathJoin("sp", sp_ver)) -load(pathJoin("ip", ip_ver)) -load(pathJoin("sigio", sigio_ver)) -load(pathJoin("sfcio", sfcio_ver)) -load(pathJoin("nemsio", nemsio_ver)) -load(pathJoin("wrf-io", wrf_io_ver)) -load(pathJoin("ncio", ncio_ver)) -load(pathJoin("crtm", crtm_ver)) -load(pathJoin("gsi-ncdiag",ncdiag_ver)) +load("gsi_common") pushenv("GSI_BINARY_SOURCE_DIR", "/scratch3/NCEPDEV/global/role.glopara/fix/gsi/20250430") diff --git a/modulefiles/gsi_wcoss2.intel.lua b/modulefiles/gsi_wcoss2.intel.lua index 2f26a8409..d70901e31 100644 --- a/modulefiles/gsi_wcoss2.intel.lua +++ b/modulefiles/gsi_wcoss2.intel.lua @@ -9,19 +9,21 @@ local cmake_ver= os.getenv("cmake_ver") or "3.20.2" local python_ver=os.getenv("python_ver") or "3.8.6" local prod_util_ver=os.getenv("prod_util_ver") or "2.0.10" -local netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" +local hdf5_ver=os.getenv("hdf5_ver") or "1.14.0" +local pnetcdf_ver=os.getenv("pnetcdf_ver") or "1.12.2" +local netcdf_ver=os.getenv("netcdf_ver") or "4.9.2" + local bufr_ver=os.getenv("bufr_ver") or "12.1.0" local bacio_ver=os.getenv("bacio_ver") or "2.4.1" local w3emc_ver=os.getenv("w3emc_ver") or "2.9.2" -local sp_ver=os.getenv("sp_ver") or "2.3.3" -local ip_ver=os.getenv("ip_ver") or "3.3.3" +local ip_ver=os.getenv("ip_ver") or "5.2.0" local sigio_ver=os.getenv("sigio_ver") or "2.3.2" local sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" local nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" local wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" local ncio_ver=os.getenv("ncio_ver") or "1.1.2" local crtm_ver=os.getenv("crtm_ver") or "2.4.0.1" -local ncdiag_ver=os.getenv("ncdiag_ver") or "1.1.1" +local ncdiag_ver=os.getenv("ncdiag_ver") or "1.1.2" load(pathJoin("PrgEnv-intel", PrgEnv_intel_ver)) load(pathJoin("intel", intel_ver)) @@ -32,19 +34,30 @@ load(pathJoin("python", python_ver)) load(pathJoin("prod_util", prod_util_ver)) -load(pathJoin("netcdf", netcdf_ver)) +load(pathJoin("hdf5-D", hdf5_ver)) +load(pathJoin("pnetcdf-D", pnetcdf_ver)) +load(pathJoin("netcdf-D", netcdf_ver)) + load(pathJoin("bufr", bufr_ver)) load(pathJoin("bacio", bacio_ver)) load(pathJoin("w3emc", w3emc_ver)) -load(pathJoin("sp", sp_ver)) -load(pathJoin("ip", ip_ver)) +--load(pathJoin("ip", ip_ver)) +-- Temporarily define IP's paths here. +-- TODO when testing is complete, request an official installation in https://github.com/NOAA-EMC/WCOSS2-requests/issues/11 +pushenv("ip_ROOT", pathJoin("/apps/ops/para/libs/intel/19.1.3.304/ip", ip_ver)) +pushenv("IP_INC4", pathJoin("/apps/ops/para/libs/intel/19.1.3.304/ip", ip_ver, "include_4")) +pushenv("IP_INCd", pathJoin("/apps/ops/para/libs/intel/19.1.3.304/ip", ip_ver, "include_d")) +pushenv("IP_LIB4", pathJoin("/apps/ops/para/libs/intel/19.1.3.304/ip", ip_ver, "lib64/libip_4.a")) +pushenv("IP_LIBd", pathJoin("/apps/ops/para/libs/intel/19.1.3.304/ip", ip_ver, "lib64/libip_d.a")) +pushenv("ip_VERSION", ip_ver) + load(pathJoin("sigio", sigio_ver)) load(pathJoin("sfcio", sfcio_ver)) load(pathJoin("nemsio", nemsio_ver)) load(pathJoin("wrf_io", wrf_io_ver)) -load(pathJoin("ncio", ncio_ver)) +load(pathJoin("ncio-A", ncio_ver)) load(pathJoin("crtm", crtm_ver)) -load(pathJoin("ncdiag",ncdiag_ver)) +load(pathJoin("ncdiag-A",ncdiag_ver)) pushenv("GSI_BINARY_SOURCE_DIR", "/lfs/h2/emc/global/noscrub/emc.global/FIX/fix/gsi/20241022") diff --git a/regression/regression_param.sh b/regression/regression_param.sh index 8eaa1b2dc..c9a081fc6 100755 --- a/regression/regression_param.sh +++ b/regression/regression_param.sh @@ -22,20 +22,10 @@ case $machine in Hercules) sub_cmd="sub_hercules" memnode=512 - numcore=40 - ;; - Jet) - sub_cmd="sub_jet" - memnode=96 - numcore=40 - ;; - gaeac5) - sub_cmd="sub_gaeac5" - memnode=251 - numcore=128 + numcore=80 ;; gaeac6) - sub_cmd="sub_gaeac6" + sub_cmd="sub_gaeac6" memnode=384 numcore=192 ;; @@ -49,9 +39,6 @@ case $machine in memnode=512 numcore=128 ;; - Discover) - sub_cmd="sub_discover" - ;; *) # EXIT out for unresolved machine echo "unknown $machine" exit 1 @@ -80,15 +67,6 @@ case $regtest in elif [[ "$machine" = "Hercules" ]]; then topts[1]="0:10:00" ; popts[1]="12/8/" ; ropts[1]="/1" topts[2]="0:10:00" ; popts[2]="12/12/" ; ropts[2]="/2" - elif [[ "$machine" = "Jet" ]]; then - topts[1]="0:10:00" ; popts[1]="12/8/" ; ropts[1]="/1" - topts[2]="0:10:00" ; popts[2]="12/10/" ; ropts[2]="/2" - elif [[ "$machine" = "Discover" ]]; then - topts[1]="0:30:00" ; popts[1]="48/2" ; ropts[1]="/1" - topts[2]="0:30:00" ; popts[2]="60/3" ; ropts[2]="/2" - elif [[ "$machine" = "gaeac5" ]]; then - topts[1]="0:10:00" ; popts[1]="12/8/" ; ropts[1]="/1" - topts[2]="0:10:00" ; popts[2]="12/10/" ; ropts[2]="/2" elif [[ "$machine" = "gaeac6" ]]; then topts[1]="0:10:00" ; popts[1]="12/8/" ; ropts[1]="/1" topts[2]="0:10:00" ; popts[2]="12/10/" ; ropts[2]="/2" @@ -119,17 +97,11 @@ case $regtest in elif [[ "$machine" = "Hercules" ]]; then topts[1]="0:05:00" ; popts[1]="40/3/" ; ropts[1]="/1" topts[2]="0:05:00" ; popts[2]="40/5/" ; ropts[2]="/2" - elif [[ "$machine" = "Jet" ]]; then - topts[1]="0:15:00" ; popts[1]="40/3/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="40/5/" ; ropts[2]="/1" - elif [[ "$machine" = "gaeac5" ]]; then - topts[1]="0:15:00" ; popts[1]="40/3/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="40/5/" ; ropts[2]="/1" elif [[ "$machine" = "gaeac6" ]]; then topts[1]="0:15:00" ; popts[1]="40/3/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="40/5/" ; ropts[2]="/1" elif [[ "$machine" = "wcoss2" || "$machine" = "acorn" ]]; then - topts[1]="0:15:00" ; popts[1]="64/1/" ; ropts[1]="/1" + topts[1]="0:15:00" ; popts[1]="64/2/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="128/2/" ; ropts[2]="/1" fi @@ -155,12 +127,6 @@ case $regtest in elif [[ "$machine" = "Hercules" ]]; then topts[1]="0:15:00" ; popts[1]="20/1/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="5/8/" ; ropts[2]="/2" - elif [[ "$machine" = "Jet" ]]; then - topts[1]="0:15:00" ; popts[1]="5/4/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="10/4/" ; ropts[2]="/1" - elif [[ "$machine" = "gaeac5" ]]; then - topts[1]="0:15:00" ; popts[1]="32/2/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="64/4/" ; ropts[2]="/1" elif [[ "$machine" = "gaeac6" ]]; then topts[1]="0:15:00" ; popts[1]="64/1/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="128/2/" ; ropts[2]="/1" @@ -178,7 +144,7 @@ case $regtest in ;; hafs_4denvar_glbens) - + if [[ "$machine" = "Hera" ]]; then topts[1]="0:15:00" ; popts[1]="5/4/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="10/4/" ; ropts[2]="/1" @@ -191,12 +157,6 @@ case $regtest in elif [[ "$machine" = "Hercules" ]]; then topts[1]="0:20:00" ; popts[1]="5/4/" ; ropts[1]="/1" topts[2]="0:20:00" ; popts[2]="10/4/" ; ropts[2]="/1" - elif [[ "$machine" = "Jet" ]]; then - topts[1]="0:15:00" ; popts[1]="5/4/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="10/4/" ; ropts[2]="/1" - elif [[ "$machine" = "gaeac5" ]]; then - topts[1]="0:15:00" ; popts[1]="32/2/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="64/4/" ; ropts[2]="/1" elif [[ "$machine" = "gaeac6" ]]; then topts[1]="0:15:00" ; popts[1]="64/1/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="128/2/" ; ropts[2]="/1" @@ -227,12 +187,6 @@ case $regtest in elif [[ "$machine" = "Hercules" ]]; then topts[1]="0:05:00" ; popts[1]="40/2/" ; ropts[1]="/1" topts[2]="0:05:00" ; popts[2]="40/4/" ; ropts[2]="/1" - elif [[ "$machine" = "Jet" ]]; then - topts[1]="0:15:00" ; popts[1]="4/4/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="6/6/" ; ropts[2]="/1" - elif [[ "$machine" = "gaeac5" ]]; then - topts[1]="0:15:00" ; popts[1]="40/2/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="40/4/" ; ropts[2]="/1" elif [[ "$machine" = "gaeac6" ]]; then topts[1]="0:15:00" ; popts[1]="64/1/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="64/2/" ; ropts[2]="/1" @@ -263,12 +217,6 @@ case $regtest in elif [[ "$machine" = "Hercules" ]]; then topts[1]="0:30:00" ; popts[1]="6/12/" ; ropts[1]="/1" topts[2]="0:30:00" ; popts[2]="8/12/" ; ropts[2]="/1" - elif [[ "$machine" = "Jet" ]]; then - topts[1]="0:30:00" ; popts[1]="6/12/" ; ropts[1]="/1" - topts[2]="0:30:00" ; popts[2]="8/12/" ; ropts[2]="/1" - elif [[ "$machine" = "gaeac5" ]]; then - topts[1]="0:30:00" ; popts[1]="14/8/" ; ropts[1]="/1" - topts[2]="0:30:00" ; popts[2]="14/14/" ; ropts[2]="/1" elif [[ "$machine" = "gaeac6" ]]; then topts[1]="0:30:00" ; popts[1]="14/8/" ; ropts[1]="/1" topts[2]="0:30:00" ; popts[2]="14/14/" ; ropts[2]="/1" @@ -299,12 +247,6 @@ case $regtest in elif [[ "$machine" = "Hercules" ]]; then topts[1]="0:10:00" ; popts[1]="12/3/" ; ropts[1]="/1" topts[2]="0:10:00" ; popts[2]="12/5/" ; ropts[2]="/2" - elif [[ "$machine" = "Jet" ]]; then - topts[1]="0:10:00" ; popts[1]="12/3/" ; ropts[1]="/1" - topts[2]="0:10:00" ; popts[2]="12/5/" ; ropts[2]="/2" - elif [[ "$machine" = "gaeac5" ]]; then - topts[1]="0:10:00" ; popts[1]="12/3/" ; ropts[1]="/1" - topts[2]="0:10:00" ; popts[2]="12/5/" ; ropts[2]="/2" elif [[ "$machine" = "gaeac6" ]]; then topts[1]="0:10:00" ; popts[1]="16/2/" ; ropts[1]="/1" topts[2]="0:10:00" ; popts[2]="16/4/" ; ropts[2]="/2" @@ -365,19 +307,6 @@ elif [[ "$machine" = "Orion" ]]; then elif [[ "$machine" = "Hercules" ]]; then export OMP_STACKSIZE=2048M export APRUN="srun -n \$ntasks --mem=0 --cpus-per-task=\$threads" -elif [[ "$machine" = "Jet" ]]; then - export OMP_STACKSIZE=1024M - export MPI_BUFS_PER_PROC=256 - export MPI_BUFS_PER_HOST=256 - export MPI_GROUP_MAX=256 - export APRUN="srun -n \$ntasks --cpus-per-task=\$threads" -elif [[ "$machine" = "gaeac5" ]]; then - export OMP_STACKSIZE=1024M - export MPI_BUFS_PER_PROC=256 - export MPI_BUFS_PER_HOST=256 - export MPI_GROUP_MAX=256 - export FI_VERBS_PREFER_XRC=0 - export APRUN="srun --export=ALL -n \$ntasks" elif [[ "$machine" = "gaeac6" ]]; then export OMP_STACKSIZE=1024M export MPI_BUFS_PER_PROC=256 @@ -390,6 +319,4 @@ elif [[ "$machine" = "wcoss2" || "$machine" = "acorn" ]]; then export FORT_BUFFERED=true export FI_OFI_RXM_SAR_LIMIT=3145728 export APRUN="mpiexec -n \$ntasks -ppn \$ppn --cpu-bind core --depth \$threads" -elif [[ "$machine" = "Discover" ]]; then - export APRUN="mpiexec_mpt -np \$SLURM_NTASKS" fi diff --git a/regression/regression_var.sh b/regression/regression_var.sh index 06aaa7885..dd019a1e9 100755 --- a/regression/regression_var.sh +++ b/regression/regression_var.sh @@ -37,16 +37,8 @@ if [[ -d /scratch3 ]]; then # Hera or Ursa else export machine="Hera" fi -elif [[ -d /mnt/lfs4 || -d /jetmon || -d /mnt/lfs5 ]]; then # Jet - export machine="Jet" -elif [[ -d /discover ]]; then # NCCS Discover - export machine="Discover" -elif [[ -d /gpfs/f5 ]]; then # GaeaC5 - export machine="gaeac5" elif [[ -d /gpfs/f6 ]]; then # GaeaC6 export machine="gaeac6" -elif [[ -d /data/prod ]]; then # S4 - export machine="S4" elif [[ -d /work ]]; then # Orion or Hercules mount=$(findmnt -n -o SOURCE /home) if [[ ${mount} =~ "hercules" ]]; then @@ -64,22 +56,12 @@ fi echo "Running Regression Tests on '$machine'"; case $machine in - gaeac5) - export queue="normal" - export group="nggps_emc" - export noscrub="/gpfs/f5/${group}/scratch/${USER}/$LOGNAME/gsi_tmp/noscrub" - export ptmp="/gpfs/f5/${group}/scratch/${USER}/$LOGNAME/gsi_tmp/ptmp" - export casesdir="/gpfs/f5/ufs-ard/world-shared/GSI_data/CASES/regtest" - - export check_resource="no" - export accnt="nggps_emc" - ;; gaeac6) export queue="normal" export group="ira-sti" export noscrub="/gpfs/f6/${group}/scratch/${USER}/${LOGNAME}/gsi_tmp/noscrub" export ptmp="/gpfs/f6/${group}/scratch/${USER}/${LOGNAME}/gsi_tmp/ptmp" - export casesdir="/gpfs/f6/bil-fire8/world-shared/GSI_data/CASES/regtest" + export casesdir="/gpfs/f6/ira-sti/world-shared/Russ.Treadon/CASES/regtest" export check_resource="no" export accnt="ira-sti" @@ -103,7 +85,7 @@ case $machine in export check_resource="no" export accnt="${accnt:-GFS-DEV}" - ;; + ;; Orion | Hercules) export local_or_default="${local_or_default:-/work/noaa/da/$LOGNAME}" if [ -d $local_or_default ]; then @@ -130,7 +112,7 @@ case $machine in export check_resource="no" export accnt="${accnt:-da-cpu}" - ;; + ;; Hera) export local_or_default="${local_or_default:-/scratch1/NCEPDEV/da/$LOGNAME}" @@ -187,39 +169,7 @@ case $machine in # After completion of regression tests, will remove the regression test subdirecories export clean=".false." ;; - - Jet) - - export noscrub=/lfs5/HFIP/emcda/$LOGNAME/noscrub - export ptmp=/lfs5/HFIP/emcda/$LOGNAME/ptmp - export casesdir="/lfs5/NESDIS/nesdis-rdo2/David.Huber/save/CASES/regtest" - export check_resource="no" - export accnt="hfv3gfs" - - export group="global" - export queue="batch" - if [[ "$cmaketest" = "false" ]]; then - export basedir="/lfs5/NESDIS/nesdis-rdo2/$LOGNAME/save/git/gsi" - fi - # On Jet, there are no scrubbers to remove old contents from stmp* directories. - # After completion of regression tests, will remove the regression test subdirecories - export clean=".true." - ;; - Discover) - if [[ "$cmaketest" = "false" ]]; then - echo "Regression tests on Discover need to be run via ctest" - exit 1 - fi - export ptmp=$basedir - export ptmp=$basedir - export noscrub=$basedir - export casesdir="/discover/nobackup/projects/gmao/obsdev/wrmccart/NCEP_regression/CASES" - export check_resource="no" - export accnt="g0613" - export queue="compute" - export clean=".false." - ;; *) echo "Regression tests are not setup on '$machine', ABORT!" exit 1 diff --git a/src/enkf/CMakeLists.txt b/src/enkf/CMakeLists.txt index 907f0c2de..4d4ba5e5c 100644 --- a/src/enkf/CMakeLists.txt +++ b/src/enkf/CMakeLists.txt @@ -65,7 +65,7 @@ find_package(sigio REQUIRED) find_package(sfcio REQUIRED) find_package(nemsio REQUIRED) find_package(ncio REQUIRED) -find_package(sp REQUIRED) +find_package(ip REQUIRED) find_package(w3emc REQUIRED) if(ENKF_MODE MATCHES "^(WRF|NMMB|FV3REG)$") find_package(wrf_io REQUIRED) @@ -112,7 +112,7 @@ target_link_libraries(enkf_fortran_obj PUBLIC sfcio::sfcio) target_link_libraries(enkf_fortran_obj PUBLIC nemsio::nemsio) target_link_libraries(enkf_fortran_obj PUBLIC ncio::ncio) target_link_libraries(enkf_fortran_obj PUBLIC w3emc::w3emc_d) -target_link_libraries(enkf_fortran_obj PUBLIC sp::sp_d) +target_link_libraries(enkf_fortran_obj PUBLIC ip::ip_d) if(OpenMP_Fortran_FOUND) target_link_libraries(enkf_fortran_obj PRIVATE OpenMP::OpenMP_Fortran) endif() diff --git a/src/enkf/specmod.f90 b/src/enkf/specmod.f90 index 4d8037691..6ef9481a1 100644 --- a/src/enkf/specmod.f90 +++ b/src/enkf/specmod.f90 @@ -6,12 +6,12 @@ module specmod ! ! abstract: module containing spectral related variables ! -! program history log: +! program history log: ! 2003-11-24 treadon ! 2004-04-28 d. kokron, updated SGI's fft to use scsl ! 2004-05-18 kleist, documentation -! 2004-08-27 treadon - add/initialize variables/arrays needed by -! splib routines for grid <---> spectral +! 2004-08-27 treadon - add/initialize variables/arrays needed by +! splib routines for grid <---> spectral ! transforms ! 2008-02-01 whitaker - modifications for use in ensemble kalman filter. ! 2010-10-27 whitaker - made thread safe (can now be called within OMP parallel regions). @@ -42,6 +42,7 @@ module specmod ! !$$$ use kinds, only: r_kind,i_kind + use sp_mod, only: sptranf0,splat,sptranf1,spdz2uv,spuv2dz implicit none integer(i_kind) jcap @@ -55,7 +56,7 @@ module specmod logical :: isinitialized=.false. contains - + subroutine init_spec_vars(nlon,nlat,jcapin,idrtin) ! Declare passed variables @@ -92,8 +93,8 @@ subroutine init_spec_vars(nlon,nlat,jcapin,idrtin) allocate( glats(jmax) ) allocate( gwts(jmax) ) allocate( clat(jb:je) ) - allocate( slat(jb:je) ) - allocate( wlat(jb:je) ) + allocate( slat(jb:je) ) + allocate( wlat(jb:je) ) allocate( pln(ncd2,jb:je) ) allocate( plntop(jcap+1,jb:je) ) @@ -105,7 +106,7 @@ subroutine init_spec_vars(nlon,nlat,jcapin,idrtin) gaulats = glats gauwts = gwts asin_gaulats=asin(gaulats) - + isinitialized = .true. end subroutine init_spec_vars @@ -133,9 +134,9 @@ subroutine sptez_s(wave,grid,idir) ! subprogram can be called from a multiprocessing environment. ! ! This routine differs from splib routine sptez in that -! 1) the calling list only contains the in/out arrays and +! 1) the calling list only contains the in/out arrays and ! flag for the direction in which to transform -! 2) it calls a version of sptranf that does not invoke +! 2) it calls a version of sptranf that does not invoke ! initialization routines on each entry ! 3) some generality built into the splib version is ! removed in the code below @@ -249,9 +250,9 @@ subroutine sptranf_s(wave,gridn,grids,idir) ! ! subprograms called: ! sptranf1 sptranf spectral transform -! -! remarks: -! This routine assumes that splib routine sptranf0 has been +! +! remarks: +! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. ! @@ -488,7 +489,7 @@ subroutine sptranf_v(waved,wavez,gridun,gridus,gridvn,gridvs,idir) ! spdz2uv compute winds from divergence and vorticity ! spuv2dz compute divergence and vorticity from winds ! -! remarks: +! remarks: ! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. @@ -516,7 +517,7 @@ subroutine sptranf_v(waved,wavez,gridun,gridus,gridvn,gridvs,idir) ! Declare local variables integer(i_kind) i,j,jj,ijn,ijs - integer(i_kind),dimension(2):: mp + integer(i_kind) :: mp real(8) wavedtmp(nc),waveztmp(nc) real(8),dimension(ncd2*2,2):: w real(8),dimension(2*(jcap+1),2):: wtop @@ -553,7 +554,7 @@ subroutine sptranf_v(waved,wavez,gridun,gridus,gridvn,gridvs,idir) gridus(ijs)=g(i,2,1) gridvn(ijn)=g(i,1,2) gridvs(ijs)=g(i,2,2) - + enddo enddo diff --git a/src/enkf/specmod_splib.f90 b/src/enkf/specmod_splib.f90 index 4d8037691..e7617896e 100644 --- a/src/enkf/specmod_splib.f90 +++ b/src/enkf/specmod_splib.f90 @@ -6,12 +6,12 @@ module specmod ! ! abstract: module containing spectral related variables ! -! program history log: +! program history log: ! 2003-11-24 treadon ! 2004-04-28 d. kokron, updated SGI's fft to use scsl ! 2004-05-18 kleist, documentation -! 2004-08-27 treadon - add/initialize variables/arrays needed by -! splib routines for grid <---> spectral +! 2004-08-27 treadon - add/initialize variables/arrays needed by +! splib routines for grid <---> spectral ! transforms ! 2008-02-01 whitaker - modifications for use in ensemble kalman filter. ! 2010-10-27 whitaker - made thread safe (can now be called within OMP parallel regions). @@ -42,6 +42,7 @@ module specmod ! !$$$ use kinds, only: r_kind,i_kind + use sp_mod, only: sptranf1, spdz2uv, spuv2dz implicit none integer(i_kind) jcap @@ -55,7 +56,7 @@ module specmod logical :: isinitialized=.false. contains - + subroutine init_spec_vars(nlon,nlat,jcapin,idrtin) ! Declare passed variables @@ -92,8 +93,8 @@ subroutine init_spec_vars(nlon,nlat,jcapin,idrtin) allocate( glats(jmax) ) allocate( gwts(jmax) ) allocate( clat(jb:je) ) - allocate( slat(jb:je) ) - allocate( wlat(jb:je) ) + allocate( slat(jb:je) ) + allocate( wlat(jb:je) ) allocate( pln(ncd2,jb:je) ) allocate( plntop(jcap+1,jb:je) ) @@ -105,7 +106,7 @@ subroutine init_spec_vars(nlon,nlat,jcapin,idrtin) gaulats = glats gauwts = gwts asin_gaulats=asin(gaulats) - + isinitialized = .true. end subroutine init_spec_vars @@ -133,9 +134,9 @@ subroutine sptez_s(wave,grid,idir) ! subprogram can be called from a multiprocessing environment. ! ! This routine differs from splib routine sptez in that -! 1) the calling list only contains the in/out arrays and +! 1) the calling list only contains the in/out arrays and ! flag for the direction in which to transform -! 2) it calls a version of sptranf that does not invoke +! 2) it calls a version of sptranf that does not invoke ! initialization routines on each entry ! 3) some generality built into the splib version is ! removed in the code below @@ -249,9 +250,9 @@ subroutine sptranf_s(wave,gridn,grids,idir) ! ! subprograms called: ! sptranf1 sptranf spectral transform -! -! remarks: -! This routine assumes that splib routine sptranf0 has been +! +! remarks: +! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. ! @@ -488,7 +489,7 @@ subroutine sptranf_v(waved,wavez,gridun,gridus,gridvn,gridvs,idir) ! spdz2uv compute winds from divergence and vorticity ! spuv2dz compute divergence and vorticity from winds ! -! remarks: +! remarks: ! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. @@ -553,7 +554,7 @@ subroutine sptranf_v(waved,wavez,gridun,gridus,gridvn,gridvs,idir) gridus(ijs)=g(i,2,1) gridvn(ijn)=g(i,1,2) gridvs(ijs)=g(i,2,2) - + enddo enddo diff --git a/src/gsi/CMakeLists.txt b/src/gsi/CMakeLists.txt index 9f20bed60..403661eed 100644 --- a/src/gsi/CMakeLists.txt +++ b/src/gsi/CMakeLists.txt @@ -30,7 +30,6 @@ option(OPENMP "Enable OpenMP Threading" OFF) option(ENABLE_MKL "Use MKL for LAPACK implementation (if available)" ON) option(USE_GSDCLOUD "Use GSD Cloud Analysis library" OFF) option(USE_MGBF "Use MGBF library" ON) -option(USE_BUFR12 "Use BUFR12 library" OFF) set(GSI_VALID_MODES "GFS" "Regional") set(GSI_MODE "GFS" CACHE STRING "Choose the GSI Application.") @@ -47,7 +46,6 @@ message(STATUS "GSI: ENABLE_MKL ............. ${ENABLE_MKL}") message(STATUS "GSI: USE_GSDCLOUD ........... ${USE_GSDCLOUD}") message(STATUS "GSI: USE_MGBF ............... ${USE_MGBF}") message(STATUS "GSI: GSI_MODE ............... ${GSI_MODE}") -message(STATUS "GSI: USE_BUFR12 ............. ${USE_BUFR12}") # Dependencies if(ENABLE_MKL) @@ -72,7 +70,6 @@ find_package(sfcio REQUIRED) find_package(nemsio REQUIRED) find_package(ncio REQUIRED) find_package(ncdiag REQUIRED) -find_package(sp REQUIRED) find_package(ip REQUIRED) find_package(w3emc REQUIRED) find_package(bufr REQUIRED) @@ -134,9 +131,6 @@ endif() if(USE_GSDCLOUD) list(APPEND GSI_Fortran_defs RR_CLOUDANALYSIS) endif() -if(USE_BUFR12) - list(APPEND GSI_Fortran_defs BUFR12) -endif() # Create a library of GSI C sources add_library(gsi_c_obj OBJECT ${GSI_SRC_C}) @@ -159,12 +153,8 @@ target_link_libraries(gsi_fortran_obj PUBLIC sfcio::sfcio) target_link_libraries(gsi_fortran_obj PUBLIC nemsio::nemsio) target_link_libraries(gsi_fortran_obj PUBLIC ncio::ncio) target_link_libraries(gsi_fortran_obj PUBLIC w3emc::w3emc_d) -target_link_libraries(gsi_fortran_obj PUBLIC sp::sp_d) -if(DEFINED ENV{USE_BUFR4} OR USE_BUFR12 ) - target_link_libraries(gsi_fortran_obj PUBLIC bufr::bufr_4) -else() - target_link_libraries(gsi_fortran_obj PUBLIC bufr::bufr_d) -endif() +target_link_libraries(gsi_fortran_obj PUBLIC ip::ip_d) +target_link_libraries(gsi_fortran_obj PUBLIC bufr::bufr_4) target_link_libraries(gsi_fortran_obj PUBLIC crtm::crtm) if(GSI_MODE MATCHES "Regional") target_link_libraries(gsi_fortran_obj PUBLIC wrf_io::wrf_io) diff --git a/src/gsi/general_specmod.f90 b/src/gsi/general_specmod.f90 index 439e26e43..e5b823043 100644 --- a/src/gsi/general_specmod.f90 +++ b/src/gsi/general_specmod.f90 @@ -7,16 +7,16 @@ module general_specmod ! abstract: copy of specmod, introducing structure variable spec_vars, so ! spectral code can be used for arbitrary resolutions. ! -! program history log: +! program history log: ! 2003-11-24 treadon ! 2004-04-28 d. kokron, updated SGI's fft to use scsl ! 2004-05-18 kleist, documentation -! 2004-08-27 treadon - add/initialize variables/arrays needed by -! splib routines for grid <---> spectral +! 2004-08-27 treadon - add/initialize variables/arrays needed by +! splib routines for grid <---> spectral ! transforms ! 2007-04-26 yang - based on idrt value xxxx descriptionxxx ! 2010-02-18 parrish - copy specmod to general_specmod and add structure variable spec_vars. -! remove all *_b variables, since now not necessary to have two +! remove all *_b variables, since now not necessary to have two ! resolutions. any number of resolutions can be now contained in ! type(spec_vars) variables passed in through init_spec_vars. also ! remove init_spec, since not really necessary. @@ -127,7 +127,7 @@ subroutine general_init_spec_vars(sp,jcap,jcap_test,nlat_a,nlon_a,eqspace) ! program history log: ! 2003-11-24 treadon ! 2004-05-18 kleist, new variables and documentation -! 2004-08-27 treadon - add call to sptranf0 and associated arrays, +! 2004-08-27 treadon - add call to sptranf0 and associated arrays, ! remove del21 and other unused arrays/variables ! 2006-04-06 middlecoff - remove jc=ncpus() since not used ! 2008-04-11 safford - rm unused vars @@ -137,7 +137,7 @@ subroutine general_init_spec_vars(sp,jcap,jcap_test,nlat_a,nlon_a,eqspace) ! 2013-10-23 el akkraoui - initialize lats to zero (otherwise point is undefined) ! ! input argument list: -! sp - type(spec_vars) variable +! sp - type(spec_vars) variable ! jcap - target resolution ! jcap_test - test resolution, used to construct mask which will zero out coefs ! with total wavenumber n in range jcap_test < n <= jcap @@ -154,6 +154,7 @@ subroutine general_init_spec_vars(sp,jcap,jcap_test,nlat_a,nlon_a,eqspace) ! !$$$ use constants, only: zero,half,one,two,pi,three + use sp_mod, only: splat, spffte, spwget, splegend implicit none ! Declare passed variables @@ -161,13 +162,15 @@ subroutine general_init_spec_vars(sp,jcap,jcap_test,nlat_a,nlon_a,eqspace) integer(i_kind) ,intent(in ) :: jcap,jcap_test,nlat_a,nlon_a logical,optional,intent(in ) :: eqspace -! Declare local variables +! Declare local variables integer(i_kind) i,ii1,j,l,m,jhe,n integer(i_kind) :: ldafft real(r_kind) :: dlon_a,half_pi,two_pi real(r_kind),dimension(nlat_a-2) :: wlatx,slatx real(r_kind) :: epsi0(0:jcap) ! epsilon factor for m=0 real(r_kind) :: fnum, fden + real(r_kind), dimension(:, :), allocatable :: dummy_w + real(r_kind), dimension(:, :), allocatable :: dummy_g ! Set constants used in transforms for analysis grid sp%jcap=jcap @@ -191,7 +194,6 @@ subroutine general_init_spec_vars(sp,jcap,jcap_test,nlat_a,nlon_a,eqspace) sp%je=(sp%jmax+1)/2 - ! Allocate and initialize fact arrays if(sp%lallocated) then deallocate(sp%factsml,sp%factvml,sp%eps,sp%epstop,sp%enn1,sp%elonn1,sp%eon,sp%eontop) @@ -229,11 +231,17 @@ subroutine general_init_spec_vars(sp,jcap,jcap_test,nlat_a,nlon_a,eqspace) ldafft=50000+4*sp%imax ! ldafft=256+imax would be sufficient at GMAO. allocate( sp%afft(ldafft)) allocate( sp%clat(sp%jb:sp%je) ) - allocate( sp%slat(sp%jb:sp%je) ) - allocate( sp%wlat(sp%jb:sp%je) ) + allocate( sp%slat(sp%jb:sp%je) ) + allocate( sp%wlat(sp%jb:sp%je) ) call spwget(sp%iromb,sp%jcap,sp%eps,sp%epstop,sp%enn1, & sp%elonn1,sp%eon,sp%eontop) - call spffte(sp%imax,(sp%imax+2)/2,sp%imax,2,0.,0.,0,sp%afft) +! Allocate dummy_w and dummy_g arrays for spffte (unused, but required by spffte) + allocate(dummy_w((sp%imax+2)/2,2), dummy_g(sp%imax,2)) + dummy_w=zero + dummy_g=zero + call spffte(sp%imax,(sp%imax+2)/2,sp%imax,2,dummy_w,dummy_g,0,sp%afft) + if(allocated(dummy_w)) deallocate(dummy_w) + if(allocated(dummy_g)) deallocate(dummy_g) call splat(sp%idrt,sp%jmax,slatx,wlatx) jhe=(sp%jmax+1)/2 if(jhe > sp%jmax/2)wlatx(jhe)=wlatx(jhe)/2 @@ -248,14 +256,14 @@ subroutine general_init_spec_vars(sp,jcap,jcap_test,nlat_a,nlon_a,eqspace) allocate( sp%plntop(sp%jcap+1,sp%jb:sp%je) ) do j=sp%jb,sp%je call splegend(sp%iromb,sp%jcap,sp%slat(j),sp%clat(j),sp%eps, & - sp%epstop,sp%pln(1,j),sp%plntop(1,j)) + sp%epstop,sp%pln(:,j),sp%plntop(:,j)) end do else sp%precalc_pln=.false. allocate( sp%pln(sp%ncd2,1) ) allocate( sp%plntop(sp%jcap+1,1) ) end if - + ! obtain rlats and rlons half_pi=half*pi two_pi=two*pi diff --git a/src/gsi/general_transform.f90 b/src/gsi/general_transform.f90 index 8f1af2084..8645a7e0b 100644 --- a/src/gsi/general_transform.f90 +++ b/src/gsi/general_transform.f90 @@ -16,9 +16,9 @@ subroutine general_sptez_s(sp,wave,grid,idir) ! subprogram can be called from a multiprocessing environment. ! ! This routine differs from splib routine sptez in that -! 1) the calling list only contains the in/out arrays and +! 1) the calling list only contains the in/out arrays and ! flag for the direction in which to transform -! 2) it calls a version of sptranf that does not invoke +! 2) it calls a version of sptranf that does not invoke ! initialization routines on each entry ! 3) some generality built into the splib version is ! removed in the code below @@ -142,9 +142,9 @@ subroutine general_sptranf_s(sp_a,wave,grid,idir) ! ! subprograms called: ! sptranf1 sptranf spectral transform -! -! remarks: -! This routine assumes that splib routine sptranf0 has been +! +! remarks: +! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. ! @@ -167,6 +167,7 @@ subroutine general_sptranf_s(sp_a,wave,grid,idir) use kinds, only: r_kind,i_kind use constants, only: zero use general_specmod, only: spec_vars + use sp_mod, only: spffte,spsynth,spanaly implicit none ! Declare passed variables @@ -181,25 +182,27 @@ subroutine general_sptranf_s(sp_a,wave,grid,idir) real(r_kind),dimension(sp_a%imax,2):: g real(r_kind),dimension(sp_a%imax+2,2):: f real(r_kind),dimension(50000+4*sp_a%imax):: tmpafft + integer(i_kind), dimension(1) :: a_mp ! Initialize local variables mp=0 + a_mp=0 do i=1,2*(sp_a%jcap+1) wtop(i)=zero end do ! Transform wave to grid -! ***NOTE*** +! ***NOTE*** ! The FFT used in the transform below has been generalized to -! allow for projection of spectral coefficients onto double -! the desired number of longitudinal grid points. This -! approach is needed when transforming high wavenumber spectral -! coefficients to a coarser resoultion grid. For example, using -! splib to directly transform T878 spectral coefficients to an +! allow for projection of spectral coefficients onto double +! the desired number of longitudinal grid points. This +! approach is needed when transforming high wavenumber spectral +! coefficients to a coarser resoultion grid. For example, using +! splib to directly transform T878 spectral coefficients to an ! 1152 x 576 grid does not use Fourier modes above wavenumber 576. -! Joe Sela insightfully suggested doubling the number of points -! in the FFT and using every other point in the output grid. +! Joe Sela insightfully suggested doubling the number of points +! in the FFT and using every other point in the output grid. ! Mark Iredell coded up Joe's idea below. tmpafft(:)=sp_a%afft(:) @@ -209,7 +212,7 @@ subroutine general_sptranf_s(sp_a,wave,grid,idir) if(idir>0) then do j=sp_a%jb,sp_a%je call spsynth(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_a%pln(1,j),sp_a%plntop(1,j),0,wave,wtop,f) + sp_a%clat(j),sp_a%pln(:,j),sp_a%plntop(:,j),a_mp,wave,wtop,f) call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & @@ -231,8 +234,8 @@ subroutine general_sptranf_s(sp_a,wave,grid,idir) ! high spectral representation fields to coarse physical space ! grids. The code below should not be used to transform coarse ! resolution grids to high spectral representation. Since this -! functionality is not yet needed in the GSI, the prudent action -! to take here is to print an ERROR message and terminate program +! functionality is not yet needed in the GSI, the prudent action +! to take here is to print an ERROR message and terminate program ! execution if such a transform is requested. else @@ -248,7 +251,7 @@ subroutine general_sptranf_s(sp_a,wave,grid,idir) enddo call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,-1,tmpafft) call spanaly(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%wlat(j),sp_a%clat(j),sp_a%pln(1,j),sp_a%plntop(1,j),0,f,wave,wtop) + sp_a%wlat(j),sp_a%clat(j),sp_a%pln(:,j),sp_a%plntop(:,j),a_mp,f,wave,wtop) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & ! tmpafft,sp_a%clat(j),sp_a%slat(j),sp_a%wlat(j), & @@ -309,9 +312,9 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) ! ! subprograms called: ! sptranf1 sptranf spectral transform -! -! remarks: -! This routine assumes that splib routine sptranf0 has been +! +! remarks: +! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. ! @@ -334,6 +337,7 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) use kinds, only: r_kind,i_kind use constants, only: zero use general_specmod, only: spec_vars + use sp_mod, only: spffte,spsynth,spanaly,splegend implicit none ! Declare passed variables @@ -345,6 +349,7 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) ! Declare local variables integer(i_kind) i,j,ii,jj,ijn,ijs,mp,ifact,kw,kwtop,imaxp2 + integer(i_kind), dimension(1) :: a_mp real(r_kind),dimension(2*(sp_b%jcap+1)):: wtop real(r_kind),dimension(sp_b%imax,2):: g real(r_kind),dimension(sp_b%imax+2,2):: f @@ -354,6 +359,7 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) ! Initialize local variables mp=0 + a_mp=0 ifact = sp_b%imax/sp_a%imax do i=1,2*(sp_b%jcap+1) wtop(i)=zero @@ -363,16 +369,16 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) imaxp2=sp_b%imax+2 ! Transform wave to grid -! ***NOTE*** +! ***NOTE*** ! The FFT used in the transform below has been generalized to -! allow for projection of spectral coefficients onto double -! the desired number of longitudinal grid points. This -! approach is needed when transforming high wavenumber spectral -! coefficients to a coarser resoultion grid. For example, using -! splib to directly transform T878 spectral coefficients to an +! allow for projection of spectral coefficients onto double +! the desired number of longitudinal grid points. This +! approach is needed when transforming high wavenumber spectral +! coefficients to a coarser resoultion grid. For example, using +! splib to directly transform T878 spectral coefficients to an ! 1152 x 576 grid does not use Fourier modes above wavenumber 576. -! Joe Sela insightfully suggested doubling the number of points -! in the FFT and using every other point in the output grid. +! Joe Sela insightfully suggested doubling the number of points +! in the FFT and using every other point in the output grid. ! Mark Iredell coded up Joe's idea below. if(idir>0) then @@ -381,7 +387,7 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) do j=sp_a%jb,sp_a%je tmpafft(:)=sp_b%afft(:) call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_b%pln(1,j),sp_b%plntop(1,j),0,wave,wtop,f) + sp_a%clat(j),sp_b%pln(:,j),sp_b%plntop(:,j),a_mp,wave,wtop,f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -404,7 +410,7 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) call splegend(sp_b%iromb,sp_b%jcap,sp_b%slat(j),sp_b%clat(j),sp_b%eps,& sp_b%epstop,tmppln,tmpplntop) call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),tmppln,tmpplntop,0,wave,wtop,f) + sp_a%clat(j),tmppln,tmpplntop,a_mp,wave,wtop,f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -428,8 +434,8 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) ! high spectral representation fields to coarse physical space ! grids. The code below should not be used to transform coarse ! resolution grids to high spectral representation. Since this -! functionality is not yet needed in the GSI, the prudent action -! to take here is to print an ERROR message and terminate program +! functionality is not yet needed in the GSI, the prudent action +! to take here is to print an ERROR message and terminate program ! execution if such a transform is requested. else @@ -451,7 +457,7 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) enddo call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,-1,tmpafft) call spanaly(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%wlat(j),sp_a%clat(j),sp_a%pln(1,j),sp_a%plntop(1,j),0,f,wave,wtop) + sp_a%wlat(j),sp_a%clat(j),sp_a%pln(:,j),sp_a%plntop(:,j),a_mp,f,wave,wtop) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & ! tmpafft,sp_a%clat(j),sp_a%slat(j),sp_a%wlat(j), & @@ -473,7 +479,7 @@ subroutine general_sptranf_s_b(sp_a,sp_b,wave,grid,idir) sp_a%epstop,tmppln,tmpplntop) call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,-1,tmpafft) call spanaly(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%wlat(j),sp_a%clat(j),sp_a%pln(1,j),sp_a%plntop(1,j),0,f,wave,wtop) + sp_a%wlat(j),sp_a%clat(j),sp_a%pln(:,j),sp_a%plntop(:,j),a_mp,f,wave,wtop) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & ! tmpafft,sp_a%clat(j),sp_a%slat(j),sp_a%wlat(j), & @@ -516,7 +522,7 @@ subroutine general_sptez_v(sp,waved,wavez,gridu,gridv,idir) ! 1996-02-29 iredell ! 2004-08-23 treadon - adapt splib routine sptezv for gsi use ! 2007-04-25 errico - replace use of duplicate arguments in sptranf_v -! 2008-04-03 safford - rm unused vars +! 2008-04-03 safford - rm unused vars ! 2010-02-18 parrish - copy to general_sptez_v, and pass specmod vars through ! input variable sp of type(spec_vars) ! @@ -649,7 +655,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) ! spdz2uv compute winds from divergence and vorticity ! spuv2dz compute divergence and vorticity from winds ! -! remarks: +! remarks: ! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. @@ -673,6 +679,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) use kinds, only: r_kind,i_kind use constants, only: zero use general_specmod, only: spec_vars + use sp_mod, only: spffte,spsynth,spanaly,splegend,spdz2uv,spuv2dz implicit none ! Declare passed variables @@ -685,7 +692,8 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) ! Declare local variables integer(i_kind) i,j,ii,jj,ijn,ijs,ifact,kw,kwtop,imaxp2 - integer(i_kind),dimension(2):: mp + integer(i_kind) :: mp + integer(i_kind), dimension(1) :: a_mp real(r_kind),dimension(sp_b%ncd2*2,2):: w real(r_kind),dimension(2*(sp_b%jcap+1),2):: wtop real(r_kind),dimension(sp_b%imax,2):: g @@ -697,6 +705,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) ! Set parameters mp=1 + a_mp=1 ifact = sp_b%imax/sp_a%imax kw=(sp_b%jcap+1)*((sp_b%iromb+1)*sp_b%jcap+2) kwtop=2*(sp_b%jcap+1) @@ -724,7 +733,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) do j=sp_a%jb,sp_a%je tmpafft(:)=sp_b%afft(:) call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_b%pln(1,j),sp_b%plntop(1,j),mp,w(1,1),wtop(1,1),f) + sp_a%clat(j),sp_b%pln(:,j),sp_b%plntop(:,j),a_mp,w(1,1),wtop(1,1),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -740,7 +749,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) gridu(ijs+i)=g(ii,2) enddo call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_b%pln(1,j),sp_b%plntop(1,j),mp,w(1,2),wtop(1,2),f) + sp_a%clat(j),sp_b%pln(:,j),sp_b%plntop(:,j),a_mp,w(1,2),wtop(1,2),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -760,7 +769,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) call splegend(sp_b%iromb,sp_b%jcap,sp_b%slat(j),sp_b%clat(j),sp_b%eps,& sp_b%epstop,tmppln,tmpplntop) call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),tmppln,tmpplntop,mp,w(1,1),wtop(1,1),f) + sp_a%clat(j),tmppln,tmpplntop,a_mp,w(1,1),wtop(1,1),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -776,7 +785,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) gridu(ijs+i)=g(ii,2) enddo call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),tmppln,tmpplntop,mp,w(1,2),wtop(1,2),f) + sp_a%clat(j),tmppln,tmpplntop,a_mp,w(1,2),wtop(1,2),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -821,7 +830,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) enddo call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,-1,tmpafft) call spanaly(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%wlat(j),sp_a%clat(j),sp_a%pln(1,j),sp_a%plntop(1,j),mp,f, & + sp_a%wlat(j),sp_a%clat(j),sp_a%pln(:,j),sp_a%plntop(:,j),a_mp,f, & w(1,1),wtop(1,1)) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & @@ -834,7 +843,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) enddo call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,-1,tmpafft) call spanaly(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%wlat(j),sp_a%clat(j),sp_a%pln(1,j),sp_a%plntop(1,j),mp,f, & + sp_a%wlat(j),sp_a%clat(j),sp_a%pln(:,j),sp_a%plntop(:,j),a_mp,f, & w(1,2),wtop(1,2)) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & @@ -847,7 +856,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) do j=sp_a%jb,sp_a%je if(sp_a%wlat(j)>zero) then call splegend(sp_a%iromb,sp_a%jcap,sp_a%slat(j),sp_a%clat(j),sp_a%eps,& - sp_a%epstop,sp_a%pln(1,1),sp_a%plntop(1,1)) + sp_a%epstop,sp_a%pln(:,1),sp_a%plntop(:,1)) jj = j-sp_a%jb ijn = jj*sp_a%jn ijs = jj*sp_a%js + sp_a%ioffset @@ -857,7 +866,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) enddo call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,-1,tmpafft) call spanaly(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%wlat(j),sp_a%clat(j),sp_a%pln(1,1),sp_a%plntop(1,1),mp,f, & + sp_a%wlat(j),sp_a%clat(j),sp_a%pln(:,1),sp_a%plntop(:,1),a_mp,f, & w(1,1),wtop(1,1)) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & @@ -870,7 +879,7 @@ subroutine general_sptranf_v(sp_a,sp_b,waved,wavez,gridu,gridv,idir) enddo call spffte(sp_a%imax,imaxp2/2,sp_a%imax,2,f,g,-1,tmpafft) call spanaly(sp_a%iromb,sp_a%jcap,sp_a%imax,imaxp2,kw,kwtop,1, & - sp_a%wlat(j),sp_a%clat(j),sp_a%pln(1,1),sp_a%plntop(1,1),mp,f, & + sp_a%wlat(j),sp_a%clat(j),sp_a%pln(:,1),sp_a%plntop(:,1),a_mp,f, & w(1,2),wtop(1,2)) ! call sptranf1(sp_a%iromb,sp_a%jcap,sp_a%idrt,sp_a%imax,sp_a%jmax,j,j, & ! sp_a%eps,sp_a%epstop,sp_a%enn1,sp_a%elonn1,sp_a%eon,sp_a%eontop, & @@ -945,7 +954,7 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) ! spdz2uv compute winds from divergence and vorticity ! spuv2dz compute divergence and vorticity from winds ! -! remarks: +! remarks: ! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. @@ -969,6 +978,7 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) use kinds, only: r_kind,i_kind use constants, only: zero use general_specmod, only: spec_vars + use sp_mod, only: spffte,spsynth,splegend,spdz2uv implicit none ! Declare passed variables @@ -980,7 +990,8 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) ! Declare local variables integer(i_kind) i,j,ii,jj,ijn,ijs,ifact,kw,kwtop,imaxp2 - integer(i_kind),dimension(2):: mp + integer(i_kind) :: mp + integer(i_kind), dimension(1) :: a_mp real(r_kind),dimension(sp_b%ncd2*2,2):: w real(r_kind),dimension(2*(sp_b%jcap+1),2):: wtop real(r_kind),dimension(sp_b%imax,2):: g @@ -991,6 +1002,7 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) ! Set parameters mp=1 + a_mp=1 ifact = sp_b%imax/sp_a%imax kw=(sp_b%jcap+1)*((sp_b%iromb+1)*sp_b%jcap+2) kwtop=2*(sp_b%jcap+1) @@ -1017,7 +1029,7 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) do j=sp_a%jb,sp_a%je tmpafft(:)=sp_b%afft(:) call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_b%pln(1,j),sp_b%plntop(1,j),mp,w(1,1),wtop(1,1),f) + sp_a%clat(j),sp_b%pln(:,j),sp_b%plntop(:,j),a_mp,w(1,1),wtop(1,1),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -1034,7 +1046,7 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) enddo if(j == sp_a%jb)then call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_b%pln(1,j),sp_b%plntop(1,j),mp,w(1,2),wtop(1,2),f) + sp_a%clat(j),sp_b%pln(:,j),sp_b%plntop(:,j),a_mp,w(1,2),wtop(1,2),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & @@ -1056,7 +1068,7 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) sp_b%epstop,tmppln,tmpplntop) tmpafft(:)=sp_b%afft(:) call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),tmppln,tmpplntop,mp,w(1,1),wtop(1,1),f) + sp_a%clat(j),tmppln,tmpplntop,a_mp,w(1,1),wtop(1,1),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -1073,7 +1085,7 @@ subroutine general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) enddo if(j == sp_a%jb)then call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),tmppln,tmpplntop,mp,w(1,2),wtop(1,2),f) + sp_a%clat(j),tmppln,tmpplntop,a_mp,w(1,2),wtop(1,2),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & @@ -1145,7 +1157,7 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) ! spdz2uv compute winds from divergence and vorticity ! spuv2dz compute divergence and vorticity from winds ! -! remarks: +! remarks: ! This routine assumes that splib routine sptranf0 has been ! previously called. sptranf0 initializes arrays needed in ! the transforms. @@ -1169,6 +1181,7 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) use kinds, only: r_kind,i_kind use constants, only: zero use general_specmod, only: spec_vars + use sp_mod, only: spffte,spsynth,splegend,spdz2uv implicit none ! Declare passed variables @@ -1180,7 +1193,8 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) ! Declare local variables integer(i_kind) i,j,ii,jj,ijn,ijs,ifact,kw,kwtop,imaxp2 - integer(i_kind),dimension(2):: mp + integer(i_kind) :: mp + integer(i_kind), dimension(1) :: a_mp real(r_kind),dimension(sp_b%ncd2*2,2):: w real(r_kind),dimension(2*(sp_b%jcap+1),2):: wtop real(r_kind),dimension(sp_b%imax,2):: g @@ -1191,6 +1205,7 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) ! Set parameters mp=1 + a_mp=1 ifact = sp_b%imax/sp_a%imax kw=(sp_b%jcap+1)*((sp_b%iromb+1)*sp_b%jcap+2) kwtop=2*(sp_b%jcap+1) @@ -1220,7 +1235,7 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) tmpafft(:)=sp_b%afft(:) if(j == sp_a%jb)then call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_b%pln(1,j),sp_b%plntop(1,j),mp,w(1,1),wtop(1,1),f) + sp_a%clat(j),sp_b%pln(:,j),sp_b%plntop(:,j),a_mp,w(1,1),wtop(1,1),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & @@ -1235,7 +1250,7 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) enddo end if call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),sp_b%pln(1,j),sp_b%plntop(1,j),mp,w(1,2),wtop(1,2),f) + sp_a%clat(j),sp_b%pln(:,j),sp_b%plntop(:,j),a_mp,w(1,2),wtop(1,2),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & @@ -1260,7 +1275,7 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) tmpafft(:)=sp_b%afft(:) if(j == sp_a%jb)then call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),tmppln,tmpplntop,mp,w(1,1),wtop(1,1),f) + sp_a%clat(j),tmppln,tmpplntop,a_mp,w(1,1),wtop(1,1),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & @@ -1275,7 +1290,7 @@ subroutine general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) enddo end if call spsynth(sp_b%iromb,sp_b%jcap,sp_b%imax,imaxp2,kw,kwtop,1, & - sp_a%clat(j),tmppln,tmpplntop,mp,w(1,2),wtop(1,2),f) + sp_a%clat(j),tmppln,tmpplntop,a_mp,w(1,2),wtop(1,2),f) call spffte(sp_b%imax,imaxp2/2,sp_b%imax,2,f,g,1,tmpafft) ! call sptranf1(sp_b%iromb,sp_b%jcap,sp_b%idrt,sp_b%imax,sp_a%jmax,j,j, & ! sp_b%eps,sp_b%epstop,sp_b%enn1,sp_b%elonn1,sp_b%eon,sp_b%eontop, & @@ -1311,9 +1326,9 @@ subroutine general_sptez_s_b(sp_a,sp_b,wave,grid,idir) ! subprogram can be called from a multiprocessing environment. ! ! This routine differs from splib routine sptez in that -! 1) the calling list only contains the in/out arrays and +! 1) the calling list only contains the in/out arrays and ! flag for the direction in which to transform -! 2) it calls a version of sptranf that does not invoke +! 2) it calls a version of sptranf that does not invoke ! initialization routines on each entry ! 3) some generality built into the splib version is ! removed in the code below @@ -1415,7 +1430,7 @@ subroutine general_sptez_v_b(sp_a,sp_b,waved,wavez,gridu,gridv,idir,iuvflag) ! 1996-02-29 iredell ! 2004-08-23 treadon - adapt splib routine sptezv for gsi use ! 2007-04-25 errico - replace use of duplicate arguments in sptranf_v -! 2008-04-03 safford - rm unused vars +! 2008-04-03 safford - rm unused vars ! 2010-02-18 parrish - copy to general_sptez_v, and pass specmod vars through ! input variable sp of type(spec_vars) ! @@ -1493,7 +1508,7 @@ subroutine general_sptez_v_b(sp_a,sp_b,waved,wavez,gridu,gridv,idir,iuvflag) if(iuvflag > 0)then ! Call spectral <--> grid transform u only (and polar v) call general_sptranf_v_u(sp_a,sp_b,waved,wavez,gridu,gridv) - else + else ! Call spectral <--> grid transform v only (and polar u) call general_sptranf_v_v(sp_a,sp_b,waved,wavez,gridu,gridv) end if diff --git a/src/gsi/ncepgfs_io.f90 b/src/gsi/ncepgfs_io.f90 index dd4691603..24e6605f3 100644 --- a/src/gsi/ncepgfs_io.f90 +++ b/src/gsi/ncepgfs_io.f90 @@ -14,7 +14,7 @@ module ncepgfs_io ! reading in gefs sigma files at resolution different from analysis. ! 2010-03-31 treadon - add read_gfs, use sp_a and sp_b ! 2010-05-19 todling - add read_gfs_chem -! 2011-04-08 li - (1) add integer nst_gsi to control the mode of NSST +! 2011-04-08 li - (1) add integer nst_gsi to control the mode of NSST ! - (2) add subroutine write_gfs_sfc_nst to save sfc and nst files ! 2014-04-08 li - (1) modify write_gfs_sfc_nst for mask dependent interpolation ! (2) add write_ens_sfc_nst, write_ens_dsfct @@ -30,12 +30,12 @@ module ncepgfs_io ! ! Subroutines Included: ! sub read_gfs - driver to read ncep gfs atmospheric ("sigma") files -! sub read_gfssfc - read ncep gfs surface file, scatter on grid to +! sub read_gfssfc - read ncep gfs surface file, scatter on grid to ! analysis subdomains ! sub write_gfs - driver to write ncep gfs atmospheric and surface ! analysis files ! sub write_gfssfc - gather/write on grid ncep surface analysis file -! sub read_gfssfc_ens - read ncep gfs ensemble surface file, scatter on grid to +! sub read_gfssfc_ens - read ncep gfs ensemble surface file, scatter on grid to ! analysis subdomains ! sub read_nst - driver to read ncep nst file ! sub read_gfsnst - read ncep nst filea from one task and then broadcast to others @@ -52,6 +52,7 @@ module ncepgfs_io ! !$$$ end documentation block use sigio_module, only: sigio_head + use sp_mod, only: splat use ncepnems_io, only: tran_gfssfc use gridmod, only: sfcnst_comb implicit none @@ -68,10 +69,10 @@ module ncepgfs_io public write_gfs public write_gfs_sfc_nst public sigio_cnvtdv8 - public sighead + public sighead public write_ghg_grid - type(sigio_head) :: sighead + type(sigio_head) :: sighead contains @@ -87,10 +88,10 @@ subroutine read_gfs ! program history log: ! 2010-03-31 treadon - create routine ! 2011-05-01 todling - cwmr no longer in guess-grids; use metguess bundle now -! 2011-10-01 mkim - add calculation of hydrometeor mixing ratio from total condensate (cw) -! 2011-11-01 eliu - add call to set_cloud_lower_bound (qcmin) +! 2011-10-01 mkim - add calculation of hydrometeor mixing ratio from total condensate (cw) +! 2011-11-01 eliu - add call to set_cloud_lower_bound (qcmin) ! 2011-11-01 eliu - move then calculation of hydrometeor mixing ratio from total condensate to cloud_efr; -! rearrange Min-Jeong's code +! rearrange Min-Jeong's code ! 2013-10-19 todling - update cloud_efr module name ! 2013-10-29 todling - revisit write to allow skipping vars not in MetGuess ! 2014-11-28 zhu - assign cwgues0 right after reading in fg, @@ -119,14 +120,14 @@ subroutine read_gfs use general_sub2grid_mod, only: sub2grid_info,general_sub2grid_create_info,general_sub2grid_destroy_info use mpimod, only: npe,mype use mpeu_util, only: die - use cloud_efr_mod, only: cloud_calc_gfs,set_cloud_lower_bound + use cloud_efr_mod, only: cloud_calc_gfs,set_cloud_lower_bound use general_specmod, only: general_init_spec_vars,general_destroy_spec_vars,spec_vars implicit none character(24) filename logical:: l_cld_derived,zflag,inithead integer(i_kind):: it,nlon_b,num_fields,inner_vars - integer(i_kind):: iret,iret_ql,iret_qi,istatus + integer(i_kind):: iret,iret_ql,iret_qi,istatus type(gsi_bundle) :: atm_bundle type(gsi_grid) :: atm_grid @@ -222,7 +223,7 @@ subroutine read_gfs if (mype==0) write(6,*)'READ_GFS: l_cld_derived = ', l_cld_derived if (l_cld_derived) then - call cloud_calc_gfs(ges_ql_it,ges_qi_it,ges_cwmr_it,ges_q_it,ges_tv_it,.true.) + call cloud_calc_gfs(ges_ql_it,ges_qi_it,ges_cwmr_it,ges_q_it,ges_tv_it,.true.) end if end do call gsi_bundledestroy(atm_bundle,istatus) @@ -237,63 +238,63 @@ subroutine read_gfs subroutine set_guess_ - call gsi_bundlegetpointer (atm_bundle,'ps',ptr2d,istatus) + call gsi_bundlegetpointer (atm_bundle,'ps',ptr2d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'ps',ges_ps_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'ps',ges_ps_it ,istatus) if(istatus==0) ges_ps_it = ptr2d endif - call gsi_bundlegetpointer (atm_bundle,'z',ptr2d,istatus) + call gsi_bundlegetpointer (atm_bundle,'z',ptr2d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'z' ,ges_z_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'z' ,ges_z_it ,istatus) if(istatus==0) ges_z_it = ptr2d endif - call gsi_bundlegetpointer (atm_bundle,'u',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'u',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'u' ,ges_u_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'u' ,ges_u_it ,istatus) if(istatus==0) ges_u_it = ptr3d endif - call gsi_bundlegetpointer (atm_bundle,'v',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'v',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'v' ,ges_v_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'v' ,ges_v_it ,istatus) if(istatus==0) ges_v_it = ptr3d endif - call gsi_bundlegetpointer (atm_bundle,'vor',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'vor',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'vor',ges_vor_it,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'vor',ges_vor_it,istatus) if(istatus==0) ges_vor_it = ptr3d endif - call gsi_bundlegetpointer (atm_bundle,'div',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'div',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'div',ges_div_it,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'div',ges_div_it,istatus) if(istatus==0) ges_div_it = ptr3d endif - call gsi_bundlegetpointer (atm_bundle,'tv',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'tv',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'tv',ges_tv_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'tv',ges_tv_it ,istatus) if(istatus==0) ges_tv_it = ptr3d endif - call gsi_bundlegetpointer (atm_bundle,'q',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'q',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'q' ,ges_q_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'q' ,ges_q_it ,istatus) if(istatus==0) ges_q_it = ptr3d endif - call gsi_bundlegetpointer (atm_bundle,'oz',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'oz',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'oz',ges_oz_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'oz',ges_oz_it ,istatus) if(istatus==0) ges_oz_it = ptr3d endif - call gsi_bundlegetpointer (atm_bundle,'cw',ptr3d,istatus) + call gsi_bundlegetpointer (atm_bundle,'cw',ptr3d,istatus) if (istatus==0) then - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'cw',ges_cwmr_it,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'cw',ges_cwmr_it,istatus) if(istatus==0) ges_cwmr_it = ptr3d endif - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'ql',ges_ql_it, iret_ql) - call gsi_bundlegetpointer (gsi_metguess_bundle(it),'qi',ges_qi_it, iret_qi) - if (iret_ql/=0) then - if (mype==0) write(6,*)'READ_GFS: cannot get pointer to ql,iret_ql= ',iret_ql + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'ql',ges_ql_it, iret_ql) + call gsi_bundlegetpointer (gsi_metguess_bundle(it),'qi',ges_qi_it, iret_qi) + if (iret_ql/=0) then + if (mype==0) write(6,*)'READ_GFS: cannot get pointer to ql,iret_ql= ',iret_ql endif - if (iret_qi/=0) then - if (mype==0) write(6,*)'READ_GFS: cannot get pointer to qi,iret_qi= ',iret_qi + if (iret_qi/=0) then + if (mype==0) write(6,*)'READ_GFS: cannot get pointer to qi,iret_qi= ',iret_qi endif end subroutine set_guess_ @@ -307,14 +308,14 @@ subroutine read_gfs_chem (iyear, month,idd, it ) ! ! prgrmmr: todling ! -! abstract: fills chemguess_bundle with GFS chemistry. +! abstract: fills chemguess_bundle with GFS chemistry. ! -! remarks: -! 1. Right now, only CO2 is done and even this is treated +! remarks: +! 1. Right now, only CO2 is done and even this is treated ! as constant througout the assimialation window. ! 2. iyear and month could come from obsmod, but logically ! this program should never depend on obsmod -! +! ! ! program history log: ! 2010-04-15 hou - Initial code @@ -585,7 +586,7 @@ subroutine read_sfc(sfct,soil_moi,sno,soil_temp,veg_frac,fact10,sfc_rough, & use guess_grids, only: nfldsfc,ifilesfc logical, intent(in ) :: use_sfc_any - real(r_single), dimension(nlat_sfc,nlon_sfc,nfldsfc), intent( out) :: sfct,soil_moi,sno,soil_temp,veg_frac,fact10,sfc_rough + real(r_single), dimension(nlat_sfc,nlon_sfc,nfldsfc), intent( out) :: sfct,soil_moi,sno,soil_temp,veg_frac,fact10,sfc_rough real(r_single), dimension(nlat_sfc,nlon_sfc), intent( out) :: veg_type,soil_type,terrain integer(i_kind), dimension(nlat_sfc,nlon_sfc), intent( out) :: isli integer(i_kind) :: latb,lonb @@ -627,51 +628,51 @@ subroutine read_sfc(sfct,soil_moi,sno,soil_temp,veg_frac,fact10,sfc_rough, & end if !$omp parallel do private(n,i,j,outtmp) do n = 1, nsfc - + if (n == 1) then ! skin temperature - - call tran_gfssfc(sfc_data%tsea,sfct(1,1,it),lonb,latb) - + + call tran_gfssfc(sfc_data%tsea,sfct(1,1,it),lonb,latb) + elseif(n == 2 .and. use_sfc_any) then ! soil moisture - call tran_gfssfc(sfc_data%smc(1:lonb,1:latb,1),soil_moi(1,1,it),lonb,latb) + call tran_gfssfc(sfc_data%smc(1:lonb,1:latb,1),soil_moi(1,1,it),lonb,latb) elseif(n == 3) then ! snow depth - call tran_gfssfc(sfc_data%sheleg,sno(1,1,it),lonb,latb) + call tran_gfssfc(sfc_data%sheleg,sno(1,1,it),lonb,latb) elseif(n == 4 .and. use_sfc_any) then ! soil temperature - call tran_gfssfc(sfc_data%stc(1:lonb,1:latb,1),soil_temp(1,1,it),lonb,latb) + call tran_gfssfc(sfc_data%stc(1:lonb,1:latb,1),soil_temp(1,1,it),lonb,latb) - elseif(n == 5 .and. use_sfc_any) then ! vegetation cover + elseif(n == 5 .and. use_sfc_any) then ! vegetation cover - call tran_gfssfc(sfc_data%vfrac,veg_frac(1,1,it),lonb,latb) + call tran_gfssfc(sfc_data%vfrac,veg_frac(1,1,it),lonb,latb) elseif(n == 6) then ! 10m wind factor - call tran_gfssfc(sfc_data%f10m,fact10(1,1,it),lonb,latb) + call tran_gfssfc(sfc_data%f10m,fact10(1,1,it),lonb,latb) elseif(n == 7) then ! suface roughness - call tran_gfssfc(sfc_data%zorl,sfc_rough(1,1,it),lonb,latb) + call tran_gfssfc(sfc_data%zorl,sfc_rough(1,1,it),lonb,latb) elseif(n == 8 .and. use_sfc_any) then ! vegetation type - call tran_gfssfc(sfc_data%vtype,veg_type,lonb,latb) + call tran_gfssfc(sfc_data%vtype,veg_type,lonb,latb) elseif(n == 9 .and. use_sfc_any) then ! soil type - call tran_gfssfc(sfc_data%stype,soil_type,lonb,latb) + call tran_gfssfc(sfc_data%stype,soil_type,lonb,latb) elseif(n == 10) then ! sea/land/ice flag - call tran_gfssfc(sfc_data%orog,terrain,lonb,latb) + call tran_gfssfc(sfc_data%orog,terrain,lonb,latb) elseif(n == 11) then ! terrain allocate(outtmp(latb+2,lonb)) - call tran_gfssfc(sfc_data%slmsk,outtmp,lonb,latb) + call tran_gfssfc(sfc_data%slmsk,outtmp,lonb,latb) do j=1,lonb do i=1,latb+2 isli(i,j) = nint(outtmp(i,j)) @@ -714,7 +715,7 @@ subroutine read_gfssfc(iope,sfct,soil_moi,sno,soil_temp,veg_frac,fact10,sfc_roug ! 2006-09-28 treadon - pull out surface roughness ! 2008-05-28 safford - rm unused vars ! 2009-01-12 gayno - add read of terrain height -! 2016-03-13 xuli - modify the document and reorganize the variables order +! 2016-03-13 xuli - modify the document and reorganize the variables order ! ! input argument list: ! iope - mpi task handling i/o @@ -731,7 +732,7 @@ subroutine read_gfssfc(iope,sfct,soil_moi,sno,soil_temp,veg_frac,fact10,sfc_roug ! veg_type - vegetation type ! soil_type - soil type ! terrain - terrain height -! isli - sea/land/ice mask +! isli - sea/land/ice mask ! ! attributes: ! language: f90 @@ -848,7 +849,7 @@ subroutine read_sfc_anl(isli_anl) endif allocate(outtmp(latb+2,lonb)) - call tran_gfssfc(sfc_data%slmsk,outtmp,lonb,latb) + call tran_gfssfc(sfc_data%slmsk,outtmp,lonb,latb) do j=1,lonb do i=1,latb+2 isli_anl(i,j) = nint(outtmp(i,j)) @@ -982,45 +983,45 @@ subroutine read_nst(tref,dt_cool,z_c,dt_warm,z_w,c_0,c_d,w_0,w_d) !$omp parallel do private(n,dwarm_tmp) do n=1,nnst - + if(n == 1)then ! foundation temperature (Tf) - call tran_gfssfc(nst_data%tref,tref(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%tref,tref(1,1,it),lonb,latb) else if(n == 2) then ! cooling amount - call tran_gfssfc(nst_data%dt_cool,dt_cool(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%dt_cool,dt_cool(1,1,it),lonb,latb) else if(n == 3) then ! cooling layer thickness - call tran_gfssfc(nst_data%z_c,z_c(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%z_c,z_c(1,1,it),lonb,latb) else if(n == 4 ) then ! warming amount allocate(dwarm_tmp(lonb,latb)) dwarm_tmp(:,:) = two*nst_data%xt(:,:)/nst_data%xz(:,:) - call tran_gfssfc(dwarm_tmp,dt_warm(1,1,it),lonb,latb) + call tran_gfssfc(dwarm_tmp,dt_warm(1,1,it),lonb,latb) deallocate(dwarm_tmp) else if(n == 5 ) then ! warm layer thickness - call tran_gfssfc(nst_data%xz,z_w(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%xz,z_w(1,1,it),lonb,latb) else if(n == 6) then ! coefficient 1 to get d(Tz)/d(Tf) - call tran_gfssfc(nst_data%c_0,c_0(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%c_0,c_0(1,1,it),lonb,latb) else if(n == 7) then ! coefficient 2 to get d(Tz)/d(Tf) - call tran_gfssfc(nst_data%c_d,c_d(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%c_d,c_d(1,1,it),lonb,latb) else if(n == 8 ) then ! coefficient 3 to get d(Tz)/d(Tf) - call tran_gfssfc(nst_data%w_0,w_0(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%w_0,w_0(1,1,it),lonb,latb) else if(n == 9 ) then ! coefficient 4 to get d(Tz)/d(Tf) - call tran_gfssfc(nst_data%w_d,w_d(1,1,it),lonb,latb) + call tran_gfssfc(nst_data%w_d,w_d(1,1,it),lonb,latb) end if @@ -1042,11 +1043,11 @@ subroutine read_gfsnst(iope,tref,dt_cool,z_c,dt_warm,z_w,c_0,c_d,w_0,w_d) !$$$ subprogram documentation block ! . . . . -! subprogram: read_gfsnst +! subprogram: read_gfsnst ! prgmmr: li org: np23 date: 2009-08-26 ! ! abstract: read gfs nst fields from a specific task and then broadcast to others -! +! ! ! program history log: ! 2015-04-25 li : modify to minimize communications/IO @@ -1128,7 +1129,7 @@ subroutine write_gfs(increment,mype_atm,mype_sfc) ! 2009-11-28 todling - add increment option (hook-only for now) ! 2010-03-31 treadon - add hires_b, sp_a, and sp_b ! 2011-05-01 todling - cwmr no longer in guess-grids; use metguess bundle now -! 2013-02-26 m.kim - recompute and write cw analysis (= original cw gues + increment) +! 2013-02-26 m.kim - recompute and write cw analysis (= original cw gues + increment) ! where cw increments are calculated with nonnegative cw ! gues while original cw gues still have negative values. ! 2013-10-19 todling - update cloud_efr module name @@ -1165,15 +1166,15 @@ subroutine write_gfs(increment,mype_atm,mype_sfc) use gsi_bundlemod, only: gsi_bundledestroy use mpeu_util, only: die use gsi_nstcouplermod, only: nst_gsi - use constants, only: qcmin + use constants, only: qcmin use constants, only:zero use general_specmod, only: general_init_spec_vars,general_destroy_spec_vars,spec_vars use gsi_4dvar, only: lwrite4danl,nhr_anal use ncepnems_io, only: write_nemsatm,write_nemssfc,write_nems_sfc_nst use netcdfgfs_io, only: write_gfsncsfc, write_gfsnc_sfc_nst, write_gfsncatm use write_incr, only: write_fv3_increment - use ncepnems_io, only: write_fv3atm_nems - use gridmod, only: fv3_full_hydro + use ncepnems_io, only: write_fv3atm_nems + use gridmod, only: fv3_full_hydro use gsi_chemguess_mod, only: gsi_chemguess_get,gsi_chemguess_bundle use chemmod, only: laeroana_gocart use radiance_mod, only: aerosol_names @@ -1238,15 +1239,15 @@ subroutine write_gfs(increment,mype_atm,mype_sfc) type(gsi_bundle) :: atm_bundle type(gsi_grid) :: atm_grid integer(i_kind),parameter :: n2d=2 - integer(i_kind),parameter :: n3d=14 + integer(i_kind),parameter :: n3d=14 character(len=4), parameter :: vars2d(n2d) = (/ 'z ', 'ps ' /) character(len=4), parameter :: vars3d(n3d) = (/ 'u ', 'v ', & 'vor ', 'div ', & 'tv ', 'q ', & 'cw ', 'oz ', & - 'ql ', 'qi ', & - 'qr ', 'qs ', & - 'qg ', 'cf ' /) + 'ql ', 'qi ', & + 'qr ', 'qs ', & + 'qg ', 'cf ' /) logical :: inithead @@ -1297,7 +1298,7 @@ subroutine write_gfs(increment,mype_atm,mype_sfc) if ( istatus == 0 ) aux_cf = zero call gsi_bundlegetpointer(atm_bundle,'cw',aux_cwmr,istatus) if ( istatus == 0 ) aux_cwmr = zero - + ! if aerosols if ( laeroana_gocart ) then call gsi_bundlecreate(chem_bundle,atm_grid,'aux-chem-write',istatus,names3d=aerosol_names) @@ -1374,22 +1375,22 @@ subroutine write_gfs(increment,mype_atm,mype_sfc) write(6,'(A,I2.2)') 'WRITE_GFS: writing full analysis state for FHR ', ifilesig(itoutsig) endif endif - - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'ps',ges_ps_it ,istatus) + + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'ps',ges_ps_it ,istatus) if ( istatus == 0 ) aux_ps = ges_ps_it - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'u' ,ges_u_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'u' ,ges_u_it ,istatus) if ( istatus == 0 ) aux_u = ges_u_it - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'v' ,ges_v_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'v' ,ges_v_it ,istatus) if ( istatus == 0 ) aux_v = ges_v_it - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'vor',ges_vor_it,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'vor',ges_vor_it,istatus) if ( istatus == 0 ) aux_vor = ges_vor_it - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'div',ges_div_it,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'div',ges_div_it,istatus) if ( istatus == 0 ) aux_div = ges_div_it - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'tv',ges_tv_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'tv',ges_tv_it ,istatus) if ( istatus == 0 ) aux_tv = ges_tv_it - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'q' ,ges_q_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'q' ,ges_q_it ,istatus) if ( istatus == 0 ) aux_q = ges_q_it - call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'oz',ges_oz_it ,istatus) + call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'oz',ges_oz_it ,istatus) if ( istatus == 0 ) aux_oz = ges_oz_it call gsi_bundlegetpointer (gsi_metguess_bundle(itoutsig),'ql',ges_ql_it,istatus) if ( istatus == 0 ) aux_ql = ges_ql_it @@ -1456,7 +1457,7 @@ subroutine write_gfs(increment,mype_atm,mype_sfc) call write_nemsatm(grd_a,sp_a,filename,mype_atm, & atm_bundle,itoutsig) end if ! laeroana_gocart - endif + endif end if else if ( use_gfs_ncio ) then @@ -1478,10 +1479,10 @@ subroutine write_gfs(increment,mype_atm,mype_sfc) if ( mype == 0 ) & write(6,*)'WRITE_GFS: allocate and load sp_b with jcap,imax,jmax=',& sp_b%jcap,sp_b%imax,sp_b%jmax - + call general_write_gfsatm(grd_a,sp_a,sp_b,filename,mype_atm, & atm_bundle,itoutsig,inithead,iret_write) - + call general_destroy_spec_vars(sp_b) ! Otherwise, use standard transform. Use sp_a in place of sp_b. else @@ -1540,21 +1541,21 @@ subroutine write_gfssfc(filename,mype_sfc,dsfct) ! prgrmmr: treadon - initial version; org: np22 ! ! abstract: This routine writes the updated surface analysis. At -! this point (20040615) the only surface field update by +! this point (20040615) the only surface field update by ! the gsi is the skin temperature. The current (20040615) ! GDAS setup does use the updated surface file. Rather, ! the output from surface cycle is used as the surface ! analysis for subsequent GFS runs. ! -! The routine gathers surface fields from subdomains, +! The routine gathers surface fields from subdomains, ! reformats the data records, and then writes each record -! to the output file. +! to the output file. ! ! Since the gsi only update the skin temperature, all ! other surface fields are simply read from the guess ! surface file and written to the analysis file. ! -! Structure of GFS surface file +! Structure of GFS surface file ! data record 1 label ! data record 2 date, dimension, version, lons/lat record ! data record 3 tsf @@ -1604,12 +1605,12 @@ subroutine write_gfssfc(filename,mype_sfc,dsfct) ! !USES: use kinds, only: r_kind,r_single,i_kind - + use mpimod, only: mpi_rtype use mpimod, only: mpi_comm_world use mpimod, only: ierror use mpimod, only: mype - + use gridmod, only: nlat,nlon use gridmod, only: lat1,lon1 use gridmod, only: lat2,lon2 @@ -1618,17 +1619,17 @@ subroutine write_gfssfc(filename,mype_sfc,dsfct) use gridmod, only: displs_g use gridmod, only: itotsub use gridmod, only: rlats,rlons,rlats_sfc,rlons_sfc - + use general_commvars_mod, only: ltosi,ltosj use obsmod, only: iadate use ncepnems_io, only: intrp22 - + use constants, only: zero_single - + use sfcio_module, only: sfcio_intkind,sfcio_head,sfcio_data,& sfcio_srohdc,sfcio_swohdc,sfcio_axdata - + implicit none ! !INPUT PARAMETERS: @@ -1663,14 +1664,14 @@ subroutine write_gfssfc(filename,mype_sfc,dsfct) type(sfcio_head):: head type(sfcio_data):: data - + !***************************************************************************** ! Initialize local variables mm1=mype+1 nlatm2=nlat-2 -! Gather skin temperature information from all tasks. +! Gather skin temperature information from all tasks. do j=1,lon1 jp1 = j+1 do i=1,lat1 @@ -1755,7 +1756,7 @@ subroutine write_gfssfc(filename,mype_sfc,dsfct) 2i6,1x,f4.1,4(i4,1x),' with iret=',i2) endif - + ! End of routine return end subroutine write_gfssfc @@ -2131,7 +2132,7 @@ subroutine write_gfs_sfc_nst(mype_so,dsfct) ! ! For the new open water (sea ice just melted) grids, reset the NSSTM variables ! - where ( data_sfcanl%slmsk(:,:) == zero .and. data_sfcges%slmsk(:,:) == two ) + where ( data_sfcanl%slmsk(:,:) == zero .and. data_sfcges%slmsk(:,:) == two ) data_nst%xt(:,:) = zero data_nst%xs(:,:) = zero data_nst%xu(:,:) = zero @@ -2212,7 +2213,7 @@ end subroutine write_gfs_sfc_nst subroutine write_tf_inc_nc(mype_so,xvar2) ! -! abstract: get a global dtf and msk used in GSI by gatjering sub-domanin ones and write them in netCDF +! abstract: get a global dtf and msk used in GSI by gatjering sub-domanin ones and write them in netCDF ! ! REMARKS: ! @@ -2255,8 +2256,8 @@ subroutine write_tf_inc_nc(mype_so,xvar2) ! ! INPUT PARAMETERS: ! - integer(i_kind), intent(in) :: mype_so - real(r_kind),dimension(lat2,lon2), intent(in) :: xvar2 + integer(i_kind), intent(in) :: mype_so + real(r_kind),dimension(lat2,lon2), intent(in) :: xvar2 ! ! OUTPUT PARAMETERS: ! @@ -2347,13 +2348,13 @@ subroutine write_tf_inc_nc(mype_so,xvar2) call nc_check( nf90_put_att(ncid, msk_varid, units, msk_units),'lat_name','dtfanl' ) ! End define mode. call nc_check( nf90_enddef(ncid),'Att_End','dtfanl' ) -! Write the coordinate variable data. +! Write the coordinate variable data. call nc_check( nf90_put_var(ncid, lat_varid, rlats*rad2deg),'write_lats','dtfanl' ) call nc_check( nf90_put_var(ncid, lon_varid, rlons*rad2deg),'write_lons','dtfanl' ) ! These settings tell netcdf to write one timestep of data. count = (/ nlon, nlat /) start = (/ 1, 1 /) -! Write the data. +! Write the data. call nc_check( nf90_put_var(ncid, dtf_varid, dtf, start, count),'write_dtf','dtfanl' ) call nc_check( nf90_put_var(ncid, msk_varid, msk, start, count),'write_msk','dtfanl' ) @@ -2569,7 +2570,7 @@ subroutine write_ens_sfc_nst(mype_so,dsfct) do k = 1, n_ens write(cmember,'(i3.3)') k ! make the a character string - + fname_nstges = 'nstf06_mem'//cmember fname_sfcges = 'sfcf06_mem'//cmember fname_sfcgcy = 'sfcgcy_mem'//cmember @@ -2615,7 +2616,7 @@ subroutine write_ens_sfc_nst(mype_so,dsfct) latb=head_sfcanl%latb lonb=head_sfcanl%lonb - + nlat_ens_sfc = latb + 2 nlon_ens_sfc = lonb ! @@ -2706,7 +2707,7 @@ subroutine write_ens_sfc_nst(mype_so,dsfct) ! note: data_sfcges%slmsk is the mask of the guess ! data_sfcanl%slmsk is the mask of the analysis ! - where ( data_sfcanl%slmsk(:,:) == zero .and. data_sfcges%slmsk(:,:) == two ) + where ( data_sfcanl%slmsk(:,:) == zero .and. data_sfcges%slmsk(:,:) == two ) data_nst%xt(:,:) = zero data_nst%xs(:,:) = zero data_nst%xu(:,:) = zero @@ -2729,7 +2730,7 @@ subroutine write_ens_sfc_nst(mype_so,dsfct) ! ! update analysis variable: Tref (foundation temperature) for nst file ! - where ( data_sfcanl%slmsk(:,:) == zero ) + where ( data_sfcanl%slmsk(:,:) == zero ) data_nst%tref(:,:) = max(data_nst%tref(:,:) + dsfct_anl(:,:),tfrozen) else where data_nst%tref(:,:) = data_sfcanl%tsea(:,:) @@ -2739,7 +2740,7 @@ subroutine write_ens_sfc_nst(mype_so,dsfct) ! where ( data_sfcanl%slmsk(:,:) == zero ) data_sfcanl%tsea(:,:) = max(data_nst%tref(:,:) & - + two*data_nst%xt(:,:)/data_nst%xz(:,:) & + + two*data_nst%xt(:,:)/data_nst%xz(:,:) & - data_nst%dt_cool(:,:), tfrozen) end where @@ -2803,7 +2804,7 @@ subroutine write_ens_sfc_nst(mype_so,dsfct) ! Write updated information to nst analysis file call nstio_swohdc(io_nstanl,fname_nstanl,head_nst,data_nst,iret) - + write(6,101)fname_nstanl,lonb,latb,head_nst%fhour,head_nst%idate(1:4),iret 101 format(' WRITE_ENS_NST_SFC: nst analysis written for ',& @@ -3023,7 +3024,7 @@ subroutine write_ens_dsfct(mype_so,dsfct) call nstio_srohdc(io_nstges,fname_nstges,head_nst,data_nst,iret) if (iret /= 0) then write(6,*)'WRITE_ENS_DSFCT: ***ERROR*** problem reading',fname_nstges,', iret=',iret - + call nstio_axdata(data_nst,iret) call stop2(80) endif @@ -3032,7 +3033,7 @@ subroutine write_ens_dsfct(mype_so,dsfct) call sfcio_srohdc(io_sfcges,fname_sfcges,head_sfcges,data_sfcges,iret) if (iret /= 0) then write(6,*)'WRITE_ENS_DSFCT: ***ERROR*** problem reading',fname_sfcges,', iret=',iret - + call sfcio_axdata(data_sfcges,iret) call stop2(80) endif @@ -3048,7 +3049,7 @@ subroutine write_ens_dsfct(mype_so,dsfct) if ( head_nst%latb /= head_sfcgcy%latb .or. head_nst%lonb /=head_sfcgcy%lonb ) then write(6,*) 'Inconsistent dimension for sfc & nst files.head_nst%latb,head_nst%lonb : ',head_nst%latb,head_nst%lonb, & 'head_sfcgcy%latb,head_sfcgcy%lonb : ',head_sfcgcy%latb,head_sfcgcy%lonb - + call stop2(80) endif @@ -3124,7 +3125,7 @@ subroutine write_ens_dsfct(mype_so,dsfct) ! write(6,*)'WRITE_ENS_DSFCT: the same grid dimensions static grids: ',& ', nlon,nlat_-2=',nlon,nlatm2,' -vs- ens lonb,latb=',lonb,latb - + do j=1,latb do i=1,lonb dsfct_anl(i,j)=dsfct_glb(latb+1-j,i) @@ -3232,8 +3233,8 @@ subroutine glbave(fld,ave) use gridmod, only: lat2,lon2,nlon,istart,wgtlats use mpl_allreducemod, only: mpl_allreduce implicit none - real(r_kind),intent(in) :: fld(:,:,:) - real(r_kind),intent(inout) :: ave(:) + real(r_kind),intent(in) :: fld(:,:,:) + real(r_kind),intent(inout) :: ave(:) integer(i_kind) i,j,k,mp1,ii real(r_quad),allocatable,dimension(:):: xave allocate(xave(size(ave,1))) diff --git a/src/gsi/oneobmod.F90 b/src/gsi/oneobmod.F90 index c18bc3084..0376de75d 100644 --- a/src/gsi/oneobmod.F90 +++ b/src/gsi/oneobmod.F90 @@ -21,7 +21,7 @@ module oneobmod ! table. Added oneobmakebufr and invtllv subroutines to make ! the radial wind superobs. Added nml options for a ! "single radar" observation test (all obs from one -! radar). +! radar). ! 2016-12-14 lippi - added nml option learthrel_rw to not rotate the winds ! from lat lon to xy. ! @@ -30,14 +30,14 @@ module oneobmod ! sub oneobmakebufr ! sub oneobmakerwsupob ! sub oneobo3lv -! sub invtllv +! sub invtllv ! ! variable definitions: ! def maginnov - magnitude of innovation for one ob exp ! def magoberr - magnitude of observational error for one ob exp ! def oblat - observation latitude for one ob exp ! def oblon - observation longitude for one ob exp -! def obhourset - observation delta time from analysis time for +! def obhourset - observation delta time from analysis time for ! one ob exp ! def obpres - observation pressure (hPa) or one ob exp ! def obdattim - observation date for one ob exp @@ -141,7 +141,7 @@ subroutine oneobmakebufr ! program history log: ! 2003-10-20 kleist ! 2004-05-13 kleist documentation -! 2006-04-06 middlecoff - changed lumk from 52 to lendian_in so one-obs prepqc +! 2006-04-06 middlecoff - changed lumk from 52 to lendian_in so one-obs prepqc ! file can be read as little endian ! 2014-08-04 carley - modify for tcamt and howv obs ! 2014-08-18 carley - added td2m, mxtm, mitm, pmsl, and wsdp10m @@ -173,11 +173,7 @@ subroutine oneobmakebufr real(r_kind),dimension(1,1):: poe,qoe,toe,woe real(r_kind),dimension(1):: xob,yob,dhr real(r_kind),dimension(1,1):: pob -#ifdef BUFR12 integer(i_kind) vtcd -#else - real(r_double) vtcd -#endif integer(i_kind) n,k,iret real(r_kind) hdr(10),obs(13,255),qms(10,255),err(10,255),cld2seq(2,1), & cldseq(3,10),owave(1,255),maxtmint(2,255),cldceilh(1,255),& @@ -234,7 +230,7 @@ subroutine oneobmakebufr subset='ADPSFC' typ(1)=87._r_kind cat(1,1)=zero - cld2seq(1,1)=25._r_kind !TOCC - total cloud amount (%) + cld2seq(1,1)=25._r_kind !TOCC - total cloud amount (%) else if (oneob_type=='howv') then subset='SFCSHP' typ(1)=80._r_kind @@ -332,7 +328,7 @@ subroutine oneobmakebufr call ufbint(lendian_in,owave,1,nlev,iret,owavestr) else if ( oneob_type=='mxtm' .or. oneob_type=='mitm') then call ufbint(lendian_in,maxtmint,2,nlev,iret,maxtmintstr) - end if + end if call writsb(lendian_in) hdr(1)=transfer(sid(n),hdr(1)) hdr(2)=xob(n) @@ -361,7 +357,7 @@ subroutine oneobmakebufr call writsb(lendian_in) enddo call closbf(lendian_in) - + oneobmade=.true. return @@ -372,8 +368,8 @@ subroutine oneobmakerwsupob use kinds, only: r_kind,i_kind use constants, only: zero,half,one,two,zero_quad,one_quad - implicit none - + implicit none + character(4) :: this_staid,isstn real(r_kind),parameter:: four_thirds = 4.0_r_kind / 3.0_r_kind @@ -487,7 +483,7 @@ subroutine oneobmakerwsupob corrected_azimuth=anaz_rw corrected_tilt=anel_rw thishgt=range_rw - + write(6,*) 'Single radial wind observation.' write(6,*) '*******************************************' @@ -549,7 +545,7 @@ subroutine oneobo3lv lumk = 22 ilev = 1 ! ilev > 24 is passive isnd = 1 - ppmv = one ! dummy value + ppmv = one ! dummy value ! obdattim=2000010100 @@ -567,7 +563,7 @@ subroutine oneobo3lv rsec = jldat(7)+jldat(8)*1.e-3_r_kind -! open data file for output. for oneobtype gsimain sets the dfile(1) +! open data file for output. for oneobtype gsimain sets the dfile(1) ! to be prepqc open(unit=lumk,file='prepqc',form='formatted') diff --git a/src/gsi/read_prepbufr.F90 b/src/gsi/read_prepbufr.F90 index 7f25925b6..c616cf6f5 100644 --- a/src/gsi/read_prepbufr.F90 +++ b/src/gsi/read_prepbufr.F90 @@ -6,9 +6,9 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! prgmmr: parrish org: np22 date: 1990-10-07 ! ! abstract: This routine reads conventional data found in the prepbufr -! file. Specific observation types read by this routine +! file. Specific observation types read by this routine ! include surface pressure, temperature, winds (components -! and speeds), moisture and total precipitable water. +! and speeds), moisture and total precipitable water. ! ! When running the gsi in regional mode, the code only ! retains those observations that fall within the regional @@ -16,7 +16,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! ! program history log: ! 1990-10-07 parrish -! 1998-05-15 weiyu yang +! 1998-05-15 weiyu yang ! 1999-08-24 derber, j., treadon, r., yang, w., first frozen mpp version ! 2004-02-13 derber, j. - clean up and modify vertical weighting ! 2004-06-16 treadon - update documentation @@ -63,7 +63,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! 2007-03-15 su - remove the error table reading part to a subroutine ! 2007-04-24 wu - add TAMDAR (134) to be used as sensible T ! 2007-05-17 kleist - generalize flag for virtual/sensible temperature obs -! 2007-09-28 treadon - truncate/expand obs time to remove extraneous bits +! 2007-09-28 treadon - truncate/expand obs time to remove extraneous bits ! 2007-10-03 su - Add reading qc mark from satellite wind ! 2007-10-24 Pondeca - add ability to use use_list on mesonet winds ! 2007-11-03 su - modify conventional thinning algorithm @@ -78,13 +78,13 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! obs into sensible temperature for 2dvar ! 2009-07-08 park,pondeca - add option to use the hilbert curve-based ! cross-validation for 2dvar -! 2009-07-08 pondeca - move handling of "provider use_list" for mesonet winds +! 2009-07-08 pondeca - move handling of "provider use_list" for mesonet winds ! to the new module sfcobsqc ! 2010-03-29 hu - add code to read cloud observation from METAR and NESDIS cloud products ! 2010-05-15 kokron - safety measure: initialize cdata_all to zero -! 2010-08-23 tong - add flg as an input argument of map3grids, so that the subroutine can be used for -! thinning grid with either pressure or height as the vertical coordinate. -! flg=-1 for prepbufr data thinning grid (pressure as the vertical coordinate). +! 2010-08-23 tong - add flg as an input argument of map3grids, so that the subroutine can be used for +! thinning grid with either pressure or height as the vertical coordinate. +! flg=-1 for prepbufr data thinning grid (pressure as the vertical coordinate). ! 2010-09-08 parrish - remove subroutine check_rotate_wind. This was a debug routine introduced when ! the reference wind rotation angle was stored as an angle, beta_ref. This field ! had a discontinuity at the date line (180E), which resulted in erroneous wind @@ -92,25 +92,25 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! from beta_ref values across the discontinuity. This was fixed by replacing the ! beta_ref field with cos_beta_ref, sin_beta_ref. ! 2010-10-19 wu - add code to limit regional use of MAP winds with P less than 400 mb -! 2010-11-13 su - skip satellite winds from prepbufr +! 2010-11-13 su - skip satellite winds from prepbufr ! 2010-11-18 treadon - add check for small POB (if POB0 means GLERL code exists.Others are dummy variables real(r_kind) time,timex,time_drift,timeobs,toff,t4dv,zeps @@ -366,11 +366,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& real(r_kind) :: windbiasfact real(r_double) rstation_id,qcmark_huge -#ifdef BUFR12 integer(i_kind) vtcd,glcd !virtual temp program code and GLERL program code -#else - real(r_double) vtcd,glcd !virtual temp program code and GLERL program code -#endif real(r_double),dimension(8):: hdr,hdrtsb real(r_double),dimension(3,255):: hdr3 real(r_double),dimension(8,255):: drfdat,qcmark,obserr,var_jb @@ -386,7 +382,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& real(r_double),dimension(1,255):: owave real(r_double),dimension(1,255):: cldceilh real(r_double),dimension(1):: satqc - real(r_double),dimension(1,1):: r_prvstg,r_sprvstg + real(r_double),dimension(1,1):: r_prvstg,r_sprvstg real(r_double),dimension(1,255):: levdat real(r_double),dimension(255,20):: tpc real(r_double),dimension(2,255,20):: tobaux @@ -415,8 +411,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& real(r_kind) :: x_obs, y_obs ! equivalence to handle character names - equivalence(r_prvstg(1,1),c_prvstg) - equivalence(r_sprvstg(1,1),c_sprvstg) + equivalence(r_prvstg(1,1),c_prvstg) + equivalence(r_sprvstg(1,1),c_sprvstg) equivalence(rstation_id,c_station_id) equivalence(rstation_id,sidchr) @@ -430,8 +426,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& data oestr /'POE QOE TOE NUL WOE NUL PWE '/ ! data satqcstr /'RFFL QIFY QIFN EEQF'/ data satqcstr /'QIFN'/ - data prvstr /'PRVSTG'/ - data sprvstr /'SPRVSTG'/ + data prvstr /'PRVSTG'/ + data sprvstr /'SPRVSTG'/ data levstr /'POB'/ data cld2seqstr /'TOCC HBLCS'/ ! total cloud cover and height above surface of base of lowest cloud seen data cldseqstr /'VSSO CLAM HOCB'/ ! vertical significance, cloud amount and cloud base height @@ -467,7 +463,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& real(r_double),dimension(3,1500):: fcstdat logical print_verbose - + print_verbose=.false. if(verbose) print_verbose=.true. ! File type @@ -481,7 +477,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& nreal=0 satqc=zero tob = obstype == 't' - uvob = obstype == 'uv' + uvob = obstype == 'uv' if (twodvar_regional) uvob = uvob .or. obstype == 'wspd10m' .or. obstype == 'uwnd10m' .or. obstype == 'vwnd10m' spdob = obstype == 'spd' psob = obstype == 'ps' @@ -511,7 +507,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& nreal=25 iqm = 10 iuse = 12 - else if(uvob) then + else if(uvob) then nreal=27 iqm = 12 iuse = 14 @@ -587,7 +583,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& nreal=18 iqm = 9 iuse = 10 - else + else write(6,*) ' illegal obs type in READ_PREPBUFR ',obstype call stop2(94) end if @@ -637,9 +633,9 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& var_jb=zero do nc=1,nconvtype if(trim(ioctype(nc)) == trim(obstype))then - if(.not.use_prepb_satwnd .and. (trim(ioctype(nc)) == 'uv' .or. trim(ioctype(nc)) == 'wspd10m' .or. & + if(.not.use_prepb_satwnd .and. (trim(ioctype(nc)) == 'uv' .or. trim(ioctype(nc)) == 'wspd10m' .or. & trim(ioctype(nc)) == 'uwnd10m' .or. trim(ioctype(nc)) == 'vwnd10m') .and. ictype(nc) >=241 & - .and. ictype(nc) <260) then + .and. ictype(nc) <260) then cycle else if (aircraft_t_bc) then @@ -761,7 +757,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end do end if end if - if(newvad)write(6,*)'new vad flag::', newvad + if(newvad)write(6,*)'new vad flag::', newvad end if !* END new vad wind @@ -793,8 +789,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if ! temporary specify iobsub until put in bufr file - iobsub = 0 - if(kx == 280 .or. kx == 180 ) iobsub=hdr(3) + iobsub = 0 + if(kx == 280 .or. kx == 180 ) iobsub=hdr(3) if(kx == 280 .or. kx ==180) then if ( hdr(3) >555.0_r_kind .and. hdr(3) <565.0_r_kind ) then iobsub=00 @@ -833,7 +829,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ncsave=0 matchloop:do ncx=1,ntmatch nc=ntxall(ncx) - if (kx /= ictype(nc))cycle + if (kx /= ictype(nc))cycle ! Find convtype which match ob type and subtype if(icsubtype(nc) == iobsub) then @@ -847,7 +843,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& isubsub=icsubtype(nc)-ixsub*10 if(ixsub == iosub .and. isubsub == 0) then ncsave=nc -! Find convtype which match ob type and subtype is all remaining +! Find convtype which match ob type and subtype is all remaining ! (icsubtype(nc) = 0) else if (ncsave == 0 .and. icsubtype(nc) == 0) then ncsave=nc @@ -898,20 +894,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& else !warn that GLERL adjustment is not available. print*, "WARNING: GLERL program code not in this file." -#ifdef BUFR12 glcd=-999 -#else - glcd=-999._r_double -#endif endif -#ifdef BUFR12 if(print_verbose) write(6,'(1x,A,A,A,2(A,1x,I8))') 'read_prepbufr:', & trim(adjustl(obstype)),':', ' vtcd= ',vtcd,' glcd= ',glcd -#else - if(print_verbose) write(6,'(1x,A,A,A,2(A,1x,F8.3))') 'read_prepbufr:', & - trim(adjustl(obstype)),':', ' vtcd= ',vtcd,' glcd= ',glcd -#endif call init_rjlists call init_aircraft_rjlists if(i_gsdsfc_uselist==1) call init_gsd_sfcuselist @@ -925,7 +912,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& endif ! loop over convinfo file entries; operate on matches - + allocate(cdata_all(nreal,maxall),rusage(maxall),rthin(maxall)) nread=0 ntest=0 @@ -943,7 +930,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& rthin = .false. ndata = 0 loop_convinfo: do nx=1, ntread - use_all_tm = .true. + use_all_tm = .true. use_all = .true. ithin=0 pmot=0 @@ -1005,7 +992,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if(reduce_diag .and. pmot < 2)pmot=pmot+2 save_all = .false. if(pmot /= 2 .and. pmot /= 0)save_all=.true. - + call closbf(lunin) close(lunin) @@ -1013,7 +1000,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& call openbf(lunin,'IN',lunin) call datelen(10) -! Big loop over prepbufr file +! Big loop over prepbufr file ntb = 0 nmsg = 0 @@ -1033,14 +1020,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if(.not.lmsg(nmsg,nx)) then ntb=ntb+nrep(nmsg) cycle loop_msg ! no useable reports this mesage, skip ahead report count - end if + end if loop_readsb: do while(ireadsb(lunin) == 0) ! use msg lookup table to decide which messages to skip ! use report id lookup table to only process matching reports ntb = ntb+1 if(tab(ntb,1) <= 0 .or. tab(ntb,2) /= nx) cycle loop_readsb - + ! Extract type, date, and location information call ufbint(lunin,hdr,8,1,iret,hdstr) kx=hdr(5) @@ -1074,7 +1061,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if ! -! check VAD subtype. 1--old, 2--new, other--old +! check VAD subtype. 1--old, 2--new, other--old if(kx==224) then call ufbint(lunin,hdrtsb,1,1,iret,'TSB') if(.not.newvad .and. hdrtsb(1)==2) cycle loop_readsb @@ -1083,7 +1070,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& !* thin new VAD in time level if(kx==224.and.newvad)then icase=0 - if ( vad_near_analtime ) then + if ( vad_near_analtime ) then if(abs(hdr(4))<0.25_r_kind) icase=1 else if(abs(hdr(4))>0.17_r_kind.and.abs(hdr(4))<0.32_r_kind) icase=1 @@ -1137,7 +1124,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& !------------------------------------------------------------------------ if(offtime_data) then - + ! in time correction for observations to account for analysis ! time being different from obs file time. write(date,'( i10)') idate @@ -1154,9 +1141,9 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& idate5(4)=iadate(4) idate5(5)=0 call w3fs21(idate5,minan) ! analysis ref time in minutes relative to historic date - + ! Add obs reference time, then subtract analysis time to get obs time relative to analysis - + time_correction=real(minobs-minan,r_kind)*r60inv else @@ -1174,7 +1161,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if if(use_prepb_satwnd .and. (kx >= 240 .and. kx <= 260)) iobsub = hdr(7) - + ! Balloon drift information available for these data driftl=kx==120.or.kx==220.or.kx==221 @@ -1214,7 +1201,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& c_prvstg=cspval c_sprvstg=cspval endif - + ! Extract data information on levels call ufbint(lunin,obsdat,13,255,levs,obstr) if (twodvar_regional) then @@ -1235,7 +1222,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& call ufbevn(lunin,tpc,1,255,20,levs,'TPC') ! If available, get obs errors from error table - + if(oberrflg .and. kx<= 300)then ! Set lower limits for observation errors @@ -1275,7 +1262,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& do k=1,levs ppb=obsdat(1,k) cat=nint(min(obsdat(10,k),qcmark_huge)) - if ( cat /=0 ) cycle + if ( cat /=0 ) cycle ppb=max(zero,min(ppb,r2000)) if(ppb>=etabl_ps(itypex,1,1)) k1_ps=1 do kl=1,32 @@ -1317,7 +1304,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& endif enddo if( ncount_t ==1) then - write(6,*) 'READ_PREPBUFR,WARNING!! tob:cannot find subtyep in the error,& + write(6,*) 'READ_PREPBUFR,WARNING!! tob:cannot find subtyep in the error,& table,itype,iosub=',itypex,icsubtype(nc) write(6,*) 'read error table at colomn subtype as 0,error table column=',ierr_t endif @@ -1367,7 +1354,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& endif enddo if(ncount_q ==1 ) then - write(6,*) 'READ_PREPBUFR,WARNING!! qob:cannot find subtyep in the & + write(6,*) 'READ_PREPBUFR,WARNING!! qob:cannot find subtyep in the & error table,itype,iosub=',itypex,icsubtype(nc) write(6,*) 'read error table at colomn subtype as 0,error table column=',ierr_q endif @@ -1538,8 +1525,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! If data with drift position, get drift information if(driftl)call ufbint(lunin,drfdat,8,255,iret,drift) - -! raob level enhancement on temp and q obs + +! raob level enhancement on temp and q obs ! (note: levs is increased by sonde_ext, and not same as original value read from prepbufr) if(ext_sonde .and. kx==120) call sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levs,kx,vtcd) @@ -1562,13 +1549,13 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& else if (aircraft_t_bc_pof) then call ufbint(lunin,aircraftwk,2,255,levs,aircraftstr) aircraftwk(2,:) = bmiss - if (kx==130) aircraftwk(1,:) = 3.0_r_kind + if (kx==130) aircraftwk(1,:) = 3.0_r_kind else if (aircraft_t_bc_ext) then call ufbint(lunin,aircraftwk,2,255,levs,aircraftstr) aircraftwk(2,:) = bmiss end if end if - else if(sstob)then + else if(sstob)then sstdat=bmiss call ufbint(lunin,sstdat,8,1,levs,sststr) else if(metarcldobs) then @@ -1686,7 +1673,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end do end if -! Re-set idx if idx>ntail +! Re-set idx if idx>ntail if (idx>ntail) idx = 0 end if end if @@ -1799,7 +1786,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& dx = dlon-klon1; dy = dlat-klat1 dx1 = one-dx; dy1 = one-dy w00=dx1*dy1; w10=dx1*dy; w01=dx*dy1; w11=dx*dy - + klat1=min(max(1,klat1),nlat); klon1=min(max(0,klon1),nlon) if (klon1==0) klon1=nlon klatp1=min(nlat,klat1+1); klonp1=klon1+1 @@ -1831,7 +1818,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Extract quality marks if(tob)then qm=tqm(k) - else if(uvob) then + else if(uvob) then qm=wqm(k) else if(spdob) then qm=wqm(k) @@ -1874,7 +1861,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& cldchqm=0 qm=cldchqm else if(metarcldobs) then - qm=0 + qm=0 else if(goesctpobs) then qm=0 else if(tcamtob) then @@ -1884,7 +1871,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& qm=0 if (kx==151)pqm=0 !Make sure GOESND data are not rejected due to the pressure quality mark end if - + ! Check qc marks to see if obs should be processed or skipped @@ -1947,7 +1934,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& endif end if -! If needed, extract drift information. +! If needed, extract drift information. if(driftl)then if(drfdat(1,k) >= r360)drfdat(1,k)=drfdat(1,k)-r360 if(drfdat(1,k) < zero)drfdat(1,k)=drfdat(1,k)+r360 @@ -1967,7 +1954,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& timeobs = real(real(drfdat(3,k),r_single),r_double) time_drift = timeobs + time_correction if (abs(time_drift-time)>four) time_drift = time - + ! Check to see if the time is outside range if (l4dvar.or.l4densvar) then t4dv=toff+time_drift @@ -1987,10 +1974,10 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& dlon_earth_deg = drfdat(1,k) dlat_earth = drfdat(2,k) * deg2rad dlon_earth = drfdat(1,k) * deg2rad - + if(regional)then call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside) - if(outside) cycle LOOP_K_LEVS + if(outside) cycle LOOP_K_LEVS else dlat = dlat_earth dlon = dlon_earth @@ -2027,7 +2014,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& endif end if -! Missing Values ==> Cycling! In this case for howv only. #ww3 +! Missing Values ==> Cycling! In this case for howv only. #ww3 if (howvob .and. owave(1,k) > r0_1_bmiss) cycle LOOP_K_LEVS ! Over-ride QM=9 and hard-wire errors for land obs and hofx_sfc_file option @@ -2038,14 +2025,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& tqm(k)=2 obserr(3,k)=2.0_r_double endif - if (qob .and. qm == 9 ) then + if (qob .and. qm == 9 ) then qm=2 qqm(k) = 2 ! qob err specified as fraction of qsat, multiplied by 10. obserr(2,k)=1.0_r_double endif endif -! Set usage variable +! Set usage variable usage = zero if((gustob .and. obsdat(8,k) > r0_1_bmiss) .or. & (visob .and. obsdat(9,k) > r0_1_bmiss) .or. & @@ -2054,7 +2041,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& (mxtmob .and. maxtmint(1,k) > r0_1_bmiss) .or. & (mitmob .and. maxtmint(2,k) > r0_1_bmiss) .or. & (howvob .and. owave(1,k) > r0_1_bmiss) .or. & - (cldchob .and. cldceilh(1,k) > r0_1_bmiss))then + (cldchob .and. cldceilh(1,k) > r0_1_bmiss))then usage=103._r_kind else if(convobs .and. pqm(k) >=lim_qm )then usage=102._r_kind @@ -2067,7 +2054,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& windbiasfact=one - if (sfctype) then + if (sfctype) then if (i_gsdsfc_uselist==1 ) then if (kx==188 .or. kx==195 .or. kx==288.or.kx==295) & call apply_gsd_sfcuselist(kx,obstype,c_station_id,c_prvstg,c_sprvstg, & @@ -2113,8 +2100,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if(abs(obsdat(5,k))<0.01_r_kind .and. abs(obsdat(6,k))<0.01_r_kind) usage=115._r_kind endif if (qob .and. (kx >=180 .and. kx<=189) .and. obsdat(2,k) < 1.0e10_r_kind) then ! for 2-m dew point - if(obsdat(12,k) < min(-40.0_r_kind,obsdat(3,k)-10.0_r_kind)) usage=116._r_kind ! < min(-40C or T-Td) - if((obsdat(3,k)-obsdat(12,k)) > 70.0_r_kind) usage=117._r_kind ! <70C + if(obsdat(12,k) < min(-40.0_r_kind,obsdat(3,k)-10.0_r_kind)) usage=116._r_kind ! < min(-40C or T-Td) + if((obsdat(3,k)-obsdat(12,k)) > 70.0_r_kind) usage=117._r_kind ! <70C if(obsdat(12,k) > 32.2_r_kind) usage=118._r_kind ! > 90F endif endif @@ -2133,9 +2120,9 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if(mod(ndata+1,ncnumgrp(nc))== ncgroup(nc)-1)usage=ncmiter(nc) end if -! Flag regional MAP wind above 400mb for monitoring +! Flag regional MAP wind above 400mb for monitoring if(regional .and. kx==227 .and. obsdat(1,k)<400._r_kind ) usage=r100 - + ! don't use MESONET psfc obs if 8th character of station id is "x") if( kx==188 .and. psob .and. sidchr(8)=='x' ) usage=r100 @@ -2143,7 +2130,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& inflate_error=.false. if (qm==3 .or. qm==7) inflate_error=.true. - if(uvob) then + if(uvob) then selev=stnelev oelev=obsdat(4,k) if(kx >= 280 .and. kx < 300 )then @@ -2159,7 +2146,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& oelev=r20 end if end if - + if (kx == 282) oelev=r20+selev if (kx == 285 .or. kx == 289 .or. kx == 290) then oelev=selev @@ -2225,7 +2212,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Special block for data thinning - if requested if (ithin > 0 .and. ithin <5 .and. usage <100.0_r_kind) then ! if (ithin > 0 .and. ithin <5) then - + ! Set data quality index for thinning if (thin4d) then timedif = zero @@ -2276,12 +2263,12 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,tsavg,ff10,sfcr,zz) - if(lhilbert) & + if(lhilbert) & call accum_hilbertcurve(usage,c_station_id,c_prvstg,c_sprvstg, & dlat_earth,dlon_earth,dlat,dlon,t4dv,toff,nc,kx,iout) ! If a ship pressure observation with a zero height, reset pressure to sea level pressure -! Meta Sienkiewicz has discovered that when measured pressure and sea-level pressure +! Meta Sienkiewicz has discovered that when measured pressure and sea-level pressure ! disagree when the height is zero, it usually means the height is not being properly reported. if (psob .and. kx==180 .and. abs(obsdat(4,k))= 8 .or. usage >= 100.0_r_kind)then rusage(iout)=.false. end if - + ! Temperature if(tob) then ppb=obsdat(1,k) @@ -2302,7 +2289,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& call errormod(pqm,tqm,levs,plevs,errout,k,presl,dpres,nsig,lim_qm) end if toe=obserr(3,k)*errout - qtflg=tvflg(k) + qtflg=tvflg(k) if (inflate_error) toe=toe*r1_2 if(ppb < r100)toe=toe*r1_2 if (aircraft_t_bc .and. kx==130 .and. ppb>=500.0_r_kind) toe=toe*r10 @@ -2317,7 +2304,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& cdata_all(8,iout)=nc ! type cdata_all(9,iout)=qtflg ! qtflg (virtual temperature flag) cdata_all(10,iout)=tqm(k) ! quality mark - cdata_all(11,iout)=obserr(3,k) ! original obs error + cdata_all(11,iout)=obserr(3,k) ! original obs error cdata_all(12,iout)=usage ! usage parameter if (lhilbert) thisobtype_usage=12 ! save INDEX of where usage is stored for hilbertcurve cross validation (if requested) cdata_all(13,iout)=idomsfc ! dominate surface type @@ -2342,8 +2329,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if (twodvar_regional) & call adjust_error(cdata_all(17,iout),cdata_all(18,iout),cdata_all(11,iout),cdata_all(1,iout)) -! Winds - else if(uvob) then +! Winds + else if(uvob) then if (aircraftobs .and. aircraft_t_bc .and. acft_profl_file) then call errormod_aircraft(pqm,wqm,levs,plevs,errout,k,presl,dpres,nsig,lim_qm,hdr3) @@ -2369,7 +2356,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if (kx==288.or.kx==295) then uob=uob*windbiasfact vob=vob*windbiasfact - endif + endif endif cdata_all(1,iout)=woe ! wind error @@ -2386,7 +2373,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& cdata_all(12,iout)=wqm(k) ! quality mark cdata_all(13,iout)=obserr(5,k) ! original obs error cdata_all(14,iout)=usage ! usage parameter - if (lhilbert) thisobtype_usage=14 ! save INDEX of where usage + if (lhilbert) thisobtype_usage=14 ! save INDEX of where usage ! is stored for hilbertcurve cross validation (if requested) cdata_all(15,iout)=idomsfc ! dominate surface type cdata_all(16,iout)=tsavg ! skin temperature @@ -2399,14 +2386,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& cdata_all(23,iout)=r_sprvstg(1,1) ! subprovider name cdata_all(24,iout)=obsdat(10,k) ! cat cdata_all(25,iout)=var_jb(5,k) ! non linear qc parameter - cdata_all(26,iout)=one ! hilbert curve weight, modified later + cdata_all(26,iout)=one ! hilbert curve weight, modified later cdata_all(27,iout)=windbiasfact ! bias correction factor if(perturb_obs)then cdata_all(28,iout)=ran01dom()*perturb_fact ! u perturbation cdata_all(29,iout)=ran01dom()*perturb_fact ! v perturbation endif - - else if(spdob) then + + else if(spdob) then woe=obserr(5,k) if (inflate_error) woe=woe*r1_2 elev=r20 @@ -2442,7 +2429,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& cdata_all(22,iout)=r_prvstg(1,1) ! provider name cdata_all(23,iout)=r_sprvstg(1,1) ! subprovider name -! Surface pressure +! Surface pressure else if(psob) then poe=obserr(1,k)*one_tenth ! convert from mb to cb @@ -2461,7 +2448,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& cdata_all(10,iout)=pqm(k) ! quality mark cdata_all(11,iout)=obserr(1,k)*one_tenth ! original obs error (cb) cdata_all(12,iout)=usage ! usage parameter - if (lhilbert) thisobtype_usage=12 ! save INDEX of where usage is stored + if (lhilbert) thisobtype_usage=12 ! save INDEX of where usage is stored ! for hilbertcurve cross validation (if requested) cdata_all(13,iout)=idomsfc ! dominate surface type cdata_all(14,iout)=dlon_earth_deg ! earth relative longitude (degrees) @@ -2470,12 +2457,12 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& cdata_all(17,iout)=zz ! terrain height at ob location cdata_all(18,iout)=r_prvstg(1,1) ! provider name cdata_all(19,iout)=r_sprvstg(1,1) ! subprovider name - cdata_all(20,iout)=var_jb(1,k) ! non linear qc b parameter + cdata_all(20,iout)=var_jb(1,k) ! non linear qc b parameter if(perturb_obs)cdata_all(21,iout)=ran01dom()*perturb_fact ! ps perturbation if (twodvar_regional) & call adjust_error(cdata_all(14,iout),cdata_all(15,iout),cdata_all(11,iout),cdata_all(1,iout)) -! Specific humidity +! Specific humidity else if(qob) then qmaxerr=emerr if (aircraftobs .and. aircraft_t_bc .and. acft_profl_file) then @@ -2494,11 +2481,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if (tqm4q(1,k) zero .and. obsdat(9,k)<=vis_thres) !...................................................................... if(obsdat(9,k) < zero) then - cdata_all(4,iout)=bmiss + cdata_all(4,iout)=bmiss elseif(obsdat(9,k)> r0_1_bmiss)then cdata_all(4,iout)=obsdat(9,k) elseif(obsdat(9,k)> vis_thres .and. obsdat(9,k)<= r0_1_bmiss )then @@ -2744,7 +2731,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& qobcon=obsdat(2,k)*convert tdry=r999 if (tqm(k) zero .and. obsdat(x,k)<=cldch_thres) !...................................................................... if(cldceilh(1,k) < zero) then cdata_all(4,iout)=bmiss elseif (cldceilh(1,k)> r0_1_bmiss) then - cdata_all(4,iout)=cldceilh(1,k) + cdata_all(4,iout)=cldceilh(1,k) elseif (cldceilh(1,k)>=cldch_thres .and. cldceilh(1,k)<= r0_1_bmiss) then cldceilh(1,k)=cldch_thres else @@ -3127,7 +3114,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Apply hilbert curve for cross validation if requested if(lhilbert) then - call apply_hilbertcurve(ndata,obstype,cdata_all(thisobtype_usage,1:ndata)) + call apply_hilbertcurve(ndata,obstype,cdata_all(thisobtype_usage,1:ndata)) do i=1,ndata if(cdata_all(thisobtype_usage,i) >= 100._r_kind) rusage(i) = .false. @@ -3157,12 +3144,12 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! pmot=1 - all obs ! pmot=2 - use obs ! pmot=3 - use obs + thin obs - + if((pmot == 0 .and. .not. rthin(i)) .or. & (pmot == 1) .or. & (pmot == 2 .and. (rusage(i) .and. .not. rthin(i))) .or. & (pmot == 3 .and. rusage(i))) then - + if(rthin(i) .and. iqm > 0)cdata_all(iqm,i)=14 if(.not. rusage(i))cdata_all(iuse,i) = max(cdata_all(iuse,i),101.0_r_kind) ndata=ndata+1 @@ -3271,7 +3258,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ntype_arr=0 ntime=1 index_arr=0 - + do k=1,ndata ikx=nint(cdata_all(10,k)) if (ikx>0) then @@ -3311,7 +3298,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& data_hilb(2,ndata_hil,ntime),& cdata_all(4,k),data_hilb(3,ndata_hil,ntime) endif - endif + endif endif enddo rmesh=rmesh*1000.0_r_kind @@ -3338,12 +3325,12 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& do i=1,ndata cdata_all(26,i)=wght_hilb(i) enddo - + deallocate(wght_hilb) endif ! end of hilbert curve - - + + ! define a closest METAR cloud observation for each grid point @@ -3417,7 +3404,7 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) ! ! abstract: This routine adds bogus raob so that at least one report ! at each model layer, by interpolate between a significant -! report and the neighboring obs +! report and the neighboring obs ! ! program history log: ! @@ -3438,11 +3425,7 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) ! !INPUT PARAMETERS: integer(i_kind) , intent(in ) ::kx -#ifdef BUFR12 integer(i_kind) , intent(in ) ::vtcd -#else - real(r_double) , intent(in ) ::vtcd -#endif ! !INPUT/OUTPUT PARAMETERS: integer(i_kind) , intent(inout) ::levsio real(r_double),dimension(13,255), intent(inout) :: obsdat diff --git a/src/gsi/satthin.F90 b/src/gsi/satthin.F90 index 535305283..99f50abab 100644 --- a/src/gsi/satthin.F90 +++ b/src/gsi/satthin.F90 @@ -36,12 +36,12 @@ module satthin ! 2012-01-31 hchuang - add read_nemsnst in sub getnst ! 2012-03-05 akella - remove create_nst,getnst and destroy_nst; nst fields now handled by gsi_nstcoupler ! 2015-05-01 li - modify to use single precision for the variables read from sfc files -! 2016-08-18 li - tic591: when use_readin_anl_sfcmask is true, -! add read sili_anl from analysis grid/resolution sfc file (sfcf06_anl) +! 2016-08-18 li - tic591: when use_readin_anl_sfcmask is true, +! add read sili_anl from analysis grid/resolution sfc file (sfcf06_anl) ! modify to use isli_anl -! determine sno2 with interpolate, accordingly +! determine sno2 with interpolate, accordingly ! use the modified 2d interpolation (sfc_interpolate to intrp22) -! 2018-05-21 j.jin - add an option for time-thinning. Check time preference (including thin4d) here. +! 2018-05-21 j.jin - add an option for time-thinning. Check time preference (including thin4d) here. ! ! 2019-07-09 todling - revisit Li''s shuffling of nst init, read and final routines ! 2019-08-08 j.jin - add a comment block for an example of dtype-wise time-thinning @@ -65,11 +65,11 @@ module satthin ! []_makegvals - set up for superob weighting ! []_getsfc - create full horizontal fields of surface arrays ! []_makegrids - set up thinning grids -! []_tdiff2crit - get time preference and time cell id in time-thinning +! []_tdiff2crit - get time preference and time cell id in time-thinning ! []_map2tgrid - map observation to location on thinning grid ! []_checkob - intermediate ob checking to see if it should not be used ! []_finalcheck - the final criterion check for sat obs and increments counters -! combine_radobs - +! combine_radobs - ! []_destroygrids - deallocate thinning grid arrays ! []_destroy_sfc - deallocate full horizontal fields of surface arrays ! @@ -104,12 +104,12 @@ module satthin ! > ! ptime: Time interval (hour) for thinning radiance and ozone data. ! > ! It defines the number of time thinning bins (time_window/ptime). ! > ! 0, only one time thinning bin, by default. -! > ! ithin_time: Time preference is given -! > ! 1, (default) at the center time when thin4d=false, or +! > ! ithin_time: Time preference is given +! > ! 1, (default) at the center time when thin4d=false, or ! > ! observation time is ignored when thin4d=true. ptime must be 0.0; ! > ! 2, at the center of time intervals (suppressing thin4d); ! > ! 3, at the end of time intervals (suppressing thin4d); -! > ! 4, at the beginning, middle, and end of the 1st, 2nd,and 3rd two-hour +! > ! 4, at the beginning, middle, and end of the 1st, 2nd,and 3rd two-hour ! > ! time interval, respectively. ptime must be 2.0 (suppressing thin4d); ! > ! 5, select observations at random time, and ptime must be 0.0 ! > ! (Only applicable to seviri data, May 2018). @@ -120,8 +120,8 @@ module satthin ! > seviri m10 seviri_m10 2.0 4 ! > seviri m11 seviri_m11 2.0 4 ! > :: -! -! details through an info file. +! +! details through an info file. ! ! attributes: ! language: f90 @@ -135,6 +135,7 @@ module satthin use constants, only: deg2rad,rearth_equator,zero,two,pi,half,one,& rad2deg,r1000 use chemmod, only: laeroana_fv3smoke + use sp_mod, only: splat implicit none @@ -163,7 +164,7 @@ module satthin integer(i_kind) itxmax0 integer(i_kind), save:: itx_all integer(i_kind),dimension(0:51):: istart_val - + integer(i_kind),allocatable,dimension(:):: mlon logical,allocatable,dimension(:)::icount @@ -185,7 +186,7 @@ module satthin real(r_single), allocatable, dimension(:,:) :: zs_full_gfs ! declare the dummy variables of routine read_gfssfc_anl integer(i_kind),allocatable, dimension(:,:) :: isli_anl -! declare local array sno_anl +! declare local array sno_anl real(r_single),allocatable, dimension(:,:,:) :: sno_anl ! declare the dummy variables of routine berror_read_hsst real(r_single), allocatable, dimension(:,:) :: hsst @@ -197,7 +198,7 @@ module satthin subroutine makegvals !$$$ subprogram documentation block ! . . . . -! subprogram: makegvals +! subprogram: makegvals ! prgmmr: derber org: np23 date: 2002-10-17 ! ! abstract: This routine allocates and initializes arrays @@ -208,7 +209,7 @@ subroutine makegvals ! 2004-06-22 treadon - update documentation ! 2004-12-09 treadon - allocate thinning grids consistent with analysis domain ! 2006-07-28 derber - use r1000 from constants -! 2007-05-01 wu - correct error which incorrectly defines longitude range +! 2007-05-01 wu - correct error which incorrectly defines longitude range ! on regional grid when domain includes north pole. ! 2008-05-23 safford - rm unused vars ! 2008-09-08 lueken - merged ed's changes into q1fy09 code @@ -252,7 +253,7 @@ subroutine makegvals do i=1,ndat maxthin=max(maxthin,abs(dthin(i))) end do -! Check if there are any time-thinning +! Check if there are any time-thinning allocate(n_tbin_m1(0:maxthin)) n_tbin_m1 = 0 do i=1,ndat @@ -317,7 +318,7 @@ subroutine makegvals glatx = rlat_min + (j-1)*delat glatx = glatx*deg2rad glatm = glatx + dgv*deg2rad - + factor = abs(cos(abs(glatm))) if (dmesh(ii)>zero) then mlonj = nint(mlonx*factor) @@ -333,19 +334,19 @@ subroutine makegvals enddo enddo - istart_val(ii+1) = istart_val(ii+1)+ & + istart_val(ii+1) = istart_val(ii+1)+ & (istart_val(ii+1)-istart_val(ii))*n_tbin_m1(ii) end if end do superp=istart_val(maxthin+1) - + ! Allocate and initialize arrays for superobs weighthing allocate(super_val(0:superp),super_val1(0:superp)) do i=0,superp super_val(i)=zero end do - deallocate(n_tbin_m1) - + deallocate(n_tbin_m1) + return end subroutine makegvals @@ -353,7 +354,7 @@ end subroutine makegvals subroutine makegrids(rmesh,ithin,n_tbin,itxmax_in) !$$$ subprogram documentation block ! . . . . -! subprogram: makegrids +! subprogram: makegrids ! prgmmr: treadon org: np23 date: 2002-10-17 ! ! abstract: This routine sets up dimensions for and allocates @@ -368,7 +369,7 @@ subroutine makegrids(rmesh,ithin,n_tbin,itxmax_in) ! 2015-03-23 zaizhong ma - changed itxmax=1e9 for Himawari-8 ahi read in ! ! input argument list: -! rmesh - mesh size (km) of thinning grid. If (rmesh <= one), +! rmesh - mesh size (km) of thinning grid. If (rmesh <= one), ! then no thinning of the data will occur. Instead, ! all data will be used without thinning. ! n_tbin - (optional) number of time intervals. @@ -466,7 +467,7 @@ subroutine makegrids(rmesh,ithin,n_tbin,itxmax_in) end do if (present(n_tbin)) then - itxmax0 = itxmax + itxmax0 = itxmax itxmax = itxmax0 * n_tbin endif @@ -505,7 +506,7 @@ subroutine getsfc(mype,mype_io,use_sfc,use_sfc_any) ! prgmmr: parrish org: np23 date: 2006-02-02 ! ! abstract: This routine converts subdomain surface fields in -! guess_grids to full horizontal fields for use in +! guess_grids to full horizontal fields for use in ! reading of observations. ! ! program history log: @@ -677,7 +678,7 @@ subroutine getsfc(mype,mype_io,use_sfc,use_sfc_any) veg_type_full,soil_type_full,zs_full_gfs,isli_full,use_sfc_any) if ( use_readin_anl_sfcmask ) then - call read_gfssfc_anl(mype_io,isli_anl) + call read_gfssfc_anl(mype_io,isli_anl) endif endif ! @@ -695,7 +696,7 @@ subroutine getsfc(mype,mype_io,use_sfc,use_sfc_any) if (bcoption>0) then if (mype==0) write(6,*)'GETSFC: add bias correction to guess field ', trim(filename) - + ! Correct Tskin over the full grid if(nlon == nlon_sfc .and. nlat == nlat_sfc)then call bkg_bias_model(work2,'sst',bias_hour,ierror) @@ -704,7 +705,7 @@ subroutine getsfc(mype,mype_io,use_sfc,use_sfc_any) call mpi_allgatherv(zsm,ijn(mm1),mpi_rtype,& work1,ijn,displs_g,mpi_rtype,& mpi_comm_world,ierror) - + do k=1,iglobal i=ltosi(k) ; j=ltosj(k) bias(i,j)=nint(work1(k)) @@ -724,7 +725,7 @@ subroutine getsfc(mype,mype_io,use_sfc,use_sfc_any) end if end if - else ! for regional + else ! for regional #else /* HAVE_ESMF */ ! ! read NSST variables while .not. sfcnst_comb (in sigio or nemsio) @@ -902,7 +903,7 @@ subroutine getsfc(mype,mype_io,use_sfc,use_sfc_any) deallocate(work) endif endif - endif + endif ! find subdomain for isli2 if (nlon == nlon_sfc .and. nlat == nlat_sfc) then @@ -999,13 +1000,13 @@ subroutine map2tgrid(dlat_earth,dlon_earth,dist1,crit1,itx,ithin,itt,iuse,sis,it ! crit1 - quality indicator for observation (smaller = better) ! ithin - number of obs to retain per thinning grid box ! sis - sensor/instrument/satellite -! it_mesh - time meth id +! it_mesh - time meth id ! ! output argument list: ! itx - combined (i,j) index of observation on thinning grid ! itt - superobs thinning counter ! iuse - .true. if observation should be used -! +! ! ! attributes: ! language: f90 @@ -1043,7 +1044,7 @@ subroutine map2tgrid(dlat_earth,dlon_earth,dist1,crit1,itx,ithin,itt,iuse,sis,it return end if -! Compute (i,j) indices of coarse mesh grid (grid number 1) which +! Compute (i,j) indices of coarse mesh grid (grid number 1) which ! contains the current observation. dlat1=dlat_earth dlon1=dlon_earth @@ -1076,8 +1077,8 @@ subroutine map2tgrid(dlat_earth,dlon_earth,dist1,crit1,itx,ithin,itt,iuse,sis,it ! if ( dx > zero ) ratio=dy/dx ! dista=sin(two*atan(ratio)) ! distb=sin(pi*dx) !dista+distb is max at grid box center -! dist1=one - quarter*(dista + distb) !dist1 is min at grid box center and - !ranges from 1 (at corners)to +! dist1=one - quarter*(dista + distb) !dist1 is min at grid box center and + !ranges from 1 (at corners)to !.5 (at center of box) iuse=.true. @@ -1278,7 +1279,7 @@ subroutine checkob(dist1,crit1,itx,iuse) ! ! output argument list: ! iuse - .true. if observation should be used -! +! ! ! attributes: ! language: f90 @@ -1305,7 +1306,7 @@ subroutine finalcheck(dist1,crit1,itx,iuse) ! subprogram: finalcheck ! prgmmr: derber org: np23 date: 2002-10-17 ! -! abstract: This routine performs the final criterion check for sat +! abstract: This routine performs the final criterion check for sat ! obs and increments counters ! ! program history log: @@ -1318,7 +1319,7 @@ subroutine finalcheck(dist1,crit1,itx,iuse) ! ! output argument list: ! iuse - .true. if observation should be used -! +! ! ! attributes: ! language: f90 @@ -1526,22 +1527,22 @@ subroutine indexx(n,arr,indx) parameter (m=7,nstack=500) integer(i_kind) i,indxt,ir,itemp,j,jstack,k,l,istack(nstack) real(r_kind) a - + do j=1,n indx(j)=j end do jstack=0 l=1 ir=n - - loop0: do - + + loop0: do + if(ir-l&2 fi diff --git a/ush/module-setup.sh b/ush/module-setup.sh index 66e44ea4f..e7f1d106c 100755 --- a/ush/module-setup.sh +++ b/ush/module-setup.sh @@ -1,14 +1,7 @@ #!/bin/bash set -eu -if [[ $MACHINE_ID = jet* ]] ; then - # We are on NOAA Jet - if ( ! eval module help > /dev/null 2>&1 ) ; then - source /apps/lmod/lmod/init/bash - fi - module purge - -elif [[ $MACHINE_ID = hera* ]] ; then +if [[ $MACHINE_ID = hera* ]] ; then # We are on NOAA Hera if ( ! eval module help > /dev/null 2>&1 ) ; then source /apps/lmod/lmod/init/bash @@ -43,50 +36,17 @@ elif [[ $MACHINE_ID = container ]] ; then fi module purge -elif [[ $MACHINE_ID = s4* ]] ; then - # We are on SSEC Wisconsin S4 - if ( ! eval module help > /dev/null 2>&1 ) ; then - source /usr/share/lmod/lmod/init/bash - fi - module purge - elif [[ $MACHINE_ID = wcoss2 || $MACHINE_ID = acorn ]]; then # We are on WCOSS2 (cactus, dogwood, or acorn) module reset -elif [[ $MACHINE_ID = stampede* ]] ; then - # We are on TACC Stampede +elif [[ $MACHINE_ID = gaeac6 ]] ; then + # We are on GAEA C6. if ( ! eval module help > /dev/null 2>&1 ) ; then - source /opt/apps/lmod/lmod/init/bash - fi - module purge - -elif [[ $MACHINE_ID = gaea* ]] ; then - # We are on GAEA. - if ( ! eval module help > /dev/null 2>&1 ) ; then - # We cannot simply load the module command. The GAEA - # /etc/profile modifies a number of module-related variables - # before loading the module command. Without those variables, - # the module command fails. Hence we actually have to source - # /etc/profile here. - source /etc/profile + source /opt/cray/pe/lmod/lmod/init/bash fi module reset -elif [[ $MACHINE_ID = expanse* ]]; then - # We are on SDSC Expanse - if ( ! eval module help > /dev/null 2>&1 ) ; then - source /etc/profile.d/modules.sh - fi - module purge - module load slurm/expanse/20.02.3 - -elif [[ $MACHINE_ID = discover* ]]; then - # We are on NCCS discover - export SPACK_ROOT=/discover/nobackup/mapotts1/spack - export PATH=$PATH:$SPACK_ROOT/bin - . $SPACK_ROOT/share/spack/setup-env.sh - elif [[ $MACHINE_ID = noaacloud* ]]; then # We are on NOAA Cloud module purge diff --git a/ush/sub_discover b/ush/sub_discover deleted file mode 100755 index 5d6364be9..000000000 --- a/ush/sub_discover +++ /dev/null @@ -1,207 +0,0 @@ -#!/bin/sh -set -x -usage="\ -Usage: $0 [options] executable [args] - where the options are: - -a account account (default: none) - -b binding run smt binding or not (default:NO) - -d dirin initial directory (default: cwd) - -e envars copy comma-separated environment variables - -g group group name - -i append standard input to command file - -j jobname specify jobname (default: executable basename) - -m machine machine on which to run (default: current) - -n write command file to stdout rather than submitting it - -o output specify output file (default: jobname.out) - -p procs[/nodes[/ppreq] - number of MPI tasks and optional nodes or Bblocking and - ppreq option (N or S) (defaults: serial, Bunlimited, S) - -q queue[/qpreq] queue name and optional requirement, e.g. dev/P - (defaults: 1 if serial or dev if parallel and none) - (queue 3 or 4 is dev or prod with twice tasks over ip) - (options: P=parallel, B=bigmem, b=batch) - -r rmem[/rcpu] resources memory and cpus/task (default: '1024 mb', 1) - -t timew wall time limit in [[hh:]mm:]ss format (default: 900) - -u userid userid to run under (default: self) - -v verbose mode - -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or - Thh[mm] (full, incremental, today or tomorrow) format - (default: now) -Function: This command submits a job to the batch queue." -subcmd="$*" -stdin=NO -nosub=NO -account="" -binding="NO" -dirin="" -envars="" -group="" -jobname="" -machine="" -output="" -procs=0 -nodes="" -ppreq="" -queue="" -qpreq="" -rmem="1024" -rcpu="1" -timew="900" -userid="" -verbose=NO -when="" -while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do - case $opt in - a) account="$OPTARG";; - b) binding="$OPTARG";; - d) dirin="$OPTARG";; - e) envars="$OPTARG";; - g) group="$OPTARG";; - i) stdin=YES;; - j) jobname=$OPTARG;; - m) machine="$OPTARG";; - n) nosub=YES;; - o) output=$OPTARG;; - p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; - q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; - r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);; - t) timew=$OPTARG;; - u) userid=$OPTARG;; - v) verbose=YES;; - w) when=$OPTARG;; - \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; - esac -done -shift $(($OPTIND-1)) -if [[ $# -eq 0 ]];then - echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 -fi -exec=$1 -if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then - exec=$(which $exec) -fi -shift -args="$*" -bn=$(basename $exec) -export jobname=${jobname:-$bn} -output=${output:-$jobname.out} -myuser=$LOGNAME -myhost=$(hostname) - -DATA=$regdir/regtests/data -mkdir -p $DATA - -#partition=${partition:-c1ms} -queue=${queue:-batch} -timew=${timew:-01:20:00} -task_node=${task_node:-$procs} -size=$((nodes*task_node)) -envars=$envars -threads=${rcpu:-1} -#envars=$envars,mpi_tasks=$procs -#Options -###PBS -l partition=c1ms,size=0528,walltime=01:20:00 -##PBS -l partition=$queue,size=$size,walltime=$timew -##PBS -S /bin/sh - -export TZ=GMT -cfile=$DATA/sub$$ -> $cfile -echo "#!/bin/sh --login" >> $cfile -echo "" >> $cfile -echo "#SBATCH --output $output" >> $cfile -echo "#SBATCH --job-name $jobname" >> $cfile -echo "#SBATCH --time=$timew" >> $cfile -echo "#SBATCH --ntasks=$procs" >> $cfile -echo "#SBATCH --nodes=$nodes" >> $cfile -echo "#SBATCH --account=$accnt" >> $cfile -echo "#SBATCH --constraint=hasw" >> $cfile -#echo "#SBATCH --qos=advda" >> $cfile -echo "#SBATCH --export=ALL" >> $cfile -echo "#SBATCH --partition=$queue" >> $cfile -#. $exec >> $cfile -#echo "/bin/sh -x $exec" >> $cfile - -echo "" >>$cfile -echo "set -x" -echo "" >>$cfile -echo "export OMP_NUM_THREADS=$threads" >> $cfile -echo "" >>$cfile -echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile -echo "" >>$cfile -echo "module use -a $modulefiles" >> $cfile -echo "module load gsi_discover.intel" >> $cfile -echo "" >>$cfile -echo "jobname=$jobname" >>$cfile -echo "" >>$cfile - -cat $exec >> $cfile - -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -#msub -I partition=$partition,size=$procs,walltime=$walltime $cfile - -#if [[ -n $when ]];then -# whena=$when -# if [[ $when = +* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d%H%M") -# ((mn+=$(echo $now|cut -c11-12))) -# [[ $mn -ge 60 ]] && ((hr+=1)) && ((mn-=60)) -# [[ $mn -lt 10 ]] && mn=0$mn -# whena=$(/nwprod/util/exec/ndate +$hr $(echo $now|cut -c1-10))$mn -# elif [[ $when = t* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d") -# whena=$now$hr$mn -# elif [[ $when = T* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d%H") -# whena=$(/nwprod/util/exec/ndate +24 $now|cut -c1-8)$hr$mn -# fi -# yr=$(echo $whena|cut -c1-4) -# mo=$(echo $whena|cut -c5-6) -# dy=$(echo $whena|cut -c7-8) -# hr=$(echo $whena|cut -c9-10) -# mn=$(echo $whena|cut -c11-12) -# [[ -n $mn ]] || mn=00 -# echo "#@ startdate = $mo/$dy/$yr $hr:$mn" -#fi >>$cfile - - -if [[ $stdin = YES ]];then - cat -fi >>$cfile -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -qsub=${qsub:-qsub} - -ofile=$DATA/subout$$ ->$ofile -chmod 777 $ofile -$qsub -V $cfile >$ofile -rc=$? -cat $ofile -if [[ -w $SUBLOG ]];then - jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) - date -u +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG -fi -#rm $cfile $ofile -#[[ $MKDATA = YES ]] && rmdir $DATA -exit $rc diff --git a/ush/sub_gaeac5 b/ush/sub_gaeac5 deleted file mode 100755 index 2ed9affe5..000000000 --- a/ush/sub_gaeac5 +++ /dev/null @@ -1,170 +0,0 @@ -#!/bin/sh --login -set -x -usage="\ -Usage: $0 [options] executable [args] - where the options are: - -a account account (default: none) - -b binding run smt binding or not (default:NO) - -d dirin initial directory (default: cwd) - -e envars copy comma-separated environment variables - -g group group name - -i append standard input to command file - -j jobname specify jobname (default: executable basename) - -m machine machine on which to run (default: current) - -n write command file to stdout rather than submitting it - -o output specify output file (default: jobname.out) - -p procs[/nodes[/ppreq] - number of MPI tasks and optional nodes or Bblocking and - ppreq option (N or S) (defaults: serial, Bunlimited, S) - -q queue[/qpreq] queue name and optional requirement, e.g. dev/P - (defaults: 1 if serial or dev if parallel and none) - (queue 3 or 4 is dev or prod with twice tasks over ip) - (options: P=parallel, B=bigmem, b=batch) - -r rmem[/rcpu] resources memory and cpus/task (default: '1024 mb', 1) - -t timew wall time limit in [[hh:]mm:]ss format (default: 900) - -u userid userid to run under (default: self) - -v verbose mode - -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or - Thh[mm] (full, incremental, today or tomorrow) format - (default: now) -Function: This command submits a job to the batch queue." -subcmd="$*" -stdin=NO -nosub=NO -account="" -binding="NO" -dirin="" -envars="" -group="" -jobname="" -machine="" -output="" -procs=0 -nodes="" -ppreq="" -queue="" -qpreq="" -rmem="1024" -rcpu="1" -timew="900" -userid="" -verbose=NO -when="" -while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do - case $opt in - a) account="$OPTARG";; - b) binding="$OPTARG";; - d) dirin="$OPTARG";; - e) envars="$OPTARG";; - g) group="$OPTARG";; - i) stdin=YES;; - j) jobname=$OPTARG;; - m) machine="$OPTARG";; - n) nosub=YES;; - o) output=$OPTARG;; - p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; - q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; - r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);; - t) timew=$OPTARG;; - u) userid=$OPTARG;; - v) verbose=YES;; - w) when=$OPTARG;; - \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; - esac -done -shift $(($OPTIND-1)) -if [[ $# -eq 0 ]];then - echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 -fi -exec=$1 -if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then - exec=$(which $exec) -fi -shift -args="$*" -bn=$(basename $exec) -export jobname=${jobname:-$bn} -output=${output:-$jobname.out} -myuser=$LOGNAME -myhost=$(hostname) - -if [ -d /gpfs/f5/ufs-ard/scratch/${USER}/$LOGNAME ]; then - DATA=/gpfs/f5/ufs-ard/scratch/${USER}/$LOGNAME/tmp -fi -DATA=${DATA:-$ptmp/tmp} - -mkdir -p $DATA - -queue=${queue:-batch} -timew=${timew:-01:20:00} -task_node=${task_node:-$procs} -size=$((nodes*task_node)) -envars=$envars -threads=${rcpu:-1} - -export TZ=GMT -cfile=$DATA/sub$$ -> $cfile -echo "#!/bin/bash -l" >> $cfile -echo "" >> $cfile -echo "#SBATCH --output=$output" >> $cfile -echo "#SBATCH --job-name=$jobname" >> $cfile -echo "#SBATCH --qos=$queue" >> $cfile -echo "#SBATCH --clusters=c5" >> $cfile -echo "#SBATCH --time=$timew" >> $cfile -echo "#SBATCH --nodes=$nodes --ntasks-per-node=$procs --cpus-per-task=$threads" >> $cfile -echo "#SBATCH --account=$accnt" >> $cfile -echo "#SBATCH --mem=0" >> $cfile - -echo "" >>$cfile -echo "export ntasks=$(( $nodes * $procs ))" >> $cfile -echo "export ppn=$procs" >> $cfile -echo "export threads=$threads" >> $cfile -echo "export OMP_NUM_THREADS=$threads" >> $cfile -echo "ulimit -s unlimited" >> $cfile - -echo "" >>$cfile -echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile -echo "" >>$cfile - -echo "module reset" >> $cfile -echo "module use $modulefiles" >> $cfile -echo "module load gsi_gaeac5.intel" >> $cfile -echo "module list" >> $cfile -echo "" >>$cfile - -cat $exec >> $cfile - -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi - -if [[ $stdin = YES ]];then - cat -fi >>$cfile -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -sbatch=${sbatch:-sbatch} - -ofile=$DATA/subout$$ ->$ofile -chmod 777 $ofile -$sbatch $cfile >$ofile -rc=$? -cat $ofile -if [[ -w $SUBLOG ]];then - jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) - date -u +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG -fi -rm $cfile $ofile -[[ $MKDATA = YES ]] && rmdir $DATA -exit $rc diff --git a/ush/sub_jet b/ush/sub_jet deleted file mode 100755 index 96f3eae9b..000000000 --- a/ush/sub_jet +++ /dev/null @@ -1,169 +0,0 @@ -#!/bin/sh --login -set -x -usage="\ -Usage: $0 [options] executable [args] - where the options are: - -a account account (default: none) - -b binding run smt binding or not (default:NO) - -d dirin initial directory (default: cwd) - -e envars copy comma-separated environment variables - -g group group name - -i append standard input to command file - -j jobname specify jobname (default: executable basename) - -m machine machine on which to run (default: current) - -n write command file to stdout rather than submitting it - -o output specify output file (default: jobname.out) - -p procs[/nodes[/ppreq] - number of MPI tasks and optional nodes or Bblocking and - ppreq option (N or S) (defaults: serial, Bunlimited, S) - -q queue[/qpreq] queue name and optional requirement, e.g. dev/P - (defaults: 1 if serial or dev if parallel and none) - (queue 3 or 4 is dev or prod with twice tasks over ip) - (options: P=parallel, B=bigmem, b=batch) - -r rmem[/rcpu] resources memory and cpus/task (default: '1024 mb', 1) - -t timew wall time limit in [[hh:]mm:]ss format (default: 900) - -u userid userid to run under (default: self) - -v verbose mode - -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or - Thh[mm] (full, incremental, today or tomorrow) format - (default: now) -Function: This command submits a job to the batch queue." -subcmd="$*" -stdin=NO -nosub=NO -account="" -binding="NO" -dirin="" -envars="" -group="" -jobname="" -machine="" -output="" -procs=0 -nodes="" -ppreq="" -queue="" -qpreq="" -rmem="1024" -rcpu="1" -timew="900" -userid="" -verbose=NO -when="" -while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do - case $opt in - a) account="$OPTARG";; - b) binding="$OPTARG";; - d) dirin="$OPTARG";; - e) envars="$OPTARG";; - g) group="$OPTARG";; - i) stdin=YES;; - j) jobname=$OPTARG;; - m) machine="$OPTARG";; - n) nosub=YES;; - o) output=$OPTARG;; - p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; - q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; - r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);; - t) timew=$OPTARG;; - u) userid=$OPTARG;; - v) verbose=YES;; - w) when=$OPTARG;; - \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; - esac -done -shift $(($OPTIND-1)) -if [[ $# -eq 0 ]];then - echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 -fi -exec=$1 -if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then - exec=$(which $exec) -fi -shift -args="$*" -bn=$(basename $exec) -export jobname=${jobname:-$bn} -output=${output:-$jobname.out} -myuser=$LOGNAME -myhost=$(hostname) - -DATA=${DATA:-$ptmp/tmp} - -mkdir -p $DATA - -queue=${queue:-batch} -timew=${timew:-01:20:00} -task_node=${task_node:-$procs} -size=$((nodes*task_node)) -envars=$envars -threads=${rcpu:-1} - -export TZ=GMT -cfile=$DATA/sub$$ -> $cfile -echo "#!/bin/sh --login" >> $cfile -echo "" >> $cfile -echo "#SBATCH --output=$output" >> $cfile -echo "#SBATCH --job-name=$jobname" >> $cfile -echo "#SBATCH --qos=$queue" >> $cfile -echo "#SBATCH --time=$timew" >> $cfile -echo "#SBATCH --nodes=$nodes --ntasks-per-node=$procs --exclusive" >> $cfile -echo "#SBATCH --account=$accnt" >> $cfile -echo "#SBATCH --mem=0" >> $cfile -echo "#SBATCH --partition=kjet" >> $cfile - -echo "" >>$cfile -echo "export ntasks=$(( $nodes * $procs ))" >> $cfile -echo "export ppn=$procs" >> $cfile -echo "export threads=$threads" >> $cfile -echo "export OMP_NUM_THREADS=$threads" >> $cfile -echo "ulimit -s unlimited" >> $cfile - -echo "" >>$cfile -echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile -echo "" >>$cfile - -echo ". /apps/lmod/lmod/init/sh" >> $cfile -echo "module purge" >> $cfile -echo "module use $modulefiles" >> $cfile -echo "module load gsi_jet.intel" >> $cfile -echo "module list" >> $cfile -echo "" >>$cfile - -cat $exec >> $cfile - -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi - - -if [[ $stdin = YES ]];then - cat -fi >>$cfile -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -sbatch=${sbatch:-sbatch} - -ofile=$DATA/subout$$ ->$ofile -chmod 777 $ofile -$sbatch $cfile >$ofile -rc=$? -cat $ofile -if [[ -w $SUBLOG ]];then - jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) - date -u +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG -fi -rm $cfile $ofile -[[ $MKDATA = YES ]] && rmdir $DATA -exit $rc diff --git a/ush/sub_ncar b/ush/sub_ncar deleted file mode 100755 index d2887dded..000000000 --- a/ush/sub_ncar +++ /dev/null @@ -1,202 +0,0 @@ -#!/bin/sh --login -set -x -echo "starting sub_ncar" -usage="\ -Usage: $0 [options] executable [args] - where the options are: - -a account account (default: none) - -b binding run smt binding or not (default:NO) - -d dirin initial directory (default: cwd) - -e envars copy comma-separated environment variables - -g group group name - -i append standard input to command file - -j jobname specify jobname (default: executable basename) - -m machine machine on which to run (default: current) - -n write command file to stdout rather than submitting it - -o output specify output file (default: jobname.out) - -p procs[/nodes[/ppreq] - number of MPI tasks and optional nodes or Bblocking and - ppreq option (N or S) (defaults: serial, Bunlimited, S) - -q queue[/qpreq] queue name and optional requirement, e.g. dev/P - (defaults: 1 if serial or dev if parallel and none) - (queue 3 or 4 is dev or prod with twice tasks over ip) - (options: P=parallel, B=bigmem, b=batch) - -r rmem[/rcpu] resources memory and cpus/task (default: '1024 mb', 1) - -t timew wall time limit in [[hh:]mm:]ss format (default: 900) - -u userid userid to run under (default: self) - -v verbose mode - -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or - Thh[mm] (full, incremental, today or tomorrow) format - (default: now) -Function: This command submits a job to the batch queue." -subcmd="$*" -stdin=NO -nosub=NO -account="" -binding="NO" -dirin="" -envars="" -group="" -jobname="" -machine="" -output="" -procs=0 -nodes="" -ppreq="" -queue="" -qpreq="" -rmem="1024" -rcpu="1" -timew="900" -userid="" -verbose=NO -when="" -while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do - case $opt in - a) account="$OPTARG";; - b) binding="$OPTARG";; - d) dirin="$OPTARG";; - e) envars="$OPTARG";; - g) group="$OPTARG";; - i) stdin=YES;; - j) jobname=$OPTARG;; - m) machine="$OPTARG";; - n) nosub=YES;; - o) output=$OPTARG;; - p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; - q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; - r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);; - t) timew=$OPTARG;; - u) userid=$OPTARG;; - v) verbose=YES;; - w) when=$OPTARG;; - \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; - esac -done -shift $(($OPTIND-1)) -if [[ $# -eq 0 ]];then - echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 -fi -exec=$1 -if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then - exec=$(which $exec) -fi -shift -args="$*" -bn=$(basename $exec) -export jobname=${jobname:-$bn} -output=${output:-$jobname.out} -myuser=$LOGNAME -myhost=$(hostname) - -DATA=/glade/scratch/$LOGNAME/tmp -mkdir -p $DATA - -#partition=${partition:-c1ms} -#queue=${queue:-batch} -timew=${timew:-01:20:00} -task_node=${task_node:-$procs} -size=$((nodes*task_node)) -envars=$envars -threads=${rcpu:-1} -#envars=$envars,mpi_tasks=$procs -#Options -###PBS -l partition=c1ms,size=0528,walltime=01:20:00 -##PBS -l partition=$queue,size=$size,walltime=$timew -##PBS -S /bin/sh - -export TZ=GMT -cfile=$DATA/sub$$ -> $cfile -#echo "#PBS -S /bin/sh" >> $cfile -echo "#!/bin/sh --login" >> $cfile -echo "" >> $cfile -echo "#PBS -o $output" >> $cfile -echo "#PBS -N $jobname" >> $cfile -echo "#PBS -q $queue" >> $cfile -echo "#PBS -l walltime=$timew" >> $cfile -echo "#PBS -l select=$nodes:ncpus=$procs:mpiprocs=$procs" >> $cfile -echo "#PBS -j oe" >> $cfile -echo "#PBS -A "$account >> $cfile -echo "#PBS -V" >> $cfile -#echo "#PBS -d" >> $cfile -#. $exec >> $cfile -#echo "/bin/sh -x $exec" >> $cfile - -echo "" >>$cfile -echo "export OMP_NUM_THREADS=$threads" >> $cfile -echo "" >>$cfile -echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile -echo "" >>$cfile - -cat $exec >> $cfile - -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -#msub -I partition=$partition,size=$procs,walltime=$walltime $cfile - -#if [[ -n $when ]];then -# whena=$when -# if [[ $when = +* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d%H%M") -# ((mn+=$(echo $now|cut -c11-12))) -# [[ $mn -ge 60 ]] && ((hr+=1)) && ((mn-=60)) -# [[ $mn -lt 10 ]] && mn=0$mn -# whena=$(/nwprod/util/exec/ndate +$hr $(echo $now|cut -c1-10))$mn -# elif [[ $when = t* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d") -# whena=$now$hr$mn -# elif [[ $when = T* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d%H") -# whena=$(/nwprod/util/exec/ndate +24 $now|cut -c1-8)$hr$mn -# fi -# yr=$(echo $whena|cut -c1-4) -# mo=$(echo $whena|cut -c5-6) -# dy=$(echo $whena|cut -c7-8) -# hr=$(echo $whena|cut -c9-10) -# mn=$(echo $whena|cut -c11-12) -# [[ -n $mn ]] || mn=00 -# echo "#@ startdate = $mo/$dy/$yr $hr:$mn" -#fi >>$cfile - - -if [[ $stdin = YES ]];then - cat -fi >>$cfile -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -qsub=${qsub:-qsub} - -ofile=$DATA/subout$$ ->$ofile -chmod 777 $ofile -$qsub $cfile >$ofile -rc=$? -cat $ofile -if [[ -w $SUBLOG ]];then - jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) - date -u +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG -fi -#rm $cfile $ofile -[[ $MKDATA = YES ]] && rmdir $DATA -echo "ending sub_ncar" -exit $rc diff --git a/ush/sub_wcoss2 b/ush/sub_wcoss2 index e0b4a03cc..de8704c98 100755 --- a/ush/sub_wcoss2 +++ b/ush/sub_wcoss2 @@ -125,8 +125,8 @@ echo "" >> $cfile echo "module reset" >> $cfile echo "module use $modulefiles" >> $cfile -echo "module load gsi_${machine}.intel" >> $cfile echo "module load envvar/1.0" >> $cfile +echo "module load gsi_${machine}.intel" >> $cfile echo "module load cray-pals/1.2.2" >> $cfile echo "module -t list 2>&1 | while read line;do module show $line 2>&1 | sed -n -e '2p';done | sort" >> $cfile echo "module avail" >> $cfile