diff --git a/ci/spack.yaml b/ci/spack.yaml index a831de16ad..0fc66547e5 100644 --- a/ci/spack.yaml +++ b/ci/spack.yaml @@ -15,11 +15,11 @@ spack: - ip@3.3.3 - sigio@2.3.2 - sfcio@1.4.1 - - nemsio@2.5.2 + - nemsio@2.5.4 - wrf-io@1.2.0 - ncio@1.1.2 - crtm@2.4.0 - - gsi-ncdiag@1.0.0 + - gsi-ncdiag@1.1.1 view: true concretizer: unify: true diff --git a/fix b/fix index 6a42a29dbb..5722cd4d25 160000 --- a/fix +++ b/fix @@ -1 +1 @@ -Subproject commit 6a42a29dbbc9fca3453cc9e829601185555890b9 +Subproject commit 5722cd4d2519222137c5b356bdbc01bb34c5f1f4 diff --git a/modulefiles/gsi_cheyenne.gnu.lua b/modulefiles/gsi_cheyenne.gnu.lua index 494ec6fb18..43e6aaf02c 100644 --- a/modulefiles/gsi_cheyenne.gnu.lua +++ b/modulefiles/gsi_cheyenne.gnu.lua @@ -4,26 +4,24 @@ help([[ load("cmake/3.22.0") load("python/3.7.9") load("ncarenv/1.3") -load("gnu/10.1.0") -load("mpt/2.22") +load("gnu/11.2.0") +load("mpt/2.25") load("ncarcompilers/0.5.0") +unload("intel") unload("netcdf") -prepend_path("MODULEPATH", "/glade/work/epicufsrt/GMTB/tools/gnu/10.1.0/hpc-stack-v1.2.0/modulefiles/stack") +prepend_path("MODULEPATH", "/glade/work/epicufsrt/contrib/hpc-stack/gnu11.2.0/modulefiles/stack") load("hpc/1.2.0") -load("hpc-gnu/10.1.0") -load("hpc-mpt/2.22") - --- Preload w3nco to work around nemsio "find_dependency(w3nco)" hpc-stack bug -load("w3nco/2.4.1") +load("hpc-gnu/11.2.0") +load("hpc-mpt/2.25") load("gsi_common") -local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" -load(pathJoin("prod_util", prod_util_ver)) +load(pathJoin("prod_util", os.getenv("prod_util_ver") or "1.2.2")) +load(pathJoin("openblas", os.getenv("openblas_ver") or "0.3.23")) -pushenv("MKLROOT", "/glade/u/apps/opt/intel/2022.1/mkl/latest") +pushenv("GSI_BINARY_SOURCE_DIR", "/glade/work/epicufsrt/contrib/GSI_fix/fix") pushenv("CC", "mpicc") pushenv("FC", "mpif90") diff --git a/modulefiles/gsi_cheyenne.intel.lua b/modulefiles/gsi_cheyenne.intel.lua index 72bf458516..26ed666695 100644 --- a/modulefiles/gsi_cheyenne.intel.lua +++ b/modulefiles/gsi_cheyenne.intel.lua @@ -8,7 +8,7 @@ load("intel/2022.1") load("mpt/2.25") load("ncarcompilers/0.5.0") -prepend_path("MODULEPATH", "/glade/work/epicufsrt/GMTB/tools/intel/2022.1/hpc-stack-v1.2.0_6eb6/modulefiles/stack") +prepend_path("MODULEPATH", "/glade/work/epicufsrt/contrib/hpc-stack/intel2022.1/modulefiles/stack") load("hpc/1.2.0") load("hpc-intel/2022.1") @@ -17,8 +17,8 @@ load("mkl/2022.1") load("gsi_common") -local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" -load(pathJoin("prod_util", prod_util_ver)) +load(pathJoin("prod_util", os.getenv("prod_util_ver") or "1.2.2")) +pushenv("GSI_BINARY_SOURCE_DIR", "/glade/work/epicufsrt/contrib/GSI_data/fix/20230911") pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") diff --git a/modulefiles/gsi_common.lua b/modulefiles/gsi_common.lua index b2b08f1197..c54f6ddb92 100644 --- a/modulefiles/gsi_common.lua +++ b/modulefiles/gsi_common.lua @@ -6,16 +6,16 @@ local netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" local bufr_ver=os.getenv("bufr_ver") or "11.7.0" local bacio_ver=os.getenv("bacio_ver") or "2.4.1" -local w3emc_ver=os.getenv("w3emc_ver") or "2.9.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 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.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" -local ncdiag_ver=os.getenv("ncdiag_ver") or "1.0.0" +local ncdiag_ver=os.getenv("ncdiag_ver") or "1.1.1" load(pathJoin("netcdf", netcdf_ver)) @@ -31,4 +31,3 @@ load(pathJoin("wrf_io", wrf_io_ver)) load(pathJoin("ncio", ncio_ver)) load(pathJoin("crtm", crtm_ver)) load(pathJoin("ncdiag",ncdiag_ver)) - diff --git a/modulefiles/gsi_gaea b/modulefiles/gsi_gaea deleted file mode 100644 index 641f3d0fcf..0000000000 --- a/modulefiles/gsi_gaea +++ /dev/null @@ -1,62 +0,0 @@ -#%Module1.0 -###################################################################### -## NOAA-EMC/GSI -##_____________________________________________________ -proc ModulesHelp { } { -puts stderr "Set environment variables for NOAA-EMC/GSI" -puts stderr "This module initializes the environment " -puts stderr "for the Intel Compiler Suite $version\n" -} -module-whatis " NOAA-EMC/GSI whatis description" - -set COMPILER intel - -setenv FFLAGS_COM "-fp-model strict" -setenv LDFLAGS_COM " " - -#set WRF_SHARED_VER v1.1.0 -#set WRF_SHARED_ROOT /gpfs/hps/nco/ops/nwprod/wrf_shared -#set WRF_SHARED_ROOT /lustre/f1/pdata/ncep_shared/NCEPLIBS/lib/EXTERNAL/wrf_shared -#setenv WRF_SHARED_PATH ${WRF_SHARED_ROOT}.${WRF_SHARED_VER} - -setenv NCEPLIBS /lustre/f1/pdata/ncep_shared/NCEPLIBS/lib - -# Loading ncep environment -##module load ncep/1.0 -module use /opt/cray/pe/craype/2.5.5/modulefiles - -# Loading Intel Compiler Suite -module load PrgEnv-intel - -# Loading pe environment -module load cray-mpich -module load cray-libsci -module unload craype-broadwell -module load craype-haswell - -module use /sw/gaea/modulefiles -module load cmake - -# Loading nceplibs modules -module use /lustre/f1/pdata/ncep_shared/NCEPLIBS/lib/modulefiles -#module load HDF5-serial-intel-haswell/1.8.9 -#module load NetCDF-intel-haswell/4.2 -module load cray-hdf5 -module load cray-netcdf - -#module use /gpfs/hps/nco/ops/nwprod/lib/modulefiles -module load bufr-intel-sandybridge/11.0.1 -module load nemsio-intel-sandybridge/2.2.2 -module load sfcio-intel-sandybridge/1.0.0 -module load sigio-intel-sandybridge/2.0.1 -module load sp-intel-sandybridge/2.0.2 -module load w3nco-intel-sandybridge/2.0.6 -module load w3emc-intel-sandybridge/2.2.0 -module load bacio-intel-sandybridge/2.0.2 -setenv CRAYOS_VERSION $::env(CRAYPE_VERSION) -#setenv CRAYOS_VERSION ${CRAYPE_VERSION} - -# Compiler flags specific to this platform -setenv CFLAGS "-xCORE-AVX2" -setenv FFLAGS "-xCORE-AVX2" - diff --git a/modulefiles/gsi_gaea.lua b/modulefiles/gsi_gaea.lua new file mode 100644 index 0000000000..a7a2454eff --- /dev/null +++ b/modulefiles/gsi_gaea.lua @@ -0,0 +1,34 @@ +help([[ +]]) + +load("cmake/3.20.1") + +prepend_path("MODULEPATH","/lustre/f2/dev/role.epic/contrib/hpc-stack/intel-classic-2022.0.2/modulefiles/stack") +load(pathJoin("hpc", os.getenv("hpc_ver") or "1.2.0")) + +load(pathJoin("intel-classic", os.getenv("intel_classic_ver") or "2022.0.2")) +load(pathJoin("cray-mpich", os.getenv("cray_mpich_ver") or "7.7.20")) +load(pathJoin("hpc-intel-classic", os.getenv("hpc_intel_classic_ver") or "2022.0.2")) +load(pathJoin("hpc-cray-mpich", os.getenv("hpc_cray_mpich_ver") or "7.7.20")) + +load("gsi_common") + +local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +load(pathJoin("prod_util", prod_util_ver)) + +-- Needed at runtime: +load("alps") + +local MKLROOT="/opt/intel/oneapi/mkl/2022.0.2/" +prepend_path("LD_LIBRARY_PATH",pathJoin(MKLROOT,"lib/intel64")) +pushenv("MKLROOT", MKLROOT) + +pushenv("GSI_BINARY_SOURCE_DIR", "/lustre/f2/dev/role.epic/contrib/GSI_data/fix/20230911") + +setenv("CC","cc") +setenv("FC","ftn") +setenv("CXX","CC") +pushenv("CRAYPE_LINK_TYPE","dynamic") + +whatis("Description: GSI environment on Gaea with Intel Compilers") + diff --git a/modulefiles/gsi_hera.gnu.lua b/modulefiles/gsi_hera.gnu.lua index 4f0253ba4d..37504485e3 100644 --- a/modulefiles/gsi_hera.gnu.lua +++ b/modulefiles/gsi_hera.gnu.lua @@ -1,15 +1,18 @@ help([[ ]]) -prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") +prepend_path("MODULEPATH", "/scratch1/NCEPDEV/nems/role.epic/hpc-stack/libs/gnu-9.2/modulefiles/stack") -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_gnu_ver=os.getenv("hpc_gnu_ver") or "9.2.0" +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local gnu_ver=os.getenv("gnu_ver") or "9.2.0" +local hpc_gnu_ver=os.getenv("hpc_gnu_ver") or "9.2" local hpc_mpich_ver=os.getenv("hpc_mpich_ver") or "3.3.2" local cmake_ver=os.getenv("cmake_ver") or "3.20.1" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +local openblas_ver=os.getenv("openblas_ver") or "0.3.23" load(pathJoin("hpc", hpc_ver)) +load(pathJoin("gnu", gnu_ver)) load(pathJoin("hpc-gnu", hpc_gnu_ver)) load(pathJoin("hpc-mpich", hpc_mpich_ver)) load(pathJoin("cmake", cmake_ver)) @@ -17,9 +20,8 @@ load(pathJoin("cmake", cmake_ver)) load("gsi_common") load(pathJoin("prod_util", prod_util_ver)) +load(pathJoin("openblas", openblas_ver)) -pushenv("MKLROOT", "/apps/oneapi/mkl/2022.0.2") - -pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230911") whatis("Description: GSI environment on Hera with GNU Compilers") diff --git a/modulefiles/gsi_hera.intel.lua b/modulefiles/gsi_hera.intel.lua index 62a915ef72..619d0e76c9 100644 --- a/modulefiles/gsi_hera.intel.lua +++ b/modulefiles/gsi_hera.intel.lua @@ -1,13 +1,16 @@ help([[ ]]) -prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") +prepend_path("MODULEPATH", "/scratch1/NCEPDEV/nems/role.epic/miniconda3/modulefiles") +miniconda3_ver=os.getenv("miniconda3_ver") or "4.12.0" +load(pathJoin("miniconda3", miniconda3_ver)) -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2018.0.4" +prepend_path("MODULEPATH", "/scratch1/NCEPDEV/nems/role.epic/hpc-stack/libs/intel-2022.1.2/modulefiles/stack") + +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" local cmake_ver=os.getenv("cmake_ver") or "3.20.1" -local anaconda_ver=os.getenv("anaconda_ver") or "2.3.0" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("hpc", hpc_ver)) @@ -15,10 +18,6 @@ load(pathJoin("hpc-intel", hpc_intel_ver)) load(pathJoin("hpc-impi", hpc_impi_ver)) load(pathJoin("cmake", cmake_ver)) -prepend_path("MODULEPATH", "/contrib/anaconda/modulefiles") - -load(pathJoin("anaconda", anaconda_ver)) - load("gsi_common") load(pathJoin("prod_util", prod_util_ver)) @@ -26,6 +25,6 @@ load(pathJoin("prod_util", prod_util_ver)) pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") -pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230911") whatis("Description: GSI environment on Hera with Intel Compilers") diff --git a/modulefiles/gsi_jet.lua b/modulefiles/gsi_jet.lua index a769deca6f..c9e5e90680 100644 --- a/modulefiles/gsi_jet.lua +++ b/modulefiles/gsi_jet.lua @@ -1,13 +1,16 @@ help([[ ]]) -prepend_path("MODULEPATH", "/mnt/lfs4/HFIP/hfv3gfs/role.epic/hpc-stack/libs/intel-18.0.5.274/modulefiles/stack") +prepend_path("MODULEPATH", "/mnt/lfs4/HFIP/hfv3gfs/role.epic/miniconda3/modulefiles") +miniconda3_ver=os.getenv("miniconda3_ver") or "4.12.0" +load(pathJoin("miniconda3", miniconda3_ver)) + +prepend_path("MODULEPATH", "/mnt/lfs4/HFIP/hfv3gfs/role.epic/hpc-stack/libs/intel-2022.1.2/modulefiles/stack") local hpc_ver=os.getenv("hpc_ver") or "1.2.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2018.4.274" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" local cmake_ver=os.getenv("cmake_ver") or "3.20.1" -local anaconda_ver=os.getenv("anaconda_ver") or "5.3.1" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("hpc", hpc_ver)) @@ -15,10 +18,6 @@ load(pathJoin("hpc-intel", hpc_intel_ver)) load(pathJoin("hpc-impi", hpc_impi_ver)) load(pathJoin("cmake", cmake_ver)) -prepend_path("MODULEPATH", "/contrib/anaconda/modulefiles") - -load(pathJoin("anaconda", anaconda_ver)) - load("gsi_common") load(pathJoin("prod_util", prod_util_ver)) @@ -27,6 +26,6 @@ pushenv("CFLAGS", "-axSSE4.2,AVX,CORE-AVX2") pushenv("FFLAGS", "-axSSE4.2,AVX,CORE-AVX2") -pushenv("GSI_BINARY_SOURCE_DIR", "/mnt/lfs4/HFIP/hfv3gfs/glopara/git/fv3gfs/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/mnt/lfs4/HFIP/hfv3gfs/glopara/git/fv3gfs/fix/gsi/20230911") whatis("Description: GSI environment on Jet with Intel Compilers") diff --git a/modulefiles/gsi_orion.lua b/modulefiles/gsi_orion.lua index fb3df720e4..e75a01ef5e 100644 --- a/modulefiles/gsi_orion.lua +++ b/modulefiles/gsi_orion.lua @@ -1,20 +1,22 @@ help([[ ]]) -prepend_path("MODULEPATH", "/apps/contrib/NCEP/libs/hpc-stack/modulefiles/stack") +prepend_path("MODULEPATH", "/work/noaa/epic/role-epic/contrib/orion/miniconda3/modulefiles") +miniconda3_ver=os.getenv("miniconda3_ver") or "4.12.0" +load(pathJoin("miniconda3", miniconda3_ver)) -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2018.4" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2018.4" +prepend_path("MODULEPATH", "/work/noaa/epic/role-epic/contrib/orion/hpc-stack/intel-2022.1.2/modulefiles/stack") + +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" local cmake_ver=os.getenv("cmake_ver") or "3.22.1" -local python_ver=os.getenv("python_ver") or "3.7.5" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("hpc", hpc_ver)) load(pathJoin("hpc-intel", hpc_intel_ver)) load(pathJoin("hpc-impi", hpc_impi_ver)) load(pathJoin("cmake", cmake_ver)) -load(pathJoin("python", python_ver)) load("gsi_common") @@ -23,6 +25,6 @@ load(pathJoin("prod_util", prod_util_ver)) pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") -pushenv("GSI_BINARY_SOURCE_DIR", "/work/noaa/global/glopara/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/work/noaa/global/glopara/fix/gsi/20230911") whatis("Description: GSI environment on Orion with Intel Compilers") diff --git a/modulefiles/gsi_s4.lua b/modulefiles/gsi_s4.lua index 24b1f5962d..03c21e708d 100644 --- a/modulefiles/gsi_s4.lua +++ b/modulefiles/gsi_s4.lua @@ -1,9 +1,9 @@ help([[ ]]) -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.4" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "18.0.4" +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1" local miniconda_ver=os.getenv("miniconda_ver") or "3.8-s4" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" @@ -23,6 +23,6 @@ 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/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/data/prod/glopara/fix/gsi/20230911") whatis("Description: GSI environment on S4 with Intel Compilers") diff --git a/modulefiles/gsi_wcoss2.lua b/modulefiles/gsi_wcoss2.lua index 1872f89d17..e5f4c7b812 100644 --- a/modulefiles/gsi_wcoss2.lua +++ b/modulefiles/gsi_wcoss2.lua @@ -20,6 +20,6 @@ load(pathJoin("prod_util", prod_util_ver)) load("gsi_common") -pushenv("GSI_BINARY_SOURCE_DIR", "/lfs/h2/emc/global/noscrub/emc.global/FIX/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/lfs/h2/emc/global/noscrub/emc.global/FIX/fix/gsi/20230911") whatis("Description: GSI environment on WCOSS2") diff --git a/regression/regression_driver.sh b/regression/regression_driver.sh index e1d3b18dc7..821cc7cedb 100755 --- a/regression/regression_driver.sh +++ b/regression/regression_driver.sh @@ -35,9 +35,11 @@ for jn in `seq ${RSTART} ${REND}`; do if [ $jn -le 2 ]; then export scripts=${scripts_updat:-$scripts} export fixgsi=${fixgsi_updat:-$fixgsi} + export modulefiles=${modulefiles_updat:-$modulefiles} else export scripts=${scripts_contrl:-$scripts} export fixgsi=${fixgsi_contrl:-$fixgsi} + export modulefiles=${modulefiles_contrl:-$modulefiles} fi rm -f ${job[$jn]}.out diff --git a/regression/regression_param.sh b/regression/regression_param.sh index 6024dbdb54..ea27521251 100755 --- a/regression/regression_param.sh +++ b/regression/regression_param.sh @@ -18,6 +18,11 @@ case $machine in sub_cmd="sub_jet" memnode=96 numcore=40 + ;; + Gaea) + sub_cmd="sub_gaea" + memnode=64 + numcore=36 ;; wcoss2) sub_cmd="sub_wcoss2" @@ -28,7 +33,9 @@ case $machine in sub_cmd="sub_discover" ;; Cheyenne) - sub_cmd="sub_ncar -a p48503002 -q economy -d $PWD" + sub_cmd="sub_cheyenne" + memnode=128 + numcore=36 ;; *) # EXIT out for unresolved machine echo "unknown $machine" @@ -56,8 +63,11 @@ case $regtest in topts[1]="0:15:00" ; popts[1]="12/5/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="12/9/" ; ropts[2]="/2" elif [[ "$machine" = "Cheyenne" ]]; then - topts[1]="0:30:00" ; popts[1]="16/2/" ; ropts[1]="/1" - topts[2]="0:30:00" ; popts[2]="16/4/" ; ropts[2]="/2" + topts[1]="0:15:00" ; popts[1]="16/2/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="16/4/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + topts[1]="0:15:00" ; popts[1]="18/2/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="18/4/" ; ropts[2]="/2" elif [[ "$machine" = "wcoss2" ]]; then topts[1]="0:15:00" ; popts[1]="12/5/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="12/9/" ; ropts[2]="/2" @@ -86,8 +96,11 @@ case $regtest in topts[1]="0:15:00" ; popts[1]="12/3/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="12/5/" ; ropts[2]="/2" elif [[ "$machine" = "Cheyenne" ]]; then - topts[1]="0:35:00" ; popts[1]="16/2/" ; ropts[1]="/1" - topts[2]="0:25:00" ; popts[2]="16/4/" ; ropts[2]="/2" + topts[1]="0:15:00" ; popts[1]="12/3/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="12/5/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + topts[1]="0:15:00" ; popts[1]="18/2/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="18/4/" ; ropts[2]="/2" elif [[ "$machine" = "wcoss2" ]]; then topts[1]="0:15:00" ; popts[1]="28/2/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="28/4/" ; ropts[2]="/2" @@ -104,6 +117,8 @@ case $regtest in popts[1]="12/5/" elif [[ "$machine" = "Jet" ]]; then popts[1]="12/5/" + elif [[ "$machine" = "Gaea" ]]; then + popts[1]="18/5/" elif [[ "$machine" = "wcoss2" ]]; then popts[1]="28/4/" topts[1]="3:00:00" @@ -129,8 +144,11 @@ case $regtest in 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" = "Cheyenne" ]]; then - topts[1]="1:59:00" ; popts[1]="6/8/" ; ropts[1]="/1" - topts[2]="0:35:00" ; popts[2]="6/10/" ; ropts[2]="/2" + 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" = "Gaea" ]]; then + topts[1]="0:10:00" ; popts[1]="18/8/" ; ropts[1]="/1" + topts[2]="0:10:00" ; popts[2]="18/10/" ; ropts[2]="/2" elif [[ "$machine" = "wcoss2" ]]; 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" @@ -155,6 +173,12 @@ case $regtest in elif [[ "$machine" = "Jet" ]]; then topts[1]="0:15:00" ; popts[1]="20/1/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="20/2/" ; ropts[2]="/1" + elif [[ "$machine" = "Cheyenne" ]]; then + topts[1]="0:15:00" ; popts[1]="20/1/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="20/2/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + topts[1]="0:15:00" ; popts[1]="18/1/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="18/2/" ; ropts[2]="/1" elif [[ "$machine" = "wcoss2" ]]; 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" @@ -179,6 +203,12 @@ case $regtest in 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" = "Cheyenne" ]]; then + topts[1]="0:15:00" ; popts[1]="4/4/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="6/6/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; 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" = "wcoss2" ]]; then topts[1]="0:15:00" ; popts[1]="28/1/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="28/2/" ; ropts[2]="/1" @@ -204,8 +234,11 @@ case $regtest in 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" = "Cheyenne" ]]; then - topts[1]="0:15:00" ; popts[1]="8/6/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="8/8/" ; ropts[2]="/1" + 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" = "Gaea" ]]; then + topts[1]="0:30:00" ; popts[1]="8/6/" ; ropts[1]="/1" + topts[2]="0:30:00" ; popts[2]="8/8/" ; ropts[2]="/1" elif [[ "$machine" = "wcoss2" ]]; then topts[1]="0:30:00" ; popts[1]="14/8/" ; ropts[1]="/1" topts[2]="0:30:00" ; popts[2]="14/14/" ; ropts[2]="/2" @@ -233,6 +266,9 @@ case $regtest in elif [[ "$machine" = "Cheyenne" ]]; then topts[1]="0:20:00" ; popts[1]="6/6/" ; ropts[1]="/1" topts[2]="0:20:00" ; popts[2]="8/8/" ; ropts[2]="/1" + elif [[ "$machine" = "Gaea" ]]; then + topts[1]="0:20:00" ; popts[1]="6/6/" ; ropts[1]="/1" + topts[2]="0:20:00" ; popts[2]="8/8/" ; ropts[2]="/1" elif [[ "$machine" = "wcoss2" ]]; then topts[1]="0:15:00" ; popts[1]="10/10/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="14/14/" ; ropts[2]="/2" @@ -258,8 +294,11 @@ case $regtest in 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" = "Cheyenne" ]]; then - topts[1]="0:15:00" ; popts[1]="16/2/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="16/4/" ; ropts[2]="/2" + topts[1]="0:15:00" ; popts[1]="12/3/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="12/5/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; 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" = "wcoss2" ]]; 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" @@ -316,13 +355,19 @@ elif [[ "$machine" = "Jet" ]]; then export MPI_BUFS_PER_PROC=256 export MPI_BUFS_PER_HOST=256 export MPI_GROUP_MAX=256 - export APRUN="srun" + export APRUN="srun -n \$ntasks --cpus-per-task=\$threads" +elif [[ "$machine" = "Gaea" ]]; 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 --export=ALL --mpi=pmi2 -n \$ntasks" elif [[ "$machine" = "Cheyenne" ]]; then export OMP_STACKSIZE=1024M export MPI_BUFS_PER_PROC=256 export MPI_BUFS_PER_HOST=256 export MPI_GROUP_MAX=256 - export APRUN="mpirun -v -np \$NCPUS" + export APRUN="mpirun -v -np \$ntasks" elif [[ "$machine" = "wcoss2" ]]; then export OMP_PLACES=cores export OMP_STACKSIZE=2G diff --git a/regression/regression_var.sh b/regression/regression_var.sh index 05b5563ef1..3176372a3b 100755 --- a/regression/regression_var.sh +++ b/regression/regression_var.sh @@ -14,6 +14,7 @@ if [ "$#" = 7 ] ; then export enkfexec_contrl=$7 export fixgsi="$gsisrc/fix" export scripts="$gsisrc/regression" + export modulefiles="$gsisrc/modulefiles" export ush="$gsisrc/ush" export cmaketest="true" export clean="false" @@ -49,19 +50,33 @@ fi echo "Running Regression Tests on '$machine'"; case $machine in + Gaea) + export queue="normal" + export noscrub="/lustre/f2/scratch/$LOGNAME/gsi_tmp/noscrub" + export ptmp="/lustre/f2/scratch/$LOGNAME/gsi_tmp/ptmp" + export casesdir="/lustre/f2/dev/role.epic/contrib/GSI_data/CASES/regtest" + + export group="global" + if [[ "$cmaketest" = "false" ]]; then + export basedir="/lustre/f2/dev/$LOGNAME/sandbox/GSI" + fi + + export check_resource="no" + export accnt="nggps_emc" + ;; Cheyenne) - export queue="economy" - export noscrub="/glade/scratch/$LOGNAME" + export queue="regular" + export noscrub="/glade/scratch/$LOGNAME/noscrub" export group="global" if [[ "$cmaketest" = "false" ]]; then - export basedir="/glade/scratch/$LOGNAME/gsi" + export basedir="/glade/scratch/$LOGNAME" fi export ptmp="/glade/scratch/$LOGNAME/$ptmpName" - export casesdir="/glade/p/ral/jntp/tools/CASES" + export casesdir="/glade/work/epicufsrt/contrib/GSI_data/CASES/regtest" export check_resource="no" - export accnt="p48503002" + export accnt="NRAL0032" ;; wcoss2) export local_or_default="${local_or_default:-/lfs/h2/emc/da/noscrub/$LOGNAME}" diff --git a/src/enkf/observer_gfs.f90 b/src/enkf/observer_gfs.f90 index 983b25f959..07e4f58457 100644 --- a/src/enkf/observer_gfs.f90 +++ b/src/enkf/observer_gfs.f90 @@ -66,7 +66,7 @@ subroutine setup_linhx(rlat, rlon, time, ix, delx, ixp, delxp, iy, dely, & !$$$ use kinds, only: r_kind,i_kind,r_single use params, only: nstatefields, nlons, nlats, nhr_state, fhr_assim - use gridinfo, only: latsgrd, lonsgrd + use gridinfo, only: latsgrd, lonsgrd, npts use constants, only: zero,one,pi use mpisetup implicit none @@ -76,6 +76,7 @@ subroutine setup_linhx(rlat, rlon, time, ix, delx, ixp, delxp, iy, dely, & real(r_single) ,intent(in ) :: time ! observation time relative to middle of window integer(i_kind), intent(out) :: ix, iy, it, ixp, iyp, itp real(r_kind), intent(out) :: delx, dely, delxp, delyp, delt, deltp + integer(i_kind) :: ixnlons ! find interplation indices and deltas @@ -87,17 +88,21 @@ subroutine setup_linhx(rlat, rlon, time, ix, delx, ixp, delxp, iy, dely, & ix = min(ix, nlats-1) ixp = max(ix-1, 0) + ixnlons = ix*nlons + if (ixp /= ix) then - delx = (rlat - latsgrd(ix*nlons+1)) / (latsgrd(ixp*nlons + 1) - latsgrd(ix*nlons+1)) + delx = (rlat - latsgrd(ixnlons+1)) / (latsgrd(ixp*nlons + 1) - latsgrd(ixnlons+1)) else delx = one endif delx = max(zero,min(delx,one)) - iyp = 1 - do while (iyp <= nlons .and. lonsgrd(ix*nlons + iyp) <= rlon) - iyp = iyp + 1 + iyp=1 + do while(iyp <= nlons .and. ixnlons+iyp <= npts) + if (lonsgrd(ixnlons+iyp) > rlon) exit + iyp = iyp + 1 enddo + iy = iyp - 1 if(iy < 1) iy = iy + nlons if(iyp > nlons) iyp = iyp - nlons diff --git a/src/gsi/ensctl2state.f90 b/src/gsi/ensctl2state.f90 index 0d6d3042c5..bd72e12b76 100644 --- a/src/gsi/ensctl2state.f90 +++ b/src/gsi/ensctl2state.f90 @@ -240,7 +240,6 @@ subroutine ensctl2state(xhat,mval,eval) !$omp section ! Get pointers to required state variables - call gsi_bundlegetpointer (eval(jj),'oz' ,sv_oz , istatus) call gsi_bundlegetpointer (eval(jj),'sst' ,sv_sst, istatus) if(ls_w)then call gsi_bundlegetpointer (eval(jj),'w' ,sv_w, istatus) @@ -249,7 +248,6 @@ subroutine ensctl2state(xhat,mval,eval) end if end if ! Copy variables - call gsi_bundlegetvar ( wbundle_c, 'oz' , sv_oz, istatus ) call gsi_bundlegetvar ( wbundle_c, 'sst', sv_sst, istatus ) if(lc_w)then call gsi_bundlegetvar ( wbundle_c, 'w' , sv_w, istatus ) @@ -258,6 +256,13 @@ subroutine ensctl2state(xhat,mval,eval) end if end if +! Get the ozone vector if it is defined + id=getindex(cvars3d,"oz") + if(id > 0) then + call gsi_bundlegetpointer (eval(jj),'oz' ,sv_oz , istatus) + call gsi_bundlegetvar ( wbundle_c, 'oz' , sv_oz, istatus ) + endif + !$omp end parallel sections ! Add contribution from static B, if necessary diff --git a/src/gsi/ensctl2state_ad.f90 b/src/gsi/ensctl2state_ad.f90 index 4c038c8c6e..d350743998 100644 --- a/src/gsi/ensctl2state_ad.f90 +++ b/src/gsi/ensctl2state_ad.f90 @@ -206,9 +206,7 @@ subroutine ensctl2state_ad(eval,mval,grad) !$omp section - call gsi_bundlegetpointer (eval(jj),'oz' ,rv_oz , istatus) call gsi_bundlegetpointer (eval(jj),'sst' ,rv_sst, istatus) - call gsi_bundleputvar ( wbundle_c, 'oz', rv_oz, istatus ) call gsi_bundleputvar ( wbundle_c, 'sst', rv_sst, istatus ) if(wdw_exist)then call gsi_bundlegetpointer (eval(jj),'w' ,rv_w, istatus) @@ -219,6 +217,13 @@ subroutine ensctl2state_ad(eval,mval,grad) end if end if +! Get the ozone vector if it is defined + id=getindex(cvars3d,"oz") + if(id > 0) then + call gsi_bundlegetpointer (eval(jj),'oz' ,rv_oz , istatus) + call gsi_bundleputvar ( wbundle_c, 'oz', rv_oz, istatus ) + endif + !$omp section if (do_cw_to_hydro_ad .and. .not.do_cw_to_hydro_ad_hwrf) then diff --git a/src/gsi/general_read_fv3atm.f90 b/src/gsi/general_read_fv3atm.f90 index 3d2646fbbb..847d1c4bd3 100644 --- a/src/gsi/general_read_fv3atm.f90 +++ b/src/gsi/general_read_fv3atm.f90 @@ -255,6 +255,7 @@ subroutine general_read_fv3atm_nems(grd,sp_a,filename,uvflag,vordivflag,zflag, & call stop2(999) endif istatus=0 + istatus1=0 call gsi_bundlegetpointer(gfs_bundle,'ps',g_ps ,ier);istatus = istatus + ier call gsi_bundlegetpointer(gfs_bundle,'q' ,g_q ,ier);istatus = istatus + ier call gsi_bundlegetpointer(gfs_bundle,'oz',g_oz ,ier);istatus = istatus + ier diff --git a/src/gsi/genstats_gps.f90 b/src/gsi/genstats_gps.f90 index ce90d06f50..acf5ca2756 100644 --- a/src/gsi/genstats_gps.f90 +++ b/src/gsi/genstats_gps.f90 @@ -250,7 +250,7 @@ subroutine genstats_gps(bwork,awork,toss_gps_sub,conv_diagsave,mype) use obsmod, only: lobsdiagsave,luse_obsdiag use obsmod, only: binary_diag,netcdf_diag,dirname,ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gridmod, only: nsig,regional use constants, only: tiny_r_kind,half,wgtlim,one,two,zero,five,four @@ -766,27 +766,27 @@ subroutine contents_netcdf_diag_ obssubtype = gps_allptr%rdiag(2) call nc_diag_metadata("Observation_Type", obstype ) call nc_diag_metadata("Observation_Subtype", obssubtype ) - call nc_diag_metadata("Latitude", sngl(gps_allptr%rdiag(3)) ) - call nc_diag_metadata("Longitude", sngl(gps_allptr%rdiag(4)) ) - call nc_diag_metadata("Incremental_Bending_Angle", sngl(gps_allptr%rdiag(5)) ) - call nc_diag_metadata("Pressure", sngl(gps_allptr%rdiag(6)) ) - call nc_diag_metadata("Height", sngl(gps_allptr%rdiag(7)) ) - call nc_diag_metadata("Time", sngl(gps_allptr%rdiag(8)) ) - call nc_diag_metadata("Model_Elevation", sngl(gps_allptr%rdiag(9)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(gps_allptr%rdiag(10)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(gps_allptr%rdiag(11)) ) - call nc_diag_metadata("Analysis_Use_Flag", sngl(gps_allptr%rdiag(12)) ) - - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(gps_allptr%rdiag(13)) ) - call nc_diag_metadata("Errinv_Input", sngl(gps_allptr%rdiag(14)) ) - call nc_diag_metadata("Errinv_Adjust", sngl(gps_allptr%rdiag(15)) ) - call nc_diag_metadata("Errinv_Final", sngl(gps_allptr%rdiag(16)) ) - call nc_diag_metadata("Observation", sngl(gps_allptr%rdiag(17)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(gps_allptr%rdiag(17))*sngl(gps_allptr%rdiag(5)) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(gps_allptr%rdiag(17))*sngl(gps_allptr%rdiag(5)) ) - call nc_diag_metadata("GPS_Type", sngl(gps_allptr%rdiag(20)) ) - call nc_diag_metadata("Temperature_at_Obs_Location", sngl(gps_allptr%rdiag(18)) ) - call nc_diag_metadata("Specific_Humidity_at_Obs_Location", sngl(gps_allptr%rdiag(21)) ) + call nc_diag_metadata_to_single("Latitude", gps_allptr%rdiag(3) ) + call nc_diag_metadata_to_single("Longitude", gps_allptr%rdiag(4) ) + call nc_diag_metadata_to_single("Incremental_Bending_Angle", gps_allptr%rdiag(5) ) + call nc_diag_metadata_to_single("Pressure", gps_allptr%rdiag(6) ) + call nc_diag_metadata_to_single("Height", gps_allptr%rdiag(7) ) + call nc_diag_metadata_to_single("Time", gps_allptr%rdiag(8) ) + call nc_diag_metadata_to_single("Model_Elevation", gps_allptr%rdiag(9) ) + call nc_diag_metadata_to_single("Setup_QC_Mark", gps_allptr%rdiag(10) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", gps_allptr%rdiag(11) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag", gps_allptr%rdiag(12) ) + + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt", gps_allptr%rdiag(13) ) + call nc_diag_metadata_to_single("Errinv_Input", gps_allptr%rdiag(14) ) + call nc_diag_metadata_to_single("Errinv_Adjust", gps_allptr%rdiag(15) ) + call nc_diag_metadata_to_single("Errinv_Final", gps_allptr%rdiag(16) ) + call nc_diag_metadata_to_single("Observation", gps_allptr%rdiag(17) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted", gps_allptr%rdiag(17),gps_allptr%rdiag(5),"*") + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",gps_allptr%rdiag(17),gps_allptr%rdiag(5),"*") + call nc_diag_metadata_to_single("GPS_Type", gps_allptr%rdiag(20) ) + call nc_diag_metadata_to_single("Temperature_at_Obs_Location", gps_allptr%rdiag(18) ) + call nc_diag_metadata_to_single("Specific_Humidity_at_Obs_Location",gps_allptr%rdiag(21) ) if (save_jacobian) then call readarray(dhx_dx, gps_allptr%rdiag(ioff+1:nreal)) diff --git a/src/gsi/gsi_fedOper.F90 b/src/gsi/gsi_fedOper.F90 new file mode 100644 index 0000000000..b2b2400ff0 --- /dev/null +++ b/src/gsi/gsi_fedOper.F90 @@ -0,0 +1,174 @@ +module gsi_fedOper +!$$$ subprogram documentation block +! . . . . +! subprogram: module gsi_fedOper +! +! abstract: an obOper extension for fedNode type +! +! program history log: +! 2023-07-10 D. Dowell - created new module for FED (flash extent +! density); gsi_dbzOper.F90 code used as a +! starting point for developing this new module +! +! input argument list: see Fortran 90 style document below +! +! output argument list: see Fortran 90 style document below +! +! attributes: +! language: Fortran 90 and/or above +! machine: +! +!$$$ end subprogram documentation block + +! module interface: + + use gsi_obOper, only: obOper + use m_fedNode , only: fedNode + implicit none + public:: fedOper ! data structure + public:: diag_fed + + type,extends(obOper):: fedOper + contains + procedure,nopass:: mytype + procedure,nopass:: nodeMold + procedure:: setup_ + procedure:: intjo1_ + procedure:: stpjo1_ + end type fedOper + +! def diag_fed- namelist logical to compute/write (=true) FED diag files + logical,save:: diag_fed=.false. + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + character(len=*),parameter :: myname='gsi_fedOper' + type(fedNode),save,target:: myNodeMold_ + +contains + function mytype(nodetype) + implicit none + character(len=:),allocatable:: mytype + logical,optional, intent(in):: nodetype + mytype="[fedOper]" + if(present(nodetype)) then + if(nodetype) mytype=myNodeMold_%mytype() + endif + end function mytype + + function nodeMold() + !> %nodeMold() returns a mold of its corresponding obsNode + use m_obsNode, only: obsNode + implicit none + class(obsNode),pointer:: nodeMold + nodeMold => myNodeMold_ + end function nodeMold + + subroutine setup_(self, lunin, mype, is, nobs, init_pass, last_pass) + use fed_setup, only: setup + use kinds, only: i_kind + use gsi_obOper, only: len_obstype + use gsi_obOper, only: len_isis + + use m_rhs , only: awork => rhs_awork + use m_rhs , only: bwork => rhs_bwork + use m_rhs , only: iwork => i_fed + + use obsmod , only: write_diag + use jfunc , only: jiter + + use mpeu_util, only: die + + use obsmod, only: dirname, ianldate + + implicit none + class(fedOper ), intent(inout):: self + integer(i_kind), intent(in):: lunin + integer(i_kind), intent(in):: mype + integer(i_kind), intent(in):: is + integer(i_kind), intent(in):: nobs + logical , intent(in):: init_pass ! supporting multi-pass setup() + logical , intent(in):: last_pass ! with incremental backgrounds. + + !---------------------------------------- + character(len=*),parameter:: myname_=myname//"::setup_" + + character(len=len_obstype):: obstype + character(len=len_isis ):: isis + integer(i_kind):: nreal,nchanl,ier,nele + logical:: diagsave + integer(i_kind):: lu_diag + character(128):: diag_file + character(80):: string + + if(nobs == 0) then + + if( (mype == 0) .and. init_pass ) then + write(string,600) jiter +600 format('fed_',i2.2) + diag_file=trim(dirname) // trim(string) + write(6,*) 'write ianldate to ', diag_file + open(newunit=lu_diag,file=trim(diag_file),form='unformatted',status='unknown',position='rewind') + write(lu_diag) ianldate + close(lu_diag) + endif + + return + + endif + + read(lunin,iostat=ier) obstype,isis,nreal,nchanl + if(ier/=0) call die(myname_,'read(obstype,...), iostat =',ier) + nele = nreal+nchanl + + diagsave = write_diag(jiter) .and. diag_fed + + call setup(self%obsLL(:), self%odiagLL(:), & + lunin,mype,bwork,awork(:,iwork),nele,nobs,is,diagsave,init_pass) + + end subroutine setup_ + + subroutine intjo1_(self, ibin, rval,sval, qpred,sbias) + use gsi_bundlemod , only: gsi_bundle + use bias_predictors, only: predictors + use m_obsNode , only: obsNode + use m_obsLList, only: obsLList_headNode + use kinds , only: i_kind, r_quad + implicit none + class(fedOper ),intent(in ):: self + integer(i_kind ),intent(in ):: ibin + type(gsi_bundle),intent(inout):: rval ! (ibin) + type(gsi_bundle),intent(in ):: sval ! (ibin) + real(r_quad ),target,dimension(:),intent(inout):: qpred ! (ibin) + type(predictors),target, intent(in ):: sbias + + !---------------------------------------- + character(len=*),parameter:: myname_=myname//"::intjo1_" + class(obsNode),pointer:: headNode + + end subroutine intjo1_ + + subroutine stpjo1_(self, ibin, dval,xval,pbcjo,sges,nstep,dbias,xbias) + use gsi_bundlemod, only: gsi_bundle + use bias_predictors, only: predictors + use m_obsNode , only: obsNode + use m_obsLList, only: obsLList_headNode + use kinds, only: r_quad,r_kind,i_kind + implicit none + class(fedOper ),intent(in):: self + integer(i_kind ),intent(in):: ibin + type(gsi_bundle),intent(in):: dval + type(gsi_bundle),intent(in):: xval + real(r_quad ),dimension(:),intent(inout):: pbcjo ! (1:4) + real(r_kind ),dimension(:),intent(in ):: sges + integer(i_kind),intent(in):: nstep + + type(predictors),target, intent(in):: dbias + type(predictors),target, intent(in):: xbias + + !---------------------------------------- + character(len=*),parameter:: myname_=myname//"::stpjo1_" + class(obsNode),pointer:: headNode + + end subroutine stpjo1_ + +end module gsi_fedOper diff --git a/src/gsi/gsi_files.cmake b/src/gsi/gsi_files.cmake index b98cd2d0da..b514e11c1e 100644 --- a/src/gsi/gsi_files.cmake +++ b/src/gsi/gsi_files.cmake @@ -217,6 +217,7 @@ gsi_colvkOper.F90 gsi_dbzOper.F90 gsi_dwOper.F90 gsi_enscouplermod.f90 +gsi_fedOper.F90 gsi_gpsbendOper.F90 gsi_gpsrefOper.F90 gsi_gustOper.F90 @@ -338,6 +339,7 @@ m_distance.f90 m_dtime.F90 m_dwNode.F90 m_extOzone.F90 +m_fedNode.F90 m_find.f90 m_gpsNode.F90 m_gpsrhs.F90 @@ -478,6 +480,7 @@ read_cris.f90 read_dbz_nc.f90 read_dbz_netcdf.f90 read_diag.f90 +read_fed.f90 read_files.f90 read_fl_hdob.f90 read_gfs_ozone_for_regional.f90 @@ -532,6 +535,7 @@ setupco.f90 setupdbz.f90 setupdbz_lib.f90 setupdw.f90 +setupfed.f90 setupgust.f90 setuphowv.f90 setuplag.f90 diff --git a/src/gsi/gsi_obOperTypeManager.F90 b/src/gsi/gsi_obOperTypeManager.F90 index 5df899825a..6db7921905 100644 --- a/src/gsi/gsi_obOperTypeManager.F90 +++ b/src/gsi/gsi_obOperTypeManager.F90 @@ -66,6 +66,7 @@ module gsi_obOperTypeManager use gsi_lightOper , only: lightOper use gsi_dbzOper , only: dbzOper + use gsi_fedOper , only: fedOper use gsi_cldtotOper , only: cldtotOper use kinds , only: i_kind @@ -136,6 +137,7 @@ module gsi_obOperTypeManager public:: iobOper_lwcp public:: iobOper_light public:: iobOper_dbz + public:: iobOper_fed public:: iobOper_cldtot enum, bind(C) @@ -181,6 +183,7 @@ module gsi_obOperTypeManager enumerator:: iobOper_lwcp enumerator:: iobOper_light enumerator:: iobOper_dbz + enumerator:: iobOper_fed enumerator:: iobOper_cldtot enumerator:: iobOper_extra_ @@ -242,6 +245,7 @@ module gsi_obOperTypeManager type( lwcpOper), target, save:: lwcpOper_mold type( lightOper), target, save:: lightOper_mold type( dbzOper), target, save:: dbzOper_mold + type( fedOper), target, save:: fedOper_mold type( cldtotOper), target, save:: cldtotOper_mold contains @@ -390,6 +394,7 @@ function dtype2index_(dtype) result(index_) case("goes_glm" ); index_= iobOper_light case("dbz" ,"[dbzoper]" ); index_= iobOper_dbz + case("fed" ,"[fedoper]" ); index_= iobOper_fed case("cldtot" ,"[cldtotoper]" ); index_= iobOper_cldtot case("mta_cld" ); index_= iobOper_cldtot @@ -487,6 +492,7 @@ function index2vmold_(iobOper) result(vmold_) case(iobOper_lwcp ); vmold_ => lwcpOper_mold case(iobOper_light ); vmold_ => lightOper_mold case(iobOper_dbz ); vmold_ => dbzOper_mold + case(iobOper_fed ); vmold_ => fedOper_mold case(iobOper_cldtot ); vmold_ => cldtotOper_mold case( obOper_undef ); vmold_ => null() @@ -602,6 +608,7 @@ subroutine cobstype_config_() cobstype(iobOper_lwcp ) ="lwcp " ! lwcp_ob_type cobstype(iobOper_light ) ="light " ! light_ob_type cobstype(iobOper_dbz ) ="dbz " ! dbz_ob_type + cobstype(iobOper_fed ) ="fed " ! fed_ob_type cobstype(iobOper_cldtot ) ="cldtot " ! using q_ob_type cobstype_configured_=.true. diff --git a/src/gsi/gsi_rfv3io_mod.f90 b/src/gsi/gsi_rfv3io_mod.f90 index 05f679cb60..62b23ee713 100644 --- a/src/gsi/gsi_rfv3io_mod.f90 +++ b/src/gsi/gsi_rfv3io_mod.f90 @@ -2188,7 +2188,7 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) use kinds, only: r_kind,i_kind - use mpimod, only: mpi_comm_world,mpi_rtype,mype + use mpimod, only: mpi_comm_world,mpi_rtype,mype,npe,setcomm,mpi_integer,mpi_max use mpimod, only: MPI_INFO_NULL use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension @@ -2217,6 +2217,11 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) logical :: phy_smaller_domain integer(i_kind) gfile_loc,iret,var_id integer(i_kind) nz,nzp1,mm1,nx_phy + + integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror + integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + logical:: procuse + ! for io_layout > 1 real(r_kind),allocatable,dimension(:,:):: uu2d_layout integer(i_kind) :: nio @@ -2232,108 +2237,132 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) kend=grd_ionouv%kend_loc allocate(uu2d(nxcase,nycase)) - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio - iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) !clt - if(iret/=nf90_noerr) then - write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret - call flush(6) - call stop2(333) - endif - enddo - else - iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) !clt - if(iret/=nf90_noerr) then - write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filenamein),gfile_loc,', Status = ',iret - call flush(6) - call stop2(333) - endif + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - vgsiname=grd_ionouv%names(1,ilevtot) - if(trim(vgsiname)=='delzinc') cycle !delzinc is not read from DZ ,it's started from hydrostatic height - if(trim(vgsiname)=='amassi') cycle - if(trim(vgsiname)=='amassj') cycle - if(trim(vgsiname)=='amassk') cycle - if(trim(vgsiname)=='pm2_5') cycle - call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) - name=trim(varname) - if(trim(filenamein) /= trim(filenamein2)) then - write(6,*)'filenamein and filenamein2 are not the same as expected, stop' - call flush(6) - call stop2(333) - endif - ilev=grd_ionouv%lnames(1,ilevtot) - nz=grd_ionouv%nsig - nzp1=nz+1 - inative=nzp1-ilev - startloc=(/1,1,inative/) - countloc=(/nxcase,nycase,1/) - ! Variable ref_f3d in phy_data.nc has a smaller domain size than - ! dynvariables and tracers as well as a reversed order in vertical - if ( trim(adjustl(varname)) == 'ref_f3d' )then - iret=nf90_inquire_dimension(gfile_loc,1,name,len) - if(trim(name)=='xaxis_1') nx_phy=len - if( nx_phy == nxcase )then - allocate(uu2d_tmp(nxcase,nycase)) - countloc_tmp=(/nxcase,nycase,1/) - phy_smaller_domain = .false. - else - allocate(uu2d_tmp(nxcase-6,nycase-6)) - countloc_tmp=(/nxcase-6,nycase-6,1/) - phy_smaller_domain = .true. - end if - startloc_tmp=(/1,1,ilev/) - end if + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - countloc=(/nxcase,ny_layout_len(nio),1/) - allocate(uu2d_layout(nxcase,ny_layout_len(nio))) - iret=nf90_inq_varid(gfile_loc_layout(nio),trim(adjustl(varname)),var_id) - iret=nf90_get_var(gfile_loc_layout(nio),var_id,uu2d_layout,start=startloc,count=countloc) - uu2d(:,ny_layout_b(nio):ny_layout_e(nio))=uu2d_layout - deallocate(uu2d_layout) - enddo - else - iret=nf90_inq_varid(gfile_loc,trim(adjustl(varname)),var_id) - if ( trim(adjustl(varname)) == 'ref_f3d' )then - uu2d = 0.0_r_kind - iret=nf90_get_var(gfile_loc,var_id,uu2d_tmp,start=startloc_tmp,count=countloc_tmp) - where(uu2d_tmp < 0.0_r_kind) - uu2d_tmp = 0.0_r_kind - endwhere - - if( phy_smaller_domain )then - uu2d(4:nxcase-3,4:nycase-3) = uu2d_tmp - else - uu2d(1:nxcase,1:nycase) = uu2d_tmp - end if - deallocate(uu2d_tmp) - else - iret=nf90_get_var(gfile_loc,var_id,uu2d,start=startloc,count=countloc) - end if - endif + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo + + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) - call fv3_h_to_ll(uu2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,grid_reverse_flag) - enddo ! ilevtot + if (procuse) then - if(fv3_io_layout_y > 1) then - do nio=1,fv3_io_layout_y-1 - iret=nf90_close(gfile_loc_layout(nio)) - enddo - deallocate(gfile_loc_layout) - else - iret=nf90_close(gfile_loc) + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) + do nio=0,fv3_io_layout_y-1 + write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio + iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) !clt + if(iret/=nf90_noerr) then + write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret + call flush(6) + call stop2(333) + endif + enddo + else + iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) !clt + if(iret/=nf90_noerr) then + write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filenamein),gfile_loc,', Status = ',iret + call flush(6) + call stop2(333) + endif + endif + do ilevtot=kbgn,kend + vgsiname=grd_ionouv%names(1,ilevtot) + if(trim(vgsiname)=='delzinc') cycle !delzinc is not read from DZ ,it's started from hydrostatic height + if(trim(vgsiname)=='amassi') cycle + if(trim(vgsiname)=='amassj') cycle + if(trim(vgsiname)=='amassk') cycle + if(trim(vgsiname)=='pm2_5') cycle + call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) + name=trim(varname) + if(trim(filenamein) /= trim(filenamein2)) then + write(6,*)'filenamein and filenamein2 are not the same as expected, stop' + call flush(6) + call stop2(333) + endif + ilev=grd_ionouv%lnames(1,ilevtot) + nz=grd_ionouv%nsig + nzp1=nz+1 + inative=nzp1-ilev + startloc=(/1,1,inative/) + countloc=(/nxcase,nycase,1/) + ! Variable ref_f3d in phy_data.nc has a smaller domain size than + ! dynvariables and tracers as well as a reversed order in vertical + if ( trim(adjustl(varname)) == 'ref_f3d' )then + iret=nf90_inquire_dimension(gfile_loc,1,name,len) + if(trim(name)=='xaxis_1') nx_phy=len + if( nx_phy == nxcase )then + allocate(uu2d_tmp(nxcase,nycase)) + countloc_tmp=(/nxcase,nycase,1/) + phy_smaller_domain = .false. + else + allocate(uu2d_tmp(nxcase-6,nycase-6)) + countloc_tmp=(/nxcase-6,nycase-6,1/) + phy_smaller_domain = .true. + end if + startloc_tmp=(/1,1,ilev/) + end if + + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + countloc=(/nxcase,ny_layout_len(nio),1/) + allocate(uu2d_layout(nxcase,ny_layout_len(nio))) + iret=nf90_inq_varid(gfile_loc_layout(nio),trim(adjustl(varname)),var_id) + iret=nf90_get_var(gfile_loc_layout(nio),var_id,uu2d_layout,start=startloc,count=countloc) + uu2d(:,ny_layout_b(nio):ny_layout_e(nio))=uu2d_layout + deallocate(uu2d_layout) + enddo + else + iret=nf90_inq_varid(gfile_loc,trim(adjustl(varname)),var_id) + if ( trim(adjustl(varname)) == 'ref_f3d' )then + uu2d = 0.0_r_kind + iret=nf90_get_var(gfile_loc,var_id,uu2d_tmp,start=startloc_tmp,count=countloc_tmp) + where(uu2d_tmp < 0.0_r_kind) + uu2d_tmp = 0.0_r_kind + endwhere + + if( phy_smaller_domain )then + uu2d(4:nxcase-3,4:nycase-3) = uu2d_tmp + else + uu2d(1:nxcase,1:nycase) = uu2d_tmp + end if + deallocate(uu2d_tmp) + else + iret=nf90_get_var(gfile_loc,var_id,uu2d,start=startloc,count=countloc) + end if + endif + + call fv3_h_to_ll(uu2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,grid_reverse_flag) + enddo ! ilevtot + + if(fv3_io_layout_y > 1) then + do nio=1,fv3_io_layout_y-1 + iret=nf90_close(gfile_loc_layout(nio)) + enddo + deallocate(gfile_loc_layout) + else + iret=nf90_close(gfile_loc) + endif endif - + call mpi_barrier(mpi_comm_world,ierror) + deallocate (uu2d) call general_grid2sub(grd_ionouv,hwork,cstate_nouv%values) return -end subroutine gsi_fv3ncdf_read + end subroutine gsi_fv3ncdf_read subroutine gsi_fv3ncdf_read_v1(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) @@ -2465,7 +2494,7 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) ! !$$$ end documentation block use kinds, only: r_kind,i_kind - use mpimod, only: mpi_comm_world,mpi_rtype,mype,mpi_info_null + use mpimod, only: mpi_comm_world,mpi_rtype,mype,mpi_info_null,npe,setcomm,mpi_integer,mpi_max use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension use netcdf, only: nf90_inquire_variable @@ -2495,6 +2524,10 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) integer(i_kind) gfile_loc,iret integer(i_kind) nz,nzp1,mm1 + integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror + integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + logical:: procuse + ! for fv3_io_layout_y > 1 real(r_kind),allocatable,dimension(:,:):: u2d_layout,v2d_layout integer(i_kind) :: nio @@ -2515,102 +2548,130 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) allocate (worksub(2,grd_uv%lat2,grd_uv%lon2,grd_uv%nsig)) filenamein=fv3filenamegin%dynvars - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio - iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) - if(iret/=nf90_noerr) then - write(6,*)'problem opening6 ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret - call flush(6) - call stop2(333) - endif - enddo - else - iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) !clt - if(iret/=nf90_noerr) then - write(6,*)' problem opening6 ',trim(filenamein),', Status = ',iret - call flush(6) - call stop2(333) - endif + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - vgsiname=grd_uv%names(1,ilevtot) - call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) - if(trim(filenamein) /= trim(filenamein2)) then - write(6,*)'filenamein and filenamein2 are not the same as expected, stop' - call flush(6) - call stop2(333) - endif - ilev=grd_uv%lnames(1,ilevtot) - nz=grd_uv%nsig - nzp1=nz+1 - inative=nzp1-ilev - u_countloc=(/nxcase,nycase+1,1/) - v_countloc=(/nxcase+1,nycase,1/) - u_startloc=(/1,1,inative/) - v_startloc=(/1,1,inative/) - - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) - allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) - call check( nf90_inq_varid(gfile_loc_layout(nio),'u',u_grd_VarId) ) - iret=nf90_get_var(gfile_loc_layout(nio),u_grd_VarId,u2d_layout,start=u_startloc,count=u_countloc) - u2d(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) - if(nio==fv3_io_layout_y-1) u2d(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) - deallocate(u2d_layout) - - v_countloc=(/nxcase+1,ny_layout_len(nio),1/) - allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) - call check( nf90_inq_varid(gfile_loc_layout(nio),'v',v_grd_VarId) ) - iret=nf90_get_var(gfile_loc_layout(nio),v_grd_VarId,v2d_layout,start=v_startloc,count=v_countloc) - v2d(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout - deallocate(v2d_layout) - enddo - else - call check( nf90_inq_varid(gfile_loc,'u',u_grd_VarId) ) - iret=nf90_get_var(gfile_loc,u_grd_VarId,u2d,start=u_startloc,count=u_countloc) - call check( nf90_inq_varid(gfile_loc,'v',v_grd_VarId) ) - iret=nf90_get_var(gfile_loc,v_grd_VarId,v2d,start=v_startloc,count=v_countloc) - endif - if(.not.grid_reverse_flag) then - call reverse_grid_r_uv (u2d,nxcase,nycase+1,1) - call reverse_grid_r_uv (v2d,nxcase+1,nycase,1) - endif - call fv3uv2earth(u2d(:,:),v2d(:,:),nxcase,nycase,uc2d,vc2d) + write(6,115)mype,kbgn,kend,procuse +115 format('gsi_fv3ncdf_readuv: mype ',i6,' has kbgn,kend= ',2(i6,1x),' set procuse ',l7) -! NOTE on transfor to earth u/v: -! The u and v before transferring need to be in E-W/N-S grid, which is -! defined as reversed grid here because it is revered from map view. -! -! Have set the following flag for grid orientation -! grid_reverse_flag=true: E-W/N-S grid -! grid_reverse_flag=false: W-E/S-N grid -! -! So for preparing the wind transferring, need to reverse the grid from -! W-E/S-N grid to E-W/N-S grid when grid_reverse_flag=false: -! -! if(.not.grid_reverse_flag) call reverse_grid_r_uv -! -! and the last input parameter for fv3_h_to_ll is alway true: -! -! - call fv3_h_to_ll(uc2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) - call fv3_h_to_ll(vc2d,hwork(2,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) - enddo ! i + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - iret=nf90_close(gfile_loc_layout(nio)) - enddo - deallocate(gfile_loc_layout) - else - iret=nf90_close(gfile_loc) + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo + + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) + + if (procuse) then + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) + do nio=0,fv3_io_layout_y-1 + write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio + iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) + if(iret/=nf90_noerr) then + write(6,*)'problem opening6 ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret + call flush(6) + call stop2(333) + endif + enddo + else + iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) !clt + if(iret/=nf90_noerr) then + write(6,*)' problem opening6 ',trim(filenamein),', Status = ',iret + call flush(6) + call stop2(333) + endif + endif + + do ilevtot=kbgn,kend + vgsiname=grd_uv%names(1,ilevtot) + call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) + if(trim(filenamein) /= trim(filenamein2)) then + write(6,*)'filenamein and filenamein2 are not the same as expected, stop' + call flush(6) + call stop2(333) + endif + ilev=grd_uv%lnames(1,ilevtot) + nz=grd_uv%nsig + nzp1=nz+1 + inative=nzp1-ilev + u_countloc=(/nxcase,nycase+1,1/) + v_countloc=(/nxcase+1,nycase,1/) + u_startloc=(/1,1,inative/) + v_startloc=(/1,1,inative/) + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) + allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) + call check( nf90_inq_varid(gfile_loc_layout(nio),'u',u_grd_VarId) ) + iret=nf90_get_var(gfile_loc_layout(nio),u_grd_VarId,u2d_layout,start=u_startloc,count=u_countloc) + u2d(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) + if(nio==fv3_io_layout_y-1) u2d(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) + deallocate(u2d_layout) + + v_countloc=(/nxcase+1,ny_layout_len(nio),1/) + allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) + call check( nf90_inq_varid(gfile_loc_layout(nio),'v',v_grd_VarId) ) + iret=nf90_get_var(gfile_loc_layout(nio),v_grd_VarId,v2d_layout,start=v_startloc,count=v_countloc) + v2d(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout + deallocate(v2d_layout) + enddo + else + call check( nf90_inq_varid(gfile_loc,'u',u_grd_VarId) ) + iret=nf90_get_var(gfile_loc,u_grd_VarId,u2d,start=u_startloc,count=u_countloc) + call check( nf90_inq_varid(gfile_loc,'v',v_grd_VarId) ) + iret=nf90_get_var(gfile_loc,v_grd_VarId,v2d,start=v_startloc,count=v_countloc) + endif + + if(.not.grid_reverse_flag) then + call reverse_grid_r_uv (u2d,nxcase,nycase+1,1) + call reverse_grid_r_uv (v2d,nxcase+1,nycase,1) + endif + call fv3uv2earth(u2d(:,:),v2d(:,:),nxcase,nycase,uc2d,vc2d) + + ! NOTE on transfor to earth u/v: + ! The u and v before transferring need to be in E-W/N-S grid, which is + ! defined as reversed grid here because it is revered from map view. + ! + ! Have set the following flag for grid orientation + ! grid_reverse_flag=true: E-W/N-S grid + ! grid_reverse_flag=false: W-E/S-N grid + ! + ! So for preparing the wind transferring, need to reverse the grid from + ! W-E/S-N grid to E-W/N-S grid when grid_reverse_flag=false: + ! + ! if(.not.grid_reverse_flag) call reverse_grid_r_uv + ! + ! and the last input parameter for fv3_h_to_ll is alway true: + ! + ! + call fv3_h_to_ll(uc2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) + call fv3_h_to_ll(vc2d,hwork(2,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) + enddo ! i + + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + iret=nf90_close(gfile_loc_layout(nio)) + enddo + deallocate(gfile_loc_layout) + else + iret=nf90_close(gfile_loc) + endif endif - deallocate(u2d,v2d,uc2d,vc2d) + call mpi_barrier(mpi_comm_world,ierror) + deallocate(u2d,v2d,uc2d,vc2d) + call general_grid2sub(grd_uv,hwork,worksub) ges_u=worksub(1,:,:,:) ges_v=worksub(2,:,:,:) @@ -3533,7 +3594,7 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) ! !$$$ end documentation block - use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null + use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null,npe,setcomm,mpi_integer,mpi_max use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension use gridmod, only: nlon_regional,nlat_regional use mod_fv3_lola, only: fv3_ll_to_h,fv3_h_to_ll, & @@ -3566,6 +3627,10 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) real(r_kind),allocatable,dimension(:,:):: u2d,v2d,workau2,workav2 real(r_kind),allocatable,dimension(:,:):: workbu2,workbv2 + integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,ierror + integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + logical:: procuse + ! for fv3_io_layout_y > 1 real(r_kind),allocatable,dimension(:,:):: u2d_layout,v2d_layout integer(i_kind) :: nio @@ -3597,117 +3662,143 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) call general_sub2grid(grd_uv,worksub,hwork) filenamein=fv3filenamegin%dynvars - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio - call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) ) - enddo - gfile_loc=gfile_loc_layout(0) - else - call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) ) + + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - varname=grd_uv%names(1,ilevtot) - ilev=grd_uv%lnames(1,ilevtot) - nz=grd_uv%nsig - nzp1=nz+1 - inative=nzp1-ilev - u_countloc=(/nxcase,nycase+1,1/) - v_countloc=(/nxcase+1,nycase,1/) - u_startloc=(/1,1,inative/) - v_startloc=(/1,1,inative/) + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - work_au=hwork(1,:,:,ilevtot) - work_av=hwork(2,:,:,ilevtot) + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo - call check( nf90_inq_varid(gfile_loc,'u',ugrd_VarId) ) - call check( nf90_inq_varid(gfile_loc,'v',vgrd_VarId) ) + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) - if(add_saved)then - allocate( workau2(nlatcase,nloncase),workav2(nlatcase,nloncase)) - allocate( workbu2(nlon_regional,nlat_regional+1)) - allocate( workbv2(nlon_regional+1,nlat_regional)) -!!!!!!!! readin work_b !!!!!!!!!!!!!!!! - if(fv3_io_layout_y > 1) then + if (procuse) then + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) do nio=0,fv3_io_layout_y-1 - allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) - u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) - call check( nf90_get_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) - work_bu(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) - if(nio==fv3_io_layout_y-1) work_bu(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) - deallocate(u2d_layout) - - allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) - v_countloc=(/nxcase+1,ny_layout_len(nio),1/) - call check( nf90_get_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) - work_bv(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout - deallocate(v2d_layout) + write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio + call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) ) enddo - else - call check( nf90_get_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) - call check( nf90_get_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) - endif - if(.not.grid_reverse_flag) then - call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) - call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) - endif - call fv3uv2earth(work_bu,work_bv,nlon_regional,nlat_regional,u2d,v2d) - call fv3_h_to_ll(u2d,workau2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) - call fv3_h_to_ll(v2d,workav2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) + gfile_loc=gfile_loc_layout(0) + else + call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) ) + endif + + do ilevtot=kbgn,kend + varname=grd_uv%names(1,ilevtot) + ilev=grd_uv%lnames(1,ilevtot) + nz=grd_uv%nsig + nzp1=nz+1 + inative=nzp1-ilev + u_countloc=(/nxcase,nycase+1,1/) + v_countloc=(/nxcase+1,nycase,1/) + u_startloc=(/1,1,inative/) + v_startloc=(/1,1,inative/) + + work_au=hwork(1,:,:,ilevtot) + work_av=hwork(2,:,:,ilevtot) + + call check( nf90_inq_varid(gfile_loc,'u',ugrd_VarId) ) + call check( nf90_inq_varid(gfile_loc,'v',vgrd_VarId) ) + + if(add_saved)then + allocate( workau2(nlatcase,nloncase),workav2(nlatcase,nloncase)) + allocate( workbu2(nlon_regional,nlat_regional+1)) + allocate( workbv2(nlon_regional+1,nlat_regional)) +!!!!!!!! readin work_b !!!!!!!!!!!!!!!! + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) + u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) + call check( nf90_get_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) + work_bu(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) + if(nio==fv3_io_layout_y-1) work_bu(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) + deallocate(u2d_layout) + + allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) + v_countloc=(/nxcase+1,ny_layout_len(nio),1/) + call check( nf90_get_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) + work_bv(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout + deallocate(v2d_layout) + enddo + else + call check( nf90_get_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) + call check( nf90_get_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) + endif + if(.not.grid_reverse_flag) then + call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) + call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) + endif + call fv3uv2earth(work_bu,work_bv,nlon_regional,nlat_regional,u2d,v2d) + call fv3_h_to_ll(u2d,workau2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) + call fv3_h_to_ll(v2d,workav2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) !!!!!!!! find analysis_inc: work_a !!!!!!!!!!!!!!!! - work_au(:,:)=work_au(:,:)-workau2(:,:) - work_av(:,:)=work_av(:,:)-workav2(:,:) - call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,workbu2,workbv2) + work_au(:,:)=work_au(:,:)-workau2(:,:) + work_av(:,:)=work_av(:,:)-workav2(:,:) + call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,workbu2,workbv2) !!!!!!!! add analysis_inc to readin work_b !!!!!!!!!!!!!!!! - work_bu(:,:)=work_bu(:,:)+workbu2(:,:) - work_bv(:,:)=work_bv(:,:)+workbv2(:,:) - deallocate(workau2,workbu2,workav2,workbv2) - else - call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,work_bu(:,:),work_bv(:,:)) - endif - if(.not.grid_reverse_flag) then - call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) - call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) - endif - - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) - u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) - u2d_layout=work_bu(:,ny_layout_b(nio):ny_layout_e(nio)+1) - call check( nf90_put_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) - deallocate(u2d_layout) - - allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) - v_countloc=(/nxcase+1,ny_layout_len(nio),1/) - v2d_layout=work_bv(:,ny_layout_b(nio):ny_layout_e(nio)) - call check( nf90_put_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) - deallocate(v2d_layout) - enddo - else - call check( nf90_put_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) - call check( nf90_put_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) - endif - enddo !ilevltot + work_bu(:,:)=work_bu(:,:)+workbu2(:,:) + work_bv(:,:)=work_bv(:,:)+workbv2(:,:) + deallocate(workau2,workbu2,workav2,workbv2) + else + call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,work_bu(:,:),work_bv(:,:)) + endif + if(.not.grid_reverse_flag) then + call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) + call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) + endif + + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) + u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) + u2d_layout=work_bu(:,ny_layout_b(nio):ny_layout_e(nio)+1) + call check( nf90_put_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) + deallocate(u2d_layout) + + allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) + v_countloc=(/nxcase+1,ny_layout_len(nio),1/) + v2d_layout=work_bv(:,ny_layout_b(nio):ny_layout_e(nio)) + call check( nf90_put_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) + deallocate(v2d_layout) + enddo + else + call check( nf90_put_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) + call check( nf90_put_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) + endif + enddo !ilevltot - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - call check( nf90_close(gfile_loc_layout(nio)) ) - enddo - deallocate(gfile_loc_layout) - else - call check( nf90_close(gfile_loc) ) + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + call check( nf90_close(gfile_loc_layout(nio)) ) + enddo + deallocate(gfile_loc_layout) + else + call check( nf90_close(gfile_loc) ) + endif endif + + call mpi_barrier(mpi_comm_world,ierror) + deallocate(work_bu,work_bv,u2d,v2d) deallocate(work_au,work_av) - end subroutine gsi_fv3ncdf_writeuv subroutine gsi_fv3ncdf_writeuv_v1(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) !$$$ subprogram documentation block @@ -4080,7 +4171,7 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file ! !$$$ end documentation block - use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null + use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null,npe,setcomm,mpi_integer,mpi_max use mod_fv3_lola, only: fv3_ll_to_h use mod_fv3_lola, only: fv3_h_to_ll use netcdf, only: nf90_open,nf90_close @@ -4112,6 +4203,10 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file real(r_kind),allocatable,dimension(:,:):: workb2,worka2 real(r_kind),allocatable,dimension(:,:):: work_b_tmp + integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror + integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + logical:: procuse + ! for io_layout > 1 real(r_kind),allocatable,dimension(:,:):: work_b_layout integer(i_kind) :: nio @@ -4133,143 +4228,168 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file allocate( workb2(nlon_regional,nlat_regional)) allocate( worka2(nlatcase,nloncase)) - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio - call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) ) - enddo - gfile_loc=gfile_loc_layout(0) - else - call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) ) + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - vgsiname=grd_ionouv%names(1,ilevtot) - if(trim(vgsiname)=='amassi') cycle - if(trim(vgsiname)=='amassj') cycle - if(trim(vgsiname)=='amassk') cycle - if(trim(vgsiname)=='pm2_5') cycle - call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) - if(trim(filenamein) /= trim(filenamein2)) then - write(6,*)'filenamein and filenamein2 are not the same as expected, stop' - call flush(6) - call stop2(333) - endif - ilev=grd_ionouv%lnames(1,ilevtot) - nz=grd_ionouv%nsig - nzp1=nz+1 - inative=nzp1-ilev - countloc=(/nxcase,nycase,1/) - startloc=(/1,1,inative/) - - work_a=hwork(1,:,:,ilevtot) - - if( trim(varname) == 'ref_f3d' )then - iret=nf90_inquire_dimension(gfile_loc,1,name,len) - if(trim(name)=='xaxis_1') nx_phy=len - if( nx_phy == nxcase )then - allocate(work_b_tmp(nxcase,nycase)) - countloc_tmp=(/nxcase,nycase,1/) - phy_smaller_domain = .false. - else - allocate(work_b_tmp(nxcase-6,nycase-6)) - countloc_tmp=(/nxcase-6,nycase-6,1/) - phy_smaller_domain = .true. - end if - startloc_tmp=(/1,1,ilev/) - end if + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - call check( nf90_inq_varid(gfile_loc,trim(varname),VarId) ) + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) - if(index(vgsiname,"delzinc") > 0) then - if(fv3_io_layout_y > 1) then + if (procuse) then + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) do nio=0,fv3_io_layout_y-1 - countloc=(/nxcase,ny_layout_len(nio),1/) - allocate(work_b_layout(nxcase,ny_layout_len(nio))) - call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) - work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout - deallocate(work_b_layout) + write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio + call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) ) enddo - else - call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) - endif - call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) - work_b(:,:)=work_b(:,:)+workb2(:,:) - else - if(add_saved)then - if(fv3_io_layout_y > 1) then + gfile_loc=gfile_loc_layout(0) + else + call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) ) + endif + + do ilevtot=kbgn,kend + vgsiname=grd_ionouv%names(1,ilevtot) + if(trim(vgsiname)=='amassi') cycle + if(trim(vgsiname)=='amassj') cycle + if(trim(vgsiname)=='amassk') cycle + if(trim(vgsiname)=='pm2_5') cycle + call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) + if(trim(filenamein) /= trim(filenamein2)) then + write(6,*)'filenamein and filenamein2 are not the same as expected, stop' + call flush(6) + call stop2(333) + endif + ilev=grd_ionouv%lnames(1,ilevtot) + nz=grd_ionouv%nsig + nzp1=nz+1 + inative=nzp1-ilev + countloc=(/nxcase,nycase,1/) + startloc=(/1,1,inative/) + + work_a=hwork(1,:,:,ilevtot) + + if( trim(varname) == 'ref_f3d' )then + iret=nf90_inquire_dimension(gfile_loc,1,name,len) + if(trim(name)=='xaxis_1') nx_phy=len + if( nx_phy == nxcase )then + allocate(work_b_tmp(nxcase,nycase)) + countloc_tmp=(/nxcase,nycase,1/) + phy_smaller_domain = .false. + else + allocate(work_b_tmp(nxcase-6,nycase-6)) + countloc_tmp=(/nxcase-6,nycase-6,1/) + phy_smaller_domain = .true. + end if + startloc_tmp=(/1,1,ilev/) + end if + + call check( nf90_inq_varid(gfile_loc,trim(varname),VarId) ) + + + if(index(vgsiname,"delzinc") > 0) then + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + countloc=(/nxcase,ny_layout_len(nio),1/) + allocate(work_b_layout(nxcase,ny_layout_len(nio))) + call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) + work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout + deallocate(work_b_layout) + enddo + else + call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) + endif + call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) + work_b(:,:)=work_b(:,:)+workb2(:,:) + else + if(add_saved)then + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + countloc=(/nxcase,ny_layout_len(nio),1/) + allocate(work_b_layout(nxcase,ny_layout_len(nio))) + call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) + work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout + deallocate(work_b_layout) + enddo + else + if( trim(varname) == 'ref_f3d' )then + work_b = 0.0_r_kind + call check( nf90_get_var(gfile_loc,VarId,work_b_tmp,start = startloc_tmp, count = countloc_tmp) ) + where(work_b_tmp < 0.0_r_kind) + work_b_tmp = 0.0_r_kind + end where + if(phy_smaller_domain)then + work_b(4:nxcase-3,4:nycase-3) = work_b_tmp + else + work_b(1:nxcase,1:nycase) = work_b_tmp + end if + else + call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) + end if + endif + call fv3_h_to_ll(work_b(:,:),worka2,nlon_regional,nlat_regional,nloncase,nlatcase,grid_reverse_flag) +!!!!!!!! analysis_inc: work_a !!!!!!!!!!!!!!!! + work_a(:,:)=work_a(:,:)-worka2(:,:) + call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) + work_b(:,:)=work_b(:,:)+workb2(:,:) + else + call fv3_ll_to_h(work_a(:,:),work_b(:,:),nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) + endif + endif + if(fv3_io_layout_y > 1) then do nio=0,fv3_io_layout_y-1 countloc=(/nxcase,ny_layout_len(nio),1/) allocate(work_b_layout(nxcase,ny_layout_len(nio))) - call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) - work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout + work_b_layout=work_b(:,ny_layout_b(nio):ny_layout_e(nio)) + call check( nf90_put_var(gfile_loc_layout(nio),VarId,work_b_layout, start = startloc, count = countloc) ) deallocate(work_b_layout) - enddo - else - if( trim(varname) == 'ref_f3d' )then - work_b = 0.0_r_kind - call check( nf90_get_var(gfile_loc,VarId,work_b_tmp,start = startloc_tmp, count = countloc_tmp) ) - where(work_b_tmp < 0.0_r_kind) - work_b_tmp = 0.0_r_kind - end where - if(phy_smaller_domain)then - work_b(4:nxcase-3,4:nycase-3) = work_b_tmp - else - work_b(1:nxcase,1:nycase) = work_b_tmp - end if - else - call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) - end if - endif - call fv3_h_to_ll(work_b(:,:),worka2,nlon_regional,nlat_regional,nloncase,nlatcase,grid_reverse_flag) -!!!!!!!! analysis_inc: work_a !!!!!!!!!!!!!!!! - work_a(:,:)=work_a(:,:)-worka2(:,:) - call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) - work_b(:,:)=work_b(:,:)+workb2(:,:) - else - call fv3_ll_to_h(work_a(:,:),work_b(:,:),nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) - endif - endif - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - countloc=(/nxcase,ny_layout_len(nio),1/) - allocate(work_b_layout(nxcase,ny_layout_len(nio))) - work_b_layout=work_b(:,ny_layout_b(nio):ny_layout_e(nio)) - call check( nf90_put_var(gfile_loc_layout(nio),VarId,work_b_layout, start = startloc, count = countloc) ) - deallocate(work_b_layout) - enddo - else - if( trim(varname) == 'ref_f3d' )then - if(phy_smaller_domain)then - work_b_tmp = work_b(4:nxcase-3,4:nycase-3) - else - work_b_tmp = work_b(1:nxcase,1:nycase) - end if - where(work_b_tmp < 0.0_r_kind) - work_b_tmp = 0.0_r_kind - end where - call check( nf90_put_var(gfile_loc,VarId,work_b_tmp, start = startloc_tmp, count = countloc_tmp) ) - deallocate(work_b_tmp) - else - call check( nf90_put_var(gfile_loc,VarId,work_b, start = startloc, count = countloc) ) - end if - endif - - enddo !ilevtotl loop - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - call check(nf90_close(gfile_loc_layout(nio))) - enddo - deallocate(gfile_loc_layout) - else - call check(nf90_close(gfile_loc)) + enddo + else + if( trim(varname) == 'ref_f3d' )then + if(phy_smaller_domain)then + work_b_tmp = work_b(4:nxcase-3,4:nycase-3) + else + work_b_tmp = work_b(1:nxcase,1:nycase) + end if + where(work_b_tmp < 0.0_r_kind) + work_b_tmp = 0.0_r_kind + end where + call check( nf90_put_var(gfile_loc,VarId,work_b_tmp, start = startloc_tmp, count = countloc_tmp) ) + deallocate(work_b_tmp) + else + call check( nf90_put_var(gfile_loc,VarId,work_b, start = startloc, count = countloc) ) + end if + endif + + enddo !ilevtotl loop + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + call check(nf90_close(gfile_loc_layout(nio))) + enddo + deallocate(gfile_loc_layout) + else + call check(nf90_close(gfile_loc)) + endif endif + + call mpi_barrier(mpi_comm_world,ierror) + deallocate(work_b,work_a) deallocate(workb2,worka2) - end subroutine gsi_fv3ncdf_write subroutine check(status) use kinds, only: i_kind diff --git a/src/gsi/gsimod.F90 b/src/gsi/gsimod.F90 index cf885c2b64..2656a2dce4 100644 --- a/src/gsi/gsimod.F90 +++ b/src/gsi/gsimod.F90 @@ -21,6 +21,7 @@ module gsimod lread_obs_save,lread_obs_skip,time_window_rad,tcp_posmatch,tcp_box, & neutral_stability_windfact_2dvar,use_similarity_2dvar,ta2tb use gsi_dbzOper, only: diag_radardbz + use gsi_fedOper, only: diag_fed use obsmod, only: doradaroneob,oneoblat,oneoblon,oneobheight,oneobvalue,oneobddiff,oneobradid,& radar_no_thinning,ens_hx_dbz_cut,static_gsi_nopcp_dbz,rmesh_dbz,& @@ -560,6 +561,7 @@ module gsimod ! diag_co - logical to turn off or on the diagnostic carbon monoxide file (true=on) ! diag_light - logical to turn off or on the diagnostic lightning file (true=on) ! diag_radardbz - logical to turn off or on the diagnostic radar reflectivity file (true=on) +! diag_fed - logical to turn off or on the diagnostic flash extent density file (true=on) ! write_diag - logical to write out diagnostic files on outer iteration ! lobsdiagsave - write out additional observation diagnostics ! ltlint - linearize inner loop @@ -738,8 +740,8 @@ module gsimod min_offset,pseudo_q2,& iout_iter,npredp,retrieval,& tzr_qc,tzr_bufrsave,& - diag_rad,diag_pcp,diag_conv,diag_ozone,diag_aero,diag_co,diag_light,diag_radardbz,iguess, & - write_diag,reduce_diag, & + diag_rad,diag_pcp,diag_conv,diag_ozone,diag_aero,diag_co,diag_light,diag_radardbz,diag_fed, & + iguess,write_diag,reduce_diag, & oneobtest,sfcmodel,dtbduv_on,ifact10,l_foto,offtime_data,& use_pbl,use_compress,nsig_ext,gpstop,commgpstop, commgpserrinf, & perturb_obs,perturb_fact,oberror_tune,preserve_restart_date, & @@ -1977,6 +1979,7 @@ subroutine gsimain_initialize diag_pcp=.false. diag_light=.false. diag_radardbz=.false. + diag_fed=.false. use_limit = 0 end if if(reduce_diag) use_limit = 0 @@ -2213,7 +2216,7 @@ subroutine gsimain_initialize endif ! Set up directories (or pe specific filenames) - call init_directories(mype) + call init_directories(mype,npe) ! Initialize space for qc call create_qcvars diff --git a/src/gsi/guess_grids.F90 b/src/gsi/guess_grids.F90 index e19ce93638..bf493a0628 100644 --- a/src/gsi/guess_grids.F90 +++ b/src/gsi/guess_grids.F90 @@ -977,18 +977,29 @@ subroutine create_gesfinfo nfldaer_all=nfldaer nfldaer_now=0 extrap_intime=.true. - allocate(hrdifsfc(nfldsfc),ifilesfc(nfldsfc), & - hrdifnst(nfldnst),ifilenst(nfldnst), & - hrdifsig(nfldsig),ifilesig(nfldsig), & - hrdifaer(nfldaer),ifileaer(nfldaer), & - hrdifsfc_all(nfldsfc_all), & - hrdifnst_all(nfldnst_all), & - hrdifsig_all(nfldsig_all), & - hrdifaer_all(nfldaer_all), & - stat=istatus) + if(nfldsig>0) allocate(hrdifsig(nfldsig),ifilesig(nfldsig), & + hrdifsig_all(nfldsig_all), & + stat=istatus) if (istatus/=0) & - write(6,*)'CREATE_GESFINFO(hrdifsfc,..): allocate error, istatus=',& - istatus + call die('CREATE_GESFINFO', '(hrdifsig,..): allocate error, istatus=', istatus) + if(nfldsfc>0) allocate(hrdifsfc(nfldsfc),ifilesfc(nfldsfc), & + hrdifsfc_all(nfldsfc_all), & + stat=istatus) + if (istatus/=0) & + call die('CREATE_GESFINFO', '(hrdifsfc,..): allocate error, istatus=',& + istatus) + if(nfldnst>0) allocate(hrdifnst(nfldnst),ifilenst(nfldnst), & + hrdifnst_all(nfldnst_all), & + stat=istatus) + if (istatus/=0) & + call die('CREATE_GESFINFO', '(hrdifnst,..): allocate error, istatus=',& + istatus) + if(nfldnst>0) allocate(hrdifaer(nfldaer),ifileaer(nfldaer), & + hrdifaer_all(nfldaer_all), & + stat=istatus) + if (istatus/=0) & + call die('CREATE_GESFINFO', '(hrdifaer,..): allocate error, istatus=',& + istatus) #endif /* HAVE_ESMF */ return @@ -1030,11 +1041,18 @@ subroutine destroy_gesfinfo gesfinfo_created_=.false. #ifndef HAVE_ESMF - deallocate(hrdifsfc,ifilesfc,hrdifnst,hrdifaer,ifilenst,hrdifsig,ifilesig,ifileaer,& - hrdifsfc_all,hrdifnst_all,hrdifsig_all,hrdifaer_all,stat=istatus) + if(nfldsig>0) deallocate(hrdifsig,ifilesig,hrdifsig_all,stat=istatus) if (istatus/=0) & - write(6,*)'DESTROY_GESFINFO: deallocate error, istatus=',& - istatus + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) + if(nfldsfc>0) deallocate(hrdifsfc,ifilesfc,hrdifsfc_all,stat=istatus) + if (istatus/=0) & + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) + if(nfldnst>0) deallocate(hrdifnst,ifilenst,hrdifnst_all,stat=istatus) + if (istatus/=0) & + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) + if(nfldnst>0) deallocate(hrdifaer,ifileaer,hrdifaer_all,stat=istatus) + if (istatus/=0) & + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) nfldsfc_all=0 nfldnst_all=0 diff --git a/src/gsi/intjo.f90 b/src/gsi/intjo.f90 index 91b811147e..a68355471b 100644 --- a/src/gsi/intjo.f90 +++ b/src/gsi/intjo.f90 @@ -31,7 +31,7 @@ module intjomod use gsi_obOperTypeManager, only: & iobOper_t, iobOper_pw, iobOper_q, & iobOper_cldtot, iobOper_w, iobOper_dw, & - iobOper_rw, iobOper_dbz, & + iobOper_rw, iobOper_dbz, iobOper_fed, & iobOper_spd, iobOper_oz, iobOper_o3l, iobOper_colvk, & iobOper_pm2_5, iobOper_pm10, iobOper_ps, iobOper_tcp, iobOper_sst, & iobOper_gpsbend, iobOper_gpsref, & @@ -60,7 +60,7 @@ module intjomod integer(i_kind),parameter,dimension(obOper_count):: ix_obtype = (/ & iobOper_t, iobOper_pw, iobOper_q, & iobOper_cldtot, iobOper_w, iobOper_dw, & - iobOper_rw, iobOper_dbz, & + iobOper_rw, iobOper_dbz, iobOper_fed, & iobOper_spd, iobOper_oz, iobOper_o3l, iobOper_colvk, & iobOper_pm2_5, iobOper_pm10, iobOper_ps, iobOper_tcp, iobOper_sst, & iobOper_gpsbend, iobOper_gpsref, & diff --git a/src/gsi/m_fedNode.F90 b/src/gsi/m_fedNode.F90 new file mode 100644 index 0000000000..84a319cd12 --- /dev/null +++ b/src/gsi/m_fedNode.F90 @@ -0,0 +1,248 @@ +module m_fedNode +!$$$ subprogram documentation block +! . . . . +! subprogram: module m_fedNode +! prgmmr: YPW +! org: CIMMS +! date: 2019-09-24 +! +! abstract: class-module of obs-type fedNode (GLM flash extent density) +! Modified based on m_tdNode.f90 +! +! program history log: +! 2019-09-24 YPW - added this document block for the initial polymorphic +! implementation. +! +! input argument list: see Fortran 90 style document below +! +! output argument list: see Fortran 90 style document below +! +! attributes: +! language: Fortran 90 and/or above +! machine: +! +!$$$ end subprogram documentation block + +! module interface: + use m_obsdiagNode, only: obs_diag + use m_obsdiagNode, only: obs_diags + use kinds , only: i_kind,r_kind + use mpeu_util, only: assert_,die,perr,warn,tell + use m_obsNode, only: obsNode + + implicit none + private + + public:: fedNode + + type,extends(obsNode):: fedNode + type(obs_diag), pointer :: diags => NULL() + real(r_kind) :: res ! flash extent density residual + real(r_kind) :: err2 ! flash extent density error squared + real(r_kind) :: raterr2 ! square of ratio of final obs error + ! to original obs error + real(r_kind) :: b ! variational quality control parameter + real(r_kind) :: pg ! variational quality control parameter + real(r_kind) :: jb ! variational quality control parameter + real(r_kind) :: wij(8) ! horizontal interpolation weights + real(r_kind) :: fedpertb ! random number adding to the obs + integer(i_kind) :: k1 ! level of errtable 1-33 + integer(i_kind) :: kx ! ob type + integer(i_kind) :: ij(8) ! horizontal locations + + real (r_kind) :: dlev ! reference to the vertical grid + contains + procedure,nopass:: mytype + procedure:: setHop => obsNode_setHop_ + procedure:: xread => obsNode_xread_ + procedure:: xwrite => obsNode_xwrite_ + procedure:: isvalid => obsNode_isvalid_ + procedure:: gettlddp => gettlddp_ + + end type fedNode + + public:: fedNode_typecast + public:: fedNode_nextcast + interface fedNode_typecast; module procedure typecast_ ; end interface + interface fedNode_nextcast; module procedure nextcast_ ; end interface + + public:: fedNode_appendto + interface fedNode_appendto; module procedure appendto_ ; end interface + + character(len=*),parameter:: MYNAME="m_fedNode" + +#include "myassert.H" +#include "mytrace.H" +contains +function typecast_(aNode) result(ptr_) +!-- cast a class(obsNode) to a type(tdNode) + use m_obsNode, only: obsNode + implicit none + type(fedNode),pointer:: ptr_ + class(obsNode),pointer,intent(in):: aNode + ptr_ => null() + if(.not.associated(aNode)) return + select type(aNode) + type is(fedNode) + ptr_ => aNode + end select +return +end function typecast_ + +function nextcast_(aNode) result(ptr_) +!-- cast an obsNode_next(obsNode) to a type(fedNode) + use m_obsNode, only: obsNode,obsNode_next + implicit none + type(fedNode),pointer:: ptr_ + class(obsNode),target,intent(in):: aNode + + class(obsNode),pointer:: inode_ + inode_ => obsNode_next(aNode) + ptr_ => typecast_(inode_) +return +end function nextcast_ + +subroutine appendto_(aNode,oll) +!-- append aNode to linked-list oLL + use m_obsNode , only: obsNode + use m_obsLList, only: obsLList,obsLList_appendNode + implicit none + type(fedNode),pointer,intent(in):: aNode + type(obsLList),intent(inout):: oLL + + class(obsNode),pointer:: inode_ + inode_ => aNode + call obsLList_appendNode(oLL,inode_) + inode_ => null() +end subroutine appendto_ + +! obsNode implementations + +function mytype() + implicit none + character(len=:),allocatable:: mytype + mytype="[fedNode]" +end function mytype + + +subroutine obsNode_xread_(aNode,iunit,istat,diagLookup,skip) + use m_obsdiagNode, only: obsdiagLookup_locate + implicit none + class(fedNode),intent(inout):: aNode + integer(i_kind),intent(in ):: iunit + integer(i_kind),intent( out):: istat + type(obs_diags),intent(in ):: diagLookup + logical,optional,intent(in ):: skip + + character(len=*),parameter:: myname_=MYNAME//'.obsNode_xread_' + logical:: skip_ +_ENTRY_(myname_) + skip_=.false. + if(present(skip)) skip_=skip + + istat=0 + if(skip_) then + read(iunit,iostat=istat) + if(istat/=0) then + call perr(myname_,'skipping read(%(res,err2,...)), iostat =',istat) + _EXIT_(myname_) + return + endif + + else + read(iunit,iostat=istat) aNode%res , & + aNode%err2 , & + aNode%raterr2 , & + aNode%b , & + aNode%pg , & + aNode%jb , & + aNode%k1 , & + aNode%kx , & + aNode%dlev , & + aNode%wij , & + aNode%ij + if(istat/=0) then + call perr(myname_,'read(%(res,err2,...), iostat =',istat) + _EXIT_(myname_) + return + endif + + aNode%diags => obsdiagLookup_locate(diagLookup,aNode%idv,aNode%iob,1_i_kind) + if(.not.associated(aNode%diags)) then + call perr(myname_,'obsdiagLookup_locate(), %idv =',aNode%idv) + call perr(myname_,' %iob =',aNode%iob) + call die(myname_) + endif + endif +_EXIT_(myname_) +return +end subroutine obsNode_xread_ + +subroutine obsNode_xwrite_(aNode,junit,jstat) + implicit none + class(fedNode),intent(in):: aNode + integer(i_kind),intent(in ):: junit + integer(i_kind),intent( out):: jstat + + character(len=*),parameter:: myname_=MYNAME//'.obsNode_xwrite_' +_ENTRY_(myname_) + + jstat=0 + write(junit,iostat=jstat) aNode%res , & + aNode%err2 , & + aNode%raterr2 , & + aNode%b , & + aNode%pg , & + aNode%jb , & + aNode%k1 , & + aNode%kx , & + aNode%dlev , & + aNode%wij , & + aNode%ij + if(jstat/=0) then + call perr(myname_,'write(%res,err2,...), iostat =',jstat) + _EXIT_(myname_) + return + endif +_EXIT_(myname_) +return +end subroutine obsNode_xwrite_ + +subroutine obsNode_setHop_(aNode) + use m_cvgridLookup, only: cvgridLookup_getiw + implicit none + class(fedNode),intent(inout):: aNode + + character(len=*),parameter:: myname_=MYNAME//'::obsNode_setHop_' +_ENTRY_(myname_) + call cvgridLookup_getiw(aNode%elat,aNode%elon,aNode%dlev,aNode%ij,aNode%wij) +_EXIT_(myname_) +return +end subroutine obsNode_setHop_ + +function obsNode_isvalid_(aNode) result(isvalid_) + implicit none + logical:: isvalid_ + class(fedNode),intent(in):: aNode + + character(len=*),parameter:: myname_=MYNAME//'::obsNode_isvalid_' +_ENTRY_(myname_) + isvalid_=associated(aNode%diags) +_EXIT_(myname_) +return +end function obsNode_isvalid_ + +pure subroutine gettlddp_(aNode,jiter,tlddp,nob) + use kinds, only: r_kind + implicit none + class(fedNode), intent(in):: aNode + integer(kind=i_kind),intent(in):: jiter + real(kind=r_kind),intent(inout):: tlddp + integer(kind=i_kind),optional,intent(inout):: nob + + tlddp = tlddp + aNode%diags%tldepart(jiter)*aNode%diags%tldepart(jiter) + if(present(nob)) nob=nob+1 +return +end subroutine gettlddp_ + +end module m_fedNode diff --git a/src/gsi/m_obsNodeTypeManager.F90 b/src/gsi/m_obsNodeTypeManager.F90 index b5ecc6e1ba..43b42e4bf2 100644 --- a/src/gsi/m_obsNodeTypeManager.F90 +++ b/src/gsi/m_obsNodeTypeManager.F90 @@ -70,6 +70,7 @@ module m_obsNodeTypeManager use m_lightNode, only: lightNode use m_dbzNode , only: dbzNode + use m_fedNode, only: fedNode use kinds, only: i_kind use m_obsNode, only: obsNode @@ -124,6 +125,7 @@ module m_obsNodeTypeManager public:: iobsNode_light public:: iobsNode_dbz + public:: iobsNode_fed public :: obsNode_typeMold public :: obsNode_typeIndex @@ -179,6 +181,7 @@ module m_obsNodeTypeManager type( lwcpNode), target, save:: lwcp_mold type( lightNode), target, save:: light_mold type( dbzNode), target, save:: dbz_mold + type( fedNode), target, save:: fed_mold !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ character(len=*),parameter :: myname='m_obsNodeTypeManager' @@ -245,6 +248,7 @@ module m_obsNodeTypeManager enumerator:: iobsNode_lwcp enumerator:: iobsNode_light enumerator:: iobsNode_dbz + enumerator:: iobsNode_fed enumerator:: iobsNode_extra_ end enum @@ -314,6 +318,7 @@ function vname2index_(vname) result(index_) case("light","[lightnode]"); index_ = iobsNode_light case("dbz" , "[dbznode]"); index_ = iobsNode_dbz + case("fed" , "[fednode]"); index_ = iobsNode_fed end select end function vname2index_ @@ -377,6 +382,7 @@ function vmold2index_select_(mold) result(index_) type is(lightNode); index_ = iobsNode_light type is( dbzNode); index_ = iobsNode_dbz + type is( fedNode); index_ = iobsNode_fed end select end function vmold2index_select_ @@ -434,6 +440,7 @@ function index2vmold_(i_obType) result(obsmold_) case(iobsNode_light); obsmold_ => light_mold case(iobsNode_dbz); obsmold_ => dbz_mold + case(iobsNode_fed); obsmold_ => fed_mold end select end function index2vmold_ diff --git a/src/gsi/m_rhs.F90 b/src/gsi/m_rhs.F90 index baee074688..aea417fe27 100644 --- a/src/gsi/m_rhs.F90 +++ b/src/gsi/m_rhs.F90 @@ -80,6 +80,7 @@ module m_rhs public:: i_lwcp public:: i_light public:: i_dbz + public:: i_fed public:: i_cldtot public:: awork_size @@ -146,6 +147,7 @@ module m_rhs enumerator:: i_lwcp enumerator:: i_light enumerator:: i_dbz + enumerator:: i_fed enumerator:: i_cldtot enumerator:: i_outbound diff --git a/src/gsi/mpeu_util.F90 b/src/gsi/mpeu_util.F90 index 960af8b71a..76271a4770 100644 --- a/src/gsi/mpeu_util.F90 +++ b/src/gsi/mpeu_util.F90 @@ -553,22 +553,6 @@ subroutine close_if_(fname,stat) endif end subroutine close_if_ -#ifdef _NEW_CODE_ -!! need to send outputs to variables. -!! need to set return code (stat=). -subroutine ls_(files) ! show information? or just inquire(exists(file)) - call system("ls "//files) -end subroutine ls_ -subroutine rm_(files) ! delete, open();close(status='delete') - call system("rm "//files) -end subroutine rm_ -subroutine mkdir_(dir,mode,parents) - call system("mkdir "//files) -end subroutine mkdir_ -subroutine size_(file) ! faster access? - call system("wc -c "//files) -end subroutine size_ -#endif #endif function myid_(who) diff --git a/src/gsi/obsmod.F90 b/src/gsi/obsmod.F90 index 3066cdb5ca..26f8ff1bbf 100644 --- a/src/gsi/obsmod.F90 +++ b/src/gsi/obsmod.F90 @@ -160,6 +160,7 @@ module obsmod ! 2021-11-16 Zhao - add option l_obsprvdiag (if true) to trigger the output of ! observation provider and sub-provider information into ! obsdiags files (used for AutoObsQC) +! 2023-07-10 Y. Wang, D. Dowell - add variables for flash extent density ! ! Subroutines Included: ! sub init_obsmod_dflts - initialize obs related variables to default values @@ -186,6 +187,7 @@ module obsmod ! def write_diag - namelist logical array to compute/write (=true) diag files ! def diag_radardbz- namelist logical to compute/write (=true) radar ! reflectiivty diag files +! def diag_fed - namelist logical to compute/write (=true) flash extent density diag files ! def reduce_diag - namelist logical to produce reduced radiance diagnostic files ! def use_limit - parameter set equal to -1 if diag files produced or 0 if not diag files or reduce_diag ! def obs_setup - prefix for files passing pe relative obs data to setup routines @@ -434,6 +436,7 @@ module obsmod public :: ran01dom,dval_use public :: iout_pcp,iout_rad,iadate,iadatemn,write_diag,reduce_diag,oberrflg,bflag,ndat,dthin,dmesh,l_do_adjoint public :: diag_radardbz + public :: diag_fed public :: lsaveobsens public :: iout_cldch, mype_cldch public :: nprof_gps,time_offset,ianldate,tcp_box @@ -483,7 +486,9 @@ module obsmod public :: iout_dbz, mype_dbz ! --- DBZ DA --- - + + public :: iout_fed, mype_fed + public :: obsmod_init_instr_table public :: obsmod_final_instr_table public :: nobs_sub @@ -583,12 +588,12 @@ module obsmod integer(i_kind) iout_co,iout_gust,iout_vis,iout_pblh,iout_tcamt,iout_lcbas integer(i_kind) iout_cldch integer(i_kind) iout_wspd10m,iout_td2m,iout_mxtm,iout_mitm,iout_pmsl,iout_howv - integer(i_kind) iout_uwnd10m,iout_vwnd10m + integer(i_kind) iout_uwnd10m,iout_vwnd10m,iout_fed integer(i_kind) mype_t,mype_q,mype_uv,mype_ps,mype_pw, & mype_rw,mype_dw,mype_gps,mype_sst, & mype_tcp,mype_lag,mype_co,mype_gust,mype_vis,mype_pblh, & mype_wspd10m,mype_td2m,mype_mxtm,mype_mitm,mype_pmsl,mype_howv,& - mype_uwnd10m,mype_vwnd10m, mype_tcamt,mype_lcbas, mype_dbz + mype_uwnd10m,mype_vwnd10m, mype_tcamt,mype_lcbas, mype_dbz, mype_fed integer(i_kind) mype_cldch integer(i_kind) iout_swcp, iout_lwcp integer(i_kind) mype_swcp, mype_lwcp @@ -638,6 +643,7 @@ module obsmod logical lobserver,l_do_adjoint, lobsdiag_forenkf logical,dimension(0:50):: write_diag logical diag_radardbz + logical diag_fed logical reduce_diag logical offtime_data logical hilbert_curve @@ -789,6 +795,7 @@ subroutine init_obsmod_dflts end do write_diag(1)=.true. diag_radardbz = .false. + diag_fed = .false. reduce_diag = .false. use_limit = -1 lobsdiagsave=.false. @@ -853,6 +860,7 @@ subroutine init_obsmod_dflts iout_lwcp=236 ! liquid-water content path iout_light=237 ! lightning iout_dbz=238 ! radar reflectivity + iout_fed=239 ! flash extent density mype_ps = npe-1 ! surface pressure mype_t = max(0,npe-2) ! temperature @@ -887,6 +895,7 @@ subroutine init_obsmod_dflts mype_lwcp=max(0,npe-31) ! liquid-water content path mype_light=max(0,npe-32)! GOES/GLM lightning mype_dbz=max(0,npe-33) ! radar reflectivity + mype_fed= max(0,npe-34) ! flash extent density ! Initialize arrays used in namelist obs_input @@ -981,7 +990,7 @@ subroutine init_obsmod_dflts return end subroutine init_obsmod_dflts - subroutine init_directories(mype) + subroutine init_directories(in_pe,num_pe) !$$$ subprogram documentation block ! . . . . ! subprogram: create sub-directories @@ -1006,20 +1015,42 @@ subroutine init_directories(mype) ! machine: ibm rs/6000 sp ! !$$$ end documentation block +#ifdef __INTEL_COMPILER + use IFPORT +#endif implicit none - integer(i_kind),intent(in ) :: mype + integer(i_kind),intent(in ) :: in_pe + integer(i_kind),intent(in ) :: num_pe + logical :: l_mkdir_stat character(len=144):: command - character(len=8):: pe_name + character(len=8):: pe_name, loc_pe_name + character(len=128):: loc_dirname + integer(i_kind) :: i if (lrun_subdirs) then - write(pe_name,'(i4.4)') mype + write(pe_name,'(i4.4)') in_pe dirname = 'dir.'//trim(pe_name)//'/' - command = 'mkdir -p -m 755 ' // trim(dirname) - call system(command) +! Only create directories on one PE + if(in_pe == 0) then + do i = 0, num_pe + write(loc_pe_name,'(i4.4)') i + loc_dirname = 'dir.'//trim(loc_pe_name) +#ifdef __INTEL_COMPILER + l_mkdir_stat = MAKEDIRQQ(trim(loc_dirname)) + if(.not. l_mkdir_stat) then + write(6, *) "Failed to create directory ", trim(loc_dirname), " for PE ", loc_pe_name + call stop2(678) + endif +#else + command = 'mkdir -p -m 755 ' // trim(loc_dirname) + call system(command) +#endif + enddo + endif else - write(pe_name,100) mype + write(pe_name,100) in_pe 100 format('pe',i4.4,'.') dirname= trim(pe_name) end if diff --git a/src/gsi/read_anowbufr.f90 b/src/gsi/read_anowbufr.f90 index e2b744eb6a..1873d0b877 100644 --- a/src/gsi/read_anowbufr.f90 +++ b/src/gsi/read_anowbufr.f90 @@ -307,6 +307,7 @@ subroutine read_anowbufr(nread,ndata,nodata,gstime,& ndata=ndata+1 nodata=nodata+1 + if(ndata>maxobs) exit cdata_all(iconc,ndata) = conc ! pm2_5 obs cdata_all(ierror,ndata) = obserror ! pm2_5 obs error diff --git a/src/gsi/read_dbz_nc.f90 b/src/gsi/read_dbz_nc.f90 index cddbd14de4..f6ac9aa112 100644 --- a/src/gsi/read_dbz_nc.f90 +++ b/src/gsi/read_dbz_nc.f90 @@ -417,6 +417,7 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no !#################### Data thinning ################### icntpnt=icntpnt+1 + if(icntpnt>maxobs) exit if(ithin > 0)then diff --git a/src/gsi/read_fed.f90 b/src/gsi/read_fed.f90 new file mode 100644 index 0000000000..c478b3d93f --- /dev/null +++ b/src/gsi/read_fed.f90 @@ -0,0 +1,525 @@ +subroutine read_fed(nread,ndata,nodata,infile,obstype,lunout,twind,sis,nobs) +!$$$ subprogram documentation block +! . . . . +! ABSTRACT: +! This routine reads in netcdf or prepbufr flash-extent density (FED) data. +! +! PROGRAM HISTORY LOG: +! 2018-07-25 Rong Kong (CAPS/OU) - modified based on read_radarref_mosaic.f90 +! 2019-09-20 Yaping Wang (CIMMS/OU) +! 2021-07-01 David Dowell (DCD; NOAA GSL) - added maximum flashes/min for observed FED +! +! input argument list: +! infile - unit from which to read observation information file +! obstype - observation type to process +! lunout - unit to which to write data for further processing +! twind - input group time window (hours) +! sis - observation variable name +! +! output argument list: +! nread - number of type "obstype" observations read +! ndata - number of type "obstype" observations retained for further processing +! nobs - array of observations on each subdomain for each processor +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +! +!$$$ +! +!_____________________________________________________________________ +! + use kinds, only: r_kind,r_double,i_kind + use constants, only: zero,one,deg2rad + use convinfo, only: nconvtype,ctwind,icuse,ioctype + use gsi_4dvar, only: l4dvar,l4densvar,winlen + use gridmod, only: tll2xy + use mod_wrfmass_to_a, only: wrfmass_obs_to_a8 + use mpimod, only: npe + use obsmod, only: perturb_obs,iadatemn + + use netcdf + implicit none + + include 'netcdf.inc' +! + character(len=*), intent(in) :: infile,obstype + integer(i_kind), intent(in) :: lunout + integer(i_kind), intent(inout) :: nread,ndata + integer(i_kind), intent(inout) :: nodata + integer(i_kind), dimension(npe) ,intent(inout) :: nobs + real(r_kind), intent(in ) :: twind + character(len=*), intent(in) :: sis + +! Declare local parameters + real(r_kind),parameter:: r90 = 90.0_r_kind + real(r_kind),parameter:: r360 = 360.0_r_kind + real(r_kind),parameter:: oe_fed = 1.0_r_kind + real(r_kind),parameter:: fed_lowbnd = 0.1_r_kind ! use fed == fed_lowbnd + real(r_kind),parameter:: fed_lowbnd2 = 0.1_r_kind ! use fed >= fed_lowbnd2 +! real(r_kind),parameter:: fed_highbnd = 18.0_r_kind ! 18 flashes/min from Sebok and Back (2021, unpublished) + real(r_kind),parameter:: fed_highbnd = 8.0_r_kind ! 8 flashes/min from Back (2023) for regional FV3 tests + +! +! For fed observations +! + integer(i_kind) nreal,nchanl + + integer(i_kind) ifn,i + + integer(i_kind) :: ilon,ilat + + logical :: fedobs, fedob + real(r_kind),allocatable,dimension(:,:):: cdata_out + real(r_kind) :: federr, thiserr + real(r_kind) :: hgt_fed(1) + data hgt_fed / 6500.0 / + + real(r_kind) :: i_maxloc,j_maxloc,k_maxloc + integer(i_kind) :: kint_maxloc + real(r_kind) :: fed_max + integer(i_kind) :: ndata2 + integer(i_kind) :: ppp + +! +! for read in bufr +! + real(r_kind) :: hdr(5),obs(1,3) + character(80):: hdrstr='SID XOB YOB DHR TYP' + character(80):: obsstr='FED' + + character(8) subset + character(8) station_id + real(r_double) :: rstation_id + equivalence(rstation_id,station_id) + integer(i_kind) :: lunin,idate + integer(i_kind) :: ireadmg,ireadsb + + integer(i_kind) :: maxlvl + integer(i_kind) :: numlvl,numfed,nmsgmax,maxobs + integer(i_kind) :: k,iret + integer(i_kind) :: nmsg,ntb + + real(r_kind),allocatable,dimension(:,:) :: fed3d_column ! 3D fed in column + real(r_kind),allocatable,dimension(:) :: utime ! time + + integer(i_kind) :: ikx + real(r_kind) :: timeo,t4dv + + character*128 :: myname='read_fed' + + real(r_kind) :: dlat, dlon ! rotated corrdinate + real(r_kind) :: dlat_earth, dlon_earth ! in unit of degree + real(r_kind) :: rlat00, rlon00 ! in unit of rad + + logical :: l_psot_fed + logical :: l_latlon_fedobs + logical :: outside + integer :: unit_table + +! for read netcdf + integer(i_kind) :: sec70,mins_an + integer(i_kind) :: varID, ncdfID, status + real(r_kind) :: timeb,twindm,rmins_an,rmins_ob + + + unit_table = 23 +!********************************************************************** +! +! END OF DECLARATIONS....start of program +! + write(6,*) "r_kind=",r_kind + l_psot_fed = .FALSE. + l_latlon_fedobs = .TRUE. + + fedob = obstype == 'fed' + if(fedob) then + nreal=25 + else + write(6,*) ' illegal obs type in read_fed : obstype=',obstype + call stop2(94) + end if + if(perturb_obs .and. fedob)nreal=nreal+1 + write(6,*)'read_fed: nreal=',nreal + + fedobs = .false. + ikx=0 + do i=1,nconvtype + if(trim(obstype) == trim(ioctype(i)) .and. abs(icuse(i))== 1) then + fedobs=.true. + ikx=i + federr = oe_fed ! Obs error (flashes per minute) + thiserr = federr + exit ! Exit loop when finished with initial convinfo fields + else if (i == nconvtype ) then + write(6,*) 'read_fed: Obs Type for fed is not in CONVINFO !' + write(6,*) 'read_fed: PLEASE modify the CONVINFO file !' + write(6,*) 'read_fed: abort read_fed !' + return + endif + end do + write(6,'(1x,A,A30,I4,A15,F7.3,A7)') & + trim(myname),': fed in convinfo-->ikx=',ikx,' fed ob err:',thiserr," (fed)" + + nread=0 + ndata=0 + nchanl=0 + ifn = 15 + + if(fedobs) then + maxlvl= 1 ! fed only has one level + + if(trim(infile) .eq. "fedbufr") then ! prebufr or netcdf format + !! get message and subset counts + ! nmsgmax and maxobs are read in from BUFR data file, not pre-set. + call getcount_bufr(infile,nmsgmax,maxobs) + write(6,*)'read_fed: nmsgmax=',nmsgmax,' maxobs=',maxobs + +! read in fed obs in bufr code format + lunin = 10 + allocate(fed3d_column(maxlvl+2+2,maxobs)) + + open ( unit = lunin, file = trim(infile),form='unformatted',err=200) + call openbf ( lunin, 'IN', lunin ) + open(unit_table,file='prepobs_kr.bufrtable') !temporily dump the bufr table, which is already saved in file + call dxdump(lunin,unit_table) + call datelen ( 10 ) + + nmsg=0 + ntb = 0 + + ndata =0 + ppp = 0 + msg_report: do while (ireadmg(lunin,subset,idate) == 0) + nmsg=nmsg+1 + if (nmsg>nmsgmax) then + write(6,*)'read_fed: messages exceed maximum ',nmsgmax + call stop2(50) + endif + loop_report: do while (ireadsb(lunin) == 0) + ntb = ntb+1 + if (ntb>maxobs) then + write(6,*)'read_fed: reports exceed maximum ',maxobs + call stop2(50) + endif + + ! Extract type, date, and location information from BUFR file + call ufbint(lunin,hdr,5,1,iret,hdrstr) + if(hdr(3) .gt. r90 ) write(6,*) "Inside read_fed.f90, hdr(2)=",hdr(2),"hdr(3)=",hdr(3) + if ( l_latlon_fedobs ) then + if(abs(hdr(3))>r90 .or. abs(hdr(2))>r360) cycle loop_report + if(hdr(2)== r360)hdr(2)=hdr(2)-r360 + if(hdr(2) < zero)hdr(2)=hdr(2)+r360 + end if + +! check time window in subset + if (l4dvar.or.l4densvar) then + t4dv=hdr(4) + if (t4dvwinlen) then + write(6,*)'read_fed: time outside window ',& + t4dv,' skip this report' + cycle loop_report + endif + else + timeo=hdr(4) + if (abs(timeo)>ctwind(ikx) .or. abs(timeo) > twind) then + write(6,*)'read_fed: time outside window ',& + timeo,' skip this report' + cycle loop_report + endif + endif +! read in observations + call ufbint(lunin,obs,1,3,iret,obsstr) !Single level bufr data, Rong Kong + if(obs(1,1) .gt. 5 ) write(6,*) "Inside read_fed.f90, obs(1,1)=",obs(1,1) + numlvl=min(iret,maxlvl) + if (numlvl .ne. maxlvl) then + write(6,*)' read_fed: numlvl is not equalt to maxlvl:',numlvl,maxlvl + end if + if(hdr(3) .gt. 90) write(6,*) "hdr(3)=",hdr(3) + if ( l_latlon_fedobs ) then + if(hdr(2)>= r360)hdr(2)=hdr(2)-r360 + if(hdr(2) < zero)hdr(2)=hdr(2)+r360 + fed3d_column(1,ntb)=hdr(2) ! observation location, earth lon + fed3d_column(2,ntb)=hdr(3) ! observation location, earth lat +! write(6,*) "Inside read_fed.f90, fed3d_column(1,ntb)=",fed3d_column(1,ntb),"fed3d_column(2,ntb)=",fed3d_column(2,ntb) + else + fed3d_column(1,ntb)=hdr(2)*10.0_r_kind ! observation location, grid index i + fed3d_column(2,ntb)=hdr(3)*10.0_r_kind ! observation location, grid index j + end if + + if (l_psot_fed .and. .NOT. l_latlon_fedobs ) then + do k=1,numlvl + if (NINT(fed3d_column(1,ntb)) .eq. 175 .and. NINT(fed3d_column(2,ntb)) .eq. 105 .and. & + NINT(hgt_fed(k)) .ge. 100 ) then + write(6,*) 'read_fed: single point/column obs run on grid: 175 105' + write(6,*) 'read_fed: found the pseudo single(column) fed obs:',fed3d_column(1:2,ntb),hgt_fed(k) + else + obs(1,1) = -999.0 + end if + end do + end if + + fed3d_column(3,ntb)=obs(1,1) + fed3d_column(4,ntb)=obs(1,2) + fed3d_column(5,ntb)=obs(1,3) + if (obs(1,1) == fed_lowbnd .or. obs(1,1) >= fed_lowbnd2 ) then + if (obs(1,1) == 0.0) then + ppp = ppp + 1 + endif + ndata = ndata + 1 + endif + + enddo loop_report + enddo msg_report + + write(6,*)'read_fed: messages/reports = ',nmsg,'/',ntb + print*,'number of Z that is less than 0 is ppp = ', ppp + numfed=ntb + +! - Finished reading fed observations from BUFR format data file +! + call closbf(lunin) + close(lunin) + + else ! NETCDF format +!!!! Start reading fed observations from NETCDF format data file + ! CHECK IF DATA FILE EXISTS + + ! OPEN NETCDF FILE + status = nf90_open(TRIM(infile), NF90_NOWRITE, ncdfID) + print*, '*** OPENING GOES FED OBS NETCDF FILE: ', infile, status + + + !------------------------ + ! Get date information + !------------------------- + ! status = nf90_get_att( ncdfID, nf90_global, 'year', idate5s(1) ) + ! print*, 'year ',status + ! status = nf90_get_att( ncdfID, nf90_global, 'month', idate5s(2) ) + ! status = nf90_get_att( ncdfID, nf90_global, 'day', idate5s(3) ) + ! status = nf90_get_att( ncdfID, nf90_global, 'hour', idate5s(4) ) + ! status = nf90_get_att( ncdfID, nf90_global, 'minute', idate5s(5) ) + ! read(idate5s(:) , *) idate5(:) + ! print*, idate5 + + !------------------------ + ! Get Dimension Info (1-D) + !------------------------- + status = nf90_inq_varid( ncdfID, 'numobs', varID ) + status = nf90_get_var( ncdfID, varID, maxobs ) + + !------------------------ + ! Allocate data arrays + !------------------------- + ALLOCATE( fed3d_column( 5, maxobs ) ) + ALLOCATE( utime( 1 ) ) ! seconds since from 2000-01-01 12:00 + + !------------------------ + ! Get useful data arrays + !------------------------- + ! LON + status = nf90_inq_varid( ncdfID, 'lon', varID ) + status = nf90_get_var( ncdfID, varID, fed3d_column(1, :) ) + ! LAT + status = nf90_inq_varid( ncdfID, 'lat', varID ) + status = nf90_get_var( ncdfID, varID, fed3d_column(2, :) ) + ! FED value + status = nf90_inq_varid( ncdfID, 'value', varID ) + status = nf90_get_var( ncdfID, varID, fed3d_column(3, :) ) + ! TIME + status = nf90_inq_varid( ncdfID, 'time', varID ) + status = nf90_get_var( ncdfID, varID, utime ) + + ! CLOSE NETCDF FILE + status = nf90_close( ncdfID ) + + + !-Obtain analysis time in minutes since reference date + sec70 = 694267200.0 ! seconds since from 1978-01-01 00:00 to 2000-01-01 12:00 + ! because the official GOES prescribed epoch time for GLM data is 2000-01-01 12:00:00 + + call w3fs21(iadatemn,mins_an) !mins_an -integer number of mins snce 01/01/1978 + rmins_an=mins_an !convert to real number + + ! SINCE ALL OBS WILL HAVE THE SAME TIME, CHECK TIME HERE: + rmins_ob = ( utime(1) + sec70 )/60 !Convert to Minutes from seconds + twindm = twind*60. !Convert to Minutes from hours + timeb = rmins_ob-rmins_an + + if(abs(timeb) > abs(twindm)) then + print*, 'WARNING: ALL FED OBSERVATIONS OUTSIDE ASSIMILATION TIME WINDOW: ', timeb, twindm + ! goto 314 + endif + numfed = maxobs + do i=1,numfed + if (fed3d_column( 3, i ) >= fed_lowbnd2 .or. fed3d_column( 3, i ) == fed_lowbnd ) then + ndata = ndata + 1 + end if + end do + end if ! end if prebufr or netcdf format + + write(6,*)'read_fed: total no. of obs = ',ndata + nread=ndata + nodata=ndata +!!! - Finished reading fed observations from NETCDF format data file + + + + allocate(cdata_out(nreal,ndata)) +! +! + do i=1,numfed + do k=1,maxlvl + +! DCD 1 July 2021 + if (fed3d_column(k+2,i) .gt. fed_highbnd) fed3d_column(k+2,i) = fed_highbnd + + end do + end do + + write(6,*) ' ------- check max and min value of OBS: bufr fed -------' + write(6,*) ' level maxval(fed) minval(fed)' + do k=1,maxlvl + write(6,*) k,maxval(fed3d_column(k+2,:)),minval(fed3d_column(k+2,:)) + end do + + + i_maxloc=-1.0 + j_maxloc=-1.0 + k_maxloc=-1.0 + kint_maxloc=-1 + fed_max=-999.99 + ndata2=0 + do i=1,numfed + do k=1,maxlvl + if( fed3d_column(k+2,i) >= fed_lowbnd2 .or. fed3d_column(k+2,i) == fed_lowbnd) then !Rong Kong + dlon_earth = fed3d_column(1,i) ! longitude (degrees) of observation + ! ilone=18 ! index of longitude (degrees) + dlat_earth = fed3d_column(2,i) ! latitude (degrees) of observation + ! ilate=19 ! index of latitude (degrees) + !-Check format of longitude and correct if necessary + if(dlon_earth>=r360) dlon_earth=dlon_earth-r360 + if(dlon_earth=r360 .or. dlat_earth >90.0_r_kind) cycle + + !-Convert back to radians + rlon00 = dlon_earth*deg2rad + rlat00 = dlat_earth*deg2rad + call tll2xy(rlon00,rlat00,dlon,dlat,outside) + if (outside) cycle + + !If observation is outside the domain + ! then cycle, but don't increase + ! range right away. + ! Domain could be rectangular, so ob + ! may be out of + ! range at one end, but not the + ! other. + + ndata2=ndata2+1 + cdata_out( 1,ndata2) = thiserr ! obs error (flashes/min) - inflated/adjusted + + cdata_out( 2,ndata2) = dlon ! + + cdata_out( 3,ndata2) = dlat + + cdata_out( 4,ndata2) = hgt_fed(k) ! obs absolute height (m) above MSL + ! ipres=4 ! index of pressure + cdata_out( 5,ndata2) = fed3d_column(k+2,i) ! FED value + ! idbzob=5 ! index of dbz observation + cdata_out( 6,ndata2) = rstation_id ! station id (charstring equivalent to real double) + ! id=6 ! index of station id + + cdata_out( 7,ndata2) = 0.0_r_kind ! observation time in data array + ! itime=7 ! index of observation time in data array + cdata_out( 8,ndata2) = ikx ! ob type + ! ikxx=8 ! index of ob type + cdata_out( 9,ndata2) = thiserr*2.0_r_kind ! max error + ! iqmax=9 ! index of max error + cdata_out(10,ndata2) = 273.0_r_kind ! dry temperature + ! itemp=10 ! index of dry temperature + cdata_out(11,ndata2) = 1.0_r_kind ! quality mark + ! iqc=11 ! index of quality mark + cdata_out(12,ndata2) = thiserr ! original-original obs error ratio + ! ier2=12 ! index of original-original obs error ratio + cdata_out(13,ndata2) = icuse(ikx) ! index of use parameter + ! iuse=13 ! index of use parameter + cdata_out(14,ndata2) = icuse(ikx) ! dominant surface type + ! idomsfc=14 ! index of dominant surface type + cdata_out(15,ndata2) = 273.0_r_kind ! index of surface skin temperature + ! iskint=15 ! index of surface skin temperature + cdata_out(16,ndata2) = 0.5_r_kind ! 10 meter wind factor + ! iff10=16 ! index of 10 meter wind factor + cdata_out(17,ndata2) = 0.5_r_kind ! surface roughness + ! isfcr=17 ! index of surface roughness + + cdata_out(18,ndata2) = dlon_earth ! longitude (degrees) + + cdata_out(19,ndata2) = dlat_earth ! latitude (degrees) + + cdata_out(20,ndata2) = hgt_fed(k) ! station elevation (m) + ! istnelv=20 ! index of station elevation (m) + cdata_out(21,ndata2) = hgt_fed(k) ! observation height (m) + ! iobshgt=21 ! index of observation height (m) + cdata_out(22,ndata2) = hgt_fed(k) ! surface height + ! izz=22 ! index of surface height + cdata_out(23,ndata2) = fed3d_column(4,i) ! i index of obs grid for bufr resolution (i.e.,8km) + + cdata_out(24,ndata2) = fed3d_column(5,i) ! j index of obs grid for bufr resolution + + cdata_out(25,ndata2) = hgt_fed(k) ! data level category + ! icat =25 ! index of data level category + if(perturb_obs .and. fedob)then + cdata_out(26,ndata2) = 1.0_r_kind ! obs perturbation + ! iptrb=26 ! index of q perturbation + end if +! print*,'cdata_out(:,ndata2)=',cdata_out(:,ndata2) + if(fed3d_column(k+2,i) > fed_max)then + kint_maxloc=k + k_maxloc=real(k,r_kind) + j_maxloc=fed3d_column(2,i) + i_maxloc=fed3d_column(1,i) + fed_max =fed3d_column(k+2,i) + end if + endif + enddo + enddo + +!---all looping done now print diagnostic output + write(6,*)'READ_FED: Reached eof on FED file' + write(6,*)'READ_FED: # read in obs. number =',nread + write(6,*)'READ_FED: # read in obs. number for further processing =',ndata2 + ! write(6,*)'READ_FED: dlon_earth', cdata_out(18,10:15) + + ilon=2 ! array index for longitude + ilat=3 ! array index for latitude in obs information array + ndata=ndata2 + nodata=ndata2 + + !---Write observations to scratch file---! + +! if(ndata > 0 ) then + call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs) + write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata + write(lunout) ((cdata_out(k,i),k=1,nreal),i=1,ndata) + ! print*,'cdata_out',cdata_out +! endif + + deallocate(cdata_out) + if (allocated(fed3d_column)) deallocate(fed3d_column) + + write(6,'(1x,A,F12.5,1x,A,3(1x,F8.3),1x,I4)') & + 'read_fed: max fed =',fed_max, '@ i j k =', & + i_maxloc,j_maxloc,k_maxloc,kint_maxloc + + end if +! close(lunout) ! ???? + return + +200 continue + write(6,*) 'read_fed, Warning : cannot find or open bufr fed data file: ', trim(infile) + +314 continue +print* ,'FINISHED WITH READ_FED' +end subroutine read_fed +! +! diff --git a/src/gsi/read_files.f90 b/src/gsi/read_files.f90 index 5d29efbace..dadcbff3e5 100644 --- a/src/gsi/read_files.f90 +++ b/src/gsi/read_files.f90 @@ -585,7 +585,7 @@ subroutine read_files(mype) if (nst_gsi > 0 ) call mpi_bcast(time_nst,2*nfldnst,mpi_rtype,npem1,mpi_comm_world,ierror) ! for external aerosol files - if(.not.allocated(time_aer)) allocate(time_aer(nfldaer,2)) + if(lread_ext_aerosol .and. (.not.allocated(time_aer))) allocate(time_aer(nfldaer,2)) if (lread_ext_aerosol) call mpi_bcast(time_aer,2*nfldaer,mpi_rtype,npem1,mpi_comm_world,ierror) call mpi_bcast(iamana,3,mpi_rtype,npem1,mpi_comm_world,ierror) diff --git a/src/gsi/read_gmi.f90 b/src/gsi/read_gmi.f90 index 0f45aa7e28..f59529662a 100644 --- a/src/gsi/read_gmi.f90 +++ b/src/gsi/read_gmi.f90 @@ -528,6 +528,7 @@ subroutine read_gmi(mype,val_gmi,ithin,rmesh,jsatid,gstime,& flgch = 0 iobs=iobs+1 + if(iobs>maxobs) exit end do read_loop end do read_subset 690 continue diff --git a/src/gsi/read_goesglm.f90 b/src/gsi/read_goesglm.f90 index e0124abbf2..bf8639c72d 100644 --- a/src/gsi/read_goesglm.f90 +++ b/src/gsi/read_goesglm.f90 @@ -276,6 +276,7 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis) icntpnt=icntpnt+1 ndata=ndata+1 + if(ndata>maxobs) exit nodata=nodata+1 iout=ndata isort(icntpnt)=iout diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index 208b333f49..038188f92a 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -826,6 +826,8 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& ! Put satinfo defined channel temperatures into data array do l=1,satinfo_nchan + ! Prevent out of bounds reference from temperature + if ( bufr_index(l) == 0 ) cycle i = bufr_index(l) data_all(l+nreal,itx) = temperature(i) ! brightness temerature end do diff --git a/src/gsi/read_obs.F90 b/src/gsi/read_obs.F90 index 86c7e4ce45..cb4a7c4b8f 100644 --- a/src/gsi/read_obs.F90 +++ b/src/gsi/read_obs.F90 @@ -192,6 +192,7 @@ subroutine read_obs_check (lexist,filename,jsatid,dtype,minuse,nread) if ( .not. l_use_dbz_directDA) then if(trim(dtype) == 'dbz' )return end if + if(trim(dtype) == 'fed' )return ! Use routine as usual @@ -435,10 +436,10 @@ subroutine read_obs_check (lexist,filename,jsatid,dtype,minuse,nread) end do nread = nread + 1 end do airploop - else if(trim(filename) == 'satwndbufr')then + else if(index(filename,'satwnd') /=0 .or. index(filename,'satwhr') /=0) then lexist = .false. loop: do while(ireadmg(lnbufr,subset,idate2) >= 0) -! 5 GOES-R AMVs (NC005030, NC005031, NC005032, NC005034 and NC005039) +! 5 GOES-R AMVs (NC005030, NC005031, NC005032, NC005034, NC005039, NC005099) ! are added as the GOES-R bufr file provide do not contain other winds. ! May not be necessary with the operational satwnd BUFR if(trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or.& @@ -449,6 +450,7 @@ subroutine read_obs_check (lexist,filename,jsatid,dtype,minuse,nread) trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or.& trim(subset) == 'NC005032' .or. trim(subset) == 'NC005034' .or.& trim(subset) == 'NC005039' .or. & + trim(subset) == 'NC005099' .or. & trim(subset) == 'NC005090' .or. trim(subset) == 'NC005091' .or.& trim(subset) == 'NC005067' .or. trim(subset) == 'NC005068' .or. trim(subset) == 'NC005069' .or.& trim(subset) == 'NC005047' .or. trim(subset) == 'NC005048' .or. trim(subset) == 'NC005049' .or.& @@ -911,7 +913,8 @@ subroutine read_obs(ndata,mype) obstype == 'mitm' .or. obstype=='pmsl' .or. & obstype == 'howv' .or. obstype=='tcamt' .or. & obstype=='lcbas' .or. obstype=='cldch' .or. obstype == 'larcglb' .or. & - obstype=='uwnd10m' .or. obstype=='vwnd10m' .or. obstype=='dbz' ) then + obstype=='uwnd10m' .or. obstype=='vwnd10m' .or. obstype=='dbz' .or. & + obstype=='fed') then ditype(i) = 'conv' else if (obstype == 'swcp' .or. obstype == 'lwcp') then ditype(i) = 'wcp' @@ -1302,6 +1305,10 @@ subroutine read_obs(ndata,mype) use_hgtl_full=.true. if(belong(i))use_hgtl_full_proc=.true. end if + if(obstype == 'fed')then + use_hgtl_full=.true. + if(belong(i))use_hgtl_full_proc=.true. + end if if(obstype == 'sst')then if(belong(i))use_sfc=.true. endif @@ -1497,7 +1504,7 @@ subroutine read_obs(ndata,mype) else if(obstype == 'uv' .or. obstype == 'wspd10m' .or. & obstype == 'uwnd10m' .or. obstype == 'vwnd10m') then ! Process satellite winds which seperate from prepbufr - if ( index(infile,'satwnd') /=0 ) then + if ( index(infile,'satwnd') /=0 .or. index(infile,'satwhr') /=0 ) then call read_satwnd(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,& prsl_full,nobs_sub1(1,i)) string='READ_SATWND' @@ -1520,10 +1527,6 @@ subroutine read_obs(ndata,mype) call read_fl_hdob(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,& prsl_full,nobs_sub1(1,i)) string='READ_FL_HDOB' - else if (index(infile,'uprair') /=0)then - call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,& - prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i)) - string='READ_UPRAIR' else call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,& prsl_full,nobs_sub1(1,i),read_rec(i)) @@ -1639,6 +1642,12 @@ subroutine read_obs(ndata,mype) endif end if +! Process flash extent density + else if (obstype == 'fed' ) then + print *, "calling read_fed" + call read_fed(nread,npuse,nouse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i)) + string='READ_FED' + ! Process lagrangian data else if (obstype == 'lag') then call read_lag(nread,npuse,nouse,infile,lunout,obstype,& diff --git a/src/gsi/read_prepbufr.f90 b/src/gsi/read_prepbufr.f90 index 2bf3a7d05d..b72e584155 100644 --- a/src/gsi/read_prepbufr.f90 +++ b/src/gsi/read_prepbufr.f90 @@ -690,7 +690,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! identify drifting buoys - TYP=180/280 T29=562 and last three digits of SID between 500 and 999 ! (see https://www.wmo.int/pages/prog/amp/mmop/wmo-number-rules.html) Set kx to 199/299 - if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(3))==562) then + if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(3),r_double)==562) then rstation_id=hdr(4) read(c_station_id,*,iostat=ios) iwmo if (ios == 0 .and. iwmo > 0) then @@ -700,7 +700,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if end if - if (id_ship .and. (kx==180) .and. (nint(hdr(3))==522 .or. nint(hdr(3))==523)) then + if (id_ship .and. (kx==180) .and. (nint(hdr(3),r_double)==522 .or. nint(hdr(3),r_double)==523)) then rstation_id=hdr(4) kx = kx + 18 end if @@ -969,7 +969,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! ! identify drifting buoys - TYP=180/280 T29=562 and last three digits of SID between 500 and 999 ! (see https://www.wmo.int/pages/prog/amp/mmop/wmo-number-rules.html) Set kx to 199/299 - if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(8))==562 ) then + if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(8),r_double)==562) then rstation_id=hdr(1) read(c_station_id,*,iostat=ios) iwmo if (ios == 0 .and. iwmo > 0) then @@ -979,7 +979,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if end if - if (id_ship .and. (kx==180) .and. (nint(hdr(8))==522 .or. nint(hdr(8))==523) ) then + if (id_ship .and. (kx==180) .and. (nint(hdr(8),r_double)==522 .or. nint(hdr(8),r_double)==523) ) then rstation_id=hdr(1) kx = kx + 18 end if @@ -1179,7 +1179,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& enddo do k=1,levs ppb=obsdat(1,k) - cat=nint(min(obsdat(10,k),qcmark_huge)) + cat=idnint(min(obsdat(10,k),qcmark_huge)) if ( cat /=0 ) cycle ppb=max(zero,min(ppb,r2000)) if(ppb>=etabl_ps(itypex,1,1)) k1_ps=1 @@ -1608,11 +1608,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& plevs(k)=one_tenth*obsdat(1,k) ! convert mb to cb if (kx == 290) plevs(k)=101.0_r_kind ! Assume 1010 mb = 101.0 cb if (goesctpobs) plevs(k)=goescld(1,k)/1000.0_r_kind ! cloud top pressure in cb - pqm(k)=nint(qcmark(1,k)) - qqm(k)=nint(qcmark(2,k)) - tqm(k)=nint(qcmark(3,k)) - wqm(k)=nint(qcmark(5,k)) - pmq(k)=nint(qcmark(8,k)) + pqm(k)=idnint(qcmark(1,k)) + qqm(k)=idnint(qcmark(2,k)) + tqm(k)=idnint(qcmark(3,k)) + wqm(k)=idnint(qcmark(5,k)) + pmq(k)=idnint(qcmark(8,k)) end do ! 181, 183, 187, and 188 are the screen-level obs over land @@ -1642,14 +1642,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if (tpc(k,j)==glcd) then !found GLERL ob - use that and jump out of events stack obsdat(3,k)=tobaux(1,k,j) qcmark(3,k)=min(tobaux(2,k,j),qcmark_huge) - tqm(k)=nint(qcmark(3,k)) + tqm(k)=idnint(qcmark(3,k)) exit - endif - endif + end if + end if if (tpc(k,j)==vtcd) then obsdat(3,k)=tobaux(1,k,j+1) qcmark(3,k)=min(tobaux(2,k,j+1),qcmark_huge) - tqm(k)=nint(qcmark(3,k)) + tqm(k)=idnint(qcmark(3,k)) end if if (tpc(k,j)>=bmiss) exit ! end of stack end do @@ -1731,11 +1731,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if(obsdat(2,k) > r0_01_bmiss)cycle loop_k_levs qm=qqm(k) else if(pwob) then - pwq=nint(qcmark(7,k)) + pwq=idnint(qcmark(7,k)) qm=pwq else if(sstob) then sstq=100 - if (k==1) sstq=nint(min(sstdat(4,k),qcmark_huge)) + if (k==1) sstq=idnint(min(sstdat(4,k),qcmark_huge)) qm=sstq else if(gustob) then gustqm=0 @@ -1791,10 +1791,10 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if if (psob) then - cat=nint(min(obsdat(10,k),qcmark_huge)) + cat=idnint(min(obsdat(10,k),qcmark_huge)) if ( cat /=0 ) cycle loop_k_levs if ( obsdat(1,k)< r500) qm=100 - zqm=nint(qcmark(4,k)) + zqm=idnint(qcmark(4,k)) if (zqm>=lim_zqm .and. zqm/=15 .and. zqm/=9) qm=9 endif @@ -1804,7 +1804,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! extract aircraft profile information if (aircraft_t_bc .and. acft_profl_file) then - if (nint(obsdat(10,k))==7) cycle LOOP_K_LEVS + if (idnint(obsdat(10,k))==7) cycle LOOP_K_LEVS if(abs(hdr3(2,k))>r90 .or. abs(hdr3(1,k))>r360) cycle LOOP_K_LEVS if(hdr3(1,k)== r360)hdr3(1,k)=hdr3(1,k)-r360 if(hdr3(1,k) < zero)hdr3(1,k)=hdr3(1,k)+r360 @@ -3270,7 +3270,7 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) enddo do k=1,levs - cat(k)=nint(obsdat(10,k)) + cat(k)=idnint(obsdat(10,k)) enddo @@ -3287,10 +3287,10 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) if(kx==120)then - pqm(1)=nint(min(qcmark(1,1),10000.0)) - qqm(1)=nint(min(qcmark(2,1),10000.0)) - tqm(1)=nint(min(qcmark(3,1),10000.0)) - zqm(1)=nint(min(qcmark(4,1),10000.0)) + pqm(1)=idnint(min(qcmark(1,1),10000.0)) + qqm(1)=idnint(min(qcmark(2,1),10000.0)) + tqm(1)=idnint(min(qcmark(3,1),10000.0)) + zqm(1)=idnint(min(qcmark(4,1),10000.0)) call grdcrd(dpres,levs,prsltmp(1),nsig,-1) do k=1,levs tvflg(k)=one ! initialize as sensible @@ -3302,10 +3302,10 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) do i=2,levs im=i-1 - pqm(i)=nint(min(qcmark(1,i),10000.0)) - qqm(i)=nint(min(qcmark(2,i),10000.0)) - tqm(i)=nint(min(qcmark(3,i),10000.0)) - zqm(i)=nint(min(qcmark(4,i),10000.0)) + pqm(i)=idnint(min(qcmark(1,i),10000.0)) + qqm(i)=idnint(min(qcmark(2,i),10000.0)) + tqm(i)=idnint(min(qcmark(3,i),10000.0)) + zqm(i)=idnint(min(qcmark(4,i),10000.0)) if ( (cat(i)==2 .or. cat(im)==2 .or. cat(i)==5 .or. cat(im)==5) .and. & pqm(i)<4 .and. pqm(im)<4 )then ku=dpres(i)-1 @@ -3361,14 +3361,14 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) enddo !levs !!!!!!!!! w (not used) !!!!!!!!!!!!!!!!!!!!!!!!!!! elseif(kx==220)then - pqm(1)=nint(min(qcmark(1,1),10000.0)) - wqm(1)=nint(min(qcmark(5,1),10000.0)) + pqm(1)=idnint(min(qcmark(1,1),10000.0)) + wqm(1)=idnint(min(qcmark(5,1),10000.0)) call grdcrd(dpres,levs,prsltmp(1),nsig,-1) do i=2,levs im=i-1 - wqm(i)=nint(min(qcmark(5,i),10000.0)) - zqm(i)=nint(min(qcmark(4,i),10000.0)) - pqm(i)=nint(min(qcmark(1,i),10000.0)) + wqm(i)=idnint(min(qcmark(5,i),10000.0)) + zqm(i)=idnint(min(qcmark(4,i),10000.0)) + pqm(i)=idnint(min(qcmark(1,i),10000.0)) if( wqm(i)<4 .and. wqm(im)<4 .and. pqm(i)<4 .and. pqm(im)<4 .and.& (cat(i)==2 .or. cat(im)==2 .or. cat(i)==5 .or. cat(im)==5) )then ku=dpres(i)-1 diff --git a/src/gsi/read_radar.f90 b/src/gsi/read_radar.f90 index 8e5de5aff9..9ce156e736 100644 --- a/src/gsi/read_radar.f90 +++ b/src/gsi/read_radar.f90 @@ -341,7 +341,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu if (.not.lexist1 .and. .not.lexist2 .and. .not.lexist3) return eradkm=rearth*0.001_r_kind - maxobs=2e8 + maxobs=4e6 nreal=maxdat nchanl=0 ilon=2 @@ -2911,6 +2911,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu !#################### Data thinning ################### icntpnt=icntpnt+1 + if(icntpnt>maxobs) exit if(ithin > 0)then if(zflag == 0)then @@ -4031,6 +4032,7 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full) end if !#################### Data thinning ################### icntpnt=icntpnt+1 + if(icntpnt>maxobs) exit ithin=1 !number of obs to keep per grid box if(radar_no_thinning) then ithin=-1 diff --git a/src/gsi/read_radar_wind_ascii.f90 b/src/gsi/read_radar_wind_ascii.f90 index 2e1b06a50c..604d9d0eca 100644 --- a/src/gsi/read_radar_wind_ascii.f90 +++ b/src/gsi/read_radar_wind_ascii.f90 @@ -509,6 +509,7 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg !#################### Data thinning ################### icntpnt=icntpnt+1 + if(icntpnt>maxobs) exit if(ithin > 0)then if(zflag == 0)then diff --git a/src/gsi/read_satwnd.f90 b/src/gsi/read_satwnd.f90 index 1679708787..943cf4d47b 100644 --- a/src/gsi/read_satwnd.f90 +++ b/src/gsi/read_satwnd.f90 @@ -18,6 +18,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ! 253: EUMETSAT IR winds, 254: EUMETSAT WV deep layer winds ! 257,258,259: MODIS IR,WV cloud top, WV deep layer winds ! 260: VIIR IR winds +! 241: CIMSS enhanced AMV winds ! respectively ! For satellite subtype: 50-80 from EUMETSAT geostationary satellites(METEOSAT) ! 100-199 from JMA geostationary satellites(MTSAT) @@ -77,6 +78,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ! 2021-07-25 Genkova - added code for Metop-B/C winds in new BUFR,NC005081 ! ! 2022-01-20 Genkova - added missing station_id for polar winds ! 2022-01-20 Genkova - added code for Meteosat and Himawari AMVs in new BUFR +! 2022-12-10 Bi - added code for CIMSS enhanced AMVs in new BUFR ! ! ! input argument list: @@ -155,7 +157,6 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis real(r_kind),parameter:: r799=799.0_r_kind real(r_kind),parameter:: r1200= 1200.0_r_kind real(r_kind),parameter:: r10000= 10000.0_r_kind - real(r_double),parameter:: rmiss=10d7 ! Declare local variables @@ -212,7 +213,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis real(r_double),dimension(13):: hdrdat real(r_double),dimension(4):: obsdat - real(r_double),dimension(2) :: hdrdat_test + real(r_double),dimension(2) :: hdrdat_test,hdrdat_005099 real(r_double),dimension(3,5) :: heightdat real(r_double),dimension(6,4) :: derdwdat real(r_double),dimension(3,12) :: qcdat @@ -509,7 +510,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis !GOES-R section of the 'if' statement over 'subsets' else if(trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or. trim(subset) == 'NC005032' .or. & - trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039') then + trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' .or. trim(subset) == 'NC005099') then ! Commented out, because we need clarification for SWCM/hdrdat(9) from Yi Song ! NOTE: Once it is confirmed that SWCM values are sensible, apply this logic and replace lines 685-702 ! if(hdrdat(9) == one) then @@ -537,6 +538,8 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis itype=246 else if(trim(subset) == 'NC005031') then ! WV clear sky/deep layer itype=247 + else if(trim(subset) == 'NC005099') then + itype=241 endif else ! wind is not recognised and itype is not assigned cycle loop_report @@ -735,7 +738,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis do_qc = subset(1:7)=='NC00503'.and.nint(hdrdat(1))>=270 do_qc = do_qc.or.subset(1:7)=='NC00501' do_qc = do_qc.or.subset=='NC005081'.or.subset=='NC005091' - do_qc = do_qc.or.qcret>0 + do_qc = do_qc.or.qcret>0 ! assign types and get quality info: start @@ -1051,7 +1054,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis endif ! get quality information THIS SECTION NEEDS TO BE TESTED!!! call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}') - irep_array = int(rep_array) + irep_array = max(1,int(rep_array)) allocate( amvivr(2,irep_array)) call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD') pct1 = amvivr(2,1) ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova @@ -1175,9 +1178,12 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis endif ! Extra block for VIIRS NOAA20: End ! Extra block for GOES-R winds: Start - else if(trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or. trim(subset) == 'NC005032' .or. & !IR(LW) / CS WV / VIS GOES-R like winds - trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' ) then !CT WV / IR(SW) GOES-R like winds + else if(trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or. trim(subset) == 'NC005032' .or. & !IR(LW) / CS WV / VIS GOES-R like winds + trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' .or. trim(subset) == 'NC005099') then !CT WV / IR(SW) GOES-R like winds + if ( trim(subset) == 'NC005099' ) then + hdrdat(10)=61.23 ! set zenith angle for CIMSS AMVs to 67 to pass QC, no value in origional data + end if if(hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then ! the range of NESDIS satellite IDs ! The sample newBUFR has SAID=259 (GOES-15) ! When GOES-R SAID is assigned, pls check @@ -1209,6 +1215,10 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis c_station_id='WV'//stationid c_sprvstg='WV' !write(6,*)'itype= ',itype + else if(trim(subset) == 'NC005099') then ! WV clear sky/deep layer + itype=241 + c_station_id='IR'//stationid + c_sprvstg='IR' endif ! call ufbint(lunin,rep_array,1,1,iret, '{AMVAHA}') @@ -1223,6 +1233,8 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ! call ufbrep(lunin,amviii,12,irep_array,iret, 'LTDS SCLF SAID SIID CHNM SCCF ORBN SAZA BEARAZ EHAM PRLC TMDBST') ! deallocate( amviii ) + if (itype /= 241) then + call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}') irep_array = int(rep_array) allocate( amvivr(2,irep_array)) @@ -1253,7 +1265,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis if(wrf_nmm_regional) then ! type 251 has been determine not suitable to be subjected to pct1 range check - if(itype==240 .or. itype==245 .or. itype==246) then + if(itype==240 .or. itype==245 .or. itype==246 .or. itype==241) then if (pct1 < 0.04_r_kind) qm=15 if (pct1 > 0.50_r_kind) qm=15 elseif (itype==251) then @@ -1279,6 +1291,16 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis if (isflg == 1 .and. ppb > 850.0_r_kind) qm=15 ! low over land endif + else ! Assign values for the mnemonics/variables missing in original datafile for type 241 + + call ufbint(lunin,hdrdat_005099,2,1,iret, 'GNAPS PCCF'); + qifn=hdrdat_005099(2); + qm=2.0 ! do not reject the wind + pct1=0.4 ! do not reject the wind + ee=1.0 ! do not reject the wind + + endif + ! winds rejected by qc dont get used if (qm == 15) usage=r100 if (qm == 3 .or. qm ==7) woe=woe*r1_2 @@ -1288,9 +1310,12 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis if(itype==246 ) then; c_prvstg='GOESR' ; c_sprvstg='WVCT' ; endif if(itype==247 ) then; c_prvstg='GOESR' ; c_sprvstg='WVCS' ; endif if(itype==251 ) then; c_prvstg='GOESR' ; c_sprvstg='VIS' ; endif + if(itype==241 ) then; c_prvstg='GOESR' ; c_sprvstg='IR' ; endif !to be revisited I.Genkova + endif ! Extra block for GOES-R winds: End else ! wind is not recognised and itype is not assigned + write(6,*) 'read_satwnd: WIND IS NOT RECOGNIZEd and we are in hell' cycle loop_readsb endif @@ -1338,7 +1363,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ! 3 snow ! 4 mixed if( .not. twodvar_regional) then - if(itype ==245 .or. itype ==252 .or. itype ==253 .or. itype ==240) then + if(itype ==245 .or. itype ==252 .or. itype ==253 .or. itype ==240 .or. itype ==241) then if(hdrdat(2) >20.0_r_kind) then call deter_sfc_type(dlat_earth,dlon_earth,t4dv,isflg,tsavg) if(isflg /= 0) cycle loop_readsb @@ -1465,7 +1490,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ! GOES-R wind are identified/recognised here by subset, but it could be done by itype or SAID ! After completing the evaluation of GOES-R winds, REVISE this section!!! if(trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or. trim(subset) == 'NC005032' .or. & - trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' ) then + trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' .or. trim(subset) == 'NC005099') then obserr=obserr/two endif diff --git a/src/gsi/setupaod.f90 b/src/gsi/setupaod.f90 index a1e4656e76..5fe4233ada 100644 --- a/src/gsi/setupaod.f90 +++ b/src/gsi/setupaod.f90 @@ -61,7 +61,8 @@ subroutine setupaod(obsLL,odiagLL,lunin,mype,nchanl,nreal,nobs,& dplat,lobsdiagsave,lobsdiag_allocated,& dirname,time_offset,luse_obsdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, nc_diag_chaninfo + nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, nc_diag_chaninfo, & + nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin use gridmod, only: nsig,get_ij @@ -841,16 +842,16 @@ subroutine contents_netcdf_diag_ if ( iuse_aero(l) < 0 ) cycle call nc_diag_metadata("Channel_Index", i) call nc_diag_metadata("Observation_Class", obsclass) - call nc_diag_metadata("Latitude", sngl(cenlat)) ! observation latitude (degrees) - call nc_diag_metadata("Longitude", sngl(cenlon)) ! observation longitude (degrees) - call nc_diag_metadata("Obs_Time", sngl(dtime))!-time_offset)) ! observation time (hours relative to analysis time) - call nc_diag_metadata("Sol_Zenith_Angle", sngl(pangs)) ! solar zenith angle (degrees) - call nc_diag_metadata("Sol_Azimuth_Angle", sngl(data_s(isazi_ang,n))) ! solar azimuth angle (degrees) + call nc_diag_metadata_to_single("Latitude",(cenlat)) ! observation latitude (degrees) + call nc_diag_metadata_to_single("Longitude",(cenlon)) ! observation longitude (degrees) + call nc_diag_metadata_to_single("Obs_Time",(dtime))!-time_offset)) ! observation time (hours relative to analysis time) + call nc_diag_metadata_to_single("Sol_Zenith_Angle",(pangs)) ! solar zenith angle (degrees) + call nc_diag_metadata_to_single("Sol_Azimuth_Angle",(data_s(isazi_ang,n))) ! solar azimuth angle (degrees) call nc_diag_metadata("Surface_type", nint(data_s(istyp,n))) call nc_diag_metadata("MODIS_deep_blue_flag", nint(dbcf) ) - call nc_diag_metadata("Observation", sngl(diagbufchan(1,i)) ) ! observed aod - call nc_diag_metadata("Obs_Minus_Forecast_adjusted",sngl(diagbufchan(2,i))) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(diagbufchan(2,i)))! obs - sim aod with no bias correction + call nc_diag_metadata("Observation",(diagbufchan(1,i)) ) ! observed aod + call nc_diag_metadata("Obs_Minus_Forecast_adjusted",(diagbufchan(2,i))) + call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",(diagbufchan(2,i)))! obs - sim aod with no bias correction if (diagbufchan(3,i) > tiny_r_kind) then tmp(1)=one/diagbufchan(3,i) @@ -859,7 +860,7 @@ subroutine contents_netcdf_diag_ end if call nc_diag_metadata("Observation_Error",tmp(1)) - call nc_diag_metadata("QC_Flag", sngl(diagbufchan(4,i))) !quality control mark or event indicator + call nc_diag_metadata("QC_Flag",(diagbufchan(4,i))) !quality control mark or event indicator tmp(1)=get_zsfc() call nc_diag_metadata("sfc_height",tmp(1)) ! height in meters diff --git a/src/gsi/setupdbz.f90 b/src/gsi/setupdbz.f90 index 96f0378c52..068842cd6b 100644 --- a/src/gsi/setupdbz.f90 +++ b/src/gsi/setupdbz.f90 @@ -131,7 +131,7 @@ subroutine setupdbz(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,radardbz_d use obsmod, only: luse_obsdiag, netcdf_diag, binary_diag, dirname, ianldate use obsmod, only: doradaroneob,oneobddiff,oneobvalue use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim,nc_diag_read_close use oneobmod, only: oneobtest use oneobmod, only: maginnov @@ -1928,29 +1928,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(ielev,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(zero) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(ielev,i) ) + call nc_diag_metadata_to_single("Pressure", presw ) + call nc_diag_metadata_to_single("Height", data(ihgt,i) ) + call nc_diag_metadata_to_single("Time", dtime, time_offset, "-") + call nc_diag_metadata_to_single("Prep_QC_Mark", zero ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ! ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",one ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",-one ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) - call nc_diag_metadata("Observation", sngl(data(idbzob,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(idbzob,i)-rdBZ) ) + call nc_diag_metadata_to_single("Observation", data(idbzob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", data(idbzob,i), rdBZ, "-") if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupdw.f90 b/src/gsi/setupdw.f90 index 93749b2ad9..63c0df4b19 100644 --- a/src/gsi/setupdw.f90 +++ b/src/gsi/setupdw.f90 @@ -37,7 +37,7 @@ subroutine setupdw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa use obsmod, only: rmiss_single,lobsdiag_forenkf use obsmod, only: netcdf_diag, binary_diag, dirname, ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsdiagNode, only: obs_diag use m_obsdiagNode, only: obs_diags @@ -904,29 +904,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) call nc_diag_metadata("Station_Elevation", missing ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) + call nc_diag_metadata_to_single("Pressure", presw ) + call nc_diag_metadata_to_single("Height", data(ihgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,"-" ) call nc_diag_metadata("Prep_QC_Mark", missing ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",one ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",-one ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(data(ilob,i))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(ilob,i)-dwwind)) + call nc_diag_metadata_to_single("Observation",data(ilob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", data(ilob,i), dwwind, '-') !_RT_NC4_TODO !_RT rdiagbuf(20,ii) = factw ! 10m wind reduction factor diff --git a/src/gsi/setupfed.f90 b/src/gsi/setupfed.f90 new file mode 100644 index 0000000000..cf6334e567 --- /dev/null +++ b/src/gsi/setupfed.f90 @@ -0,0 +1,1100 @@ +module fed_setup + implicit none + private + public:: setup + interface setup; module procedure setupfed; end interface + +contains +subroutine setupfed(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,fed_diagsave,init_pass) +!$$$ subprogram documentation block +! . . . . +! subprogram: setupfed compute rhs of flash extent density +! orig. prgmmr: +! Rong Kong CAPS/OU 2018-01-21 (modified based on setupdbz.f90) +! modified: +! Yaping Wang CIMMS/OU 2019-11-11 +! David Dowell (DCD) NOAA GSL 2021-07-01 +! - added a second option (tanh) for observation operator, based on the +! work of Sebok and Back (2021, unpublished) +! - capped maximum model FED +! +! + use mpeu_util, only: die,perr + use kinds, only: r_kind,r_single,r_double,i_kind + use m_obsdiagNode, only: obs_diag + use m_obsdiagNode, only: obs_diags + use m_obsdiagNode, only: obsdiagLList_nextNode + use m_obsdiagNode, only: obsdiagNode_set + use m_obsdiagNode, only: obsdiagNode_get + use m_obsdiagNode, only: obsdiagNode_assert + use obsmod, only: rmiss_single,& + lobsdiagsave,nobskeep,lobsdiag_allocated,time_offset + use obsmod, only: oberror_tune + use m_obsNode, only: obsNode + use m_fedNode, only: fedNode + use m_fedNode, only: fedNode_appendto + use obsmod, only: luse_obsdiag, netcdf_diag, binary_diag, dirname, ianldate + use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & + nc_diag_write, nc_diag_data2d + use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim,nc_diag_read_close + use m_obsLList, only: obsLList + use gsi_4dvar, only: nobs_bins,hr_obsbin + use oneobmod, only: oneobtest,maginnov,magoberr + use guess_grids, only: hrdifsig,nfldsig,ges_prsi + use guess_grids, only: ges_lnprsl, geop_hgtl + use gridmod, only: lat2, lon2 + use gridmod, only: nsig, get_ij,get_ijk,tll2xy + use constants, only: flattening,semi_major_axis,grav_ratio,zero,grav,wgtlim + use constants, only: half,one,two,grav_equator,eccentricity,somigliana + use constants, only: deg2rad,r60,tiny_r_kind,cg_term,huge_single + use constants, only: r10,r100,r1000 + use constants, only: grav,tpwcon + use qcmod, only: npres_print,ptopq,pbotq + use jfunc, only: jiter,last,miter + use convinfo, only: nconvtype,cermin,cermax,cgross,cvar_b,cvar_pg,ictype + use convinfo, only: icsubtype + use converr, only: ptabl + use m_dtime, only: dtime_setup, dtime_check, dtime_show + use state_vectors, only: nsdim + + use gsi_bundlemod, only: GSI_BundleGetPointer + use gsi_metguess_mod, only: gsi_metguess_get, GSI_MetGuess_Bundle + + use netcdf + + + implicit none +! Declare passed variables + type(obsLList ),target,dimension(:),intent(in):: obsLL + type(obs_diags),target,dimension(:),intent(in):: odiagLL + + logical ,intent(in ) :: fed_diagsave + integer(i_kind) ,intent(in ) :: lunin,mype,nele,nobs + real(r_kind),dimension(100+7*nsig) ,intent(inout) :: awork + real(r_kind),dimension(npres_print,nconvtype,5,3),intent(inout) :: bwork + integer(i_kind) ,intent(in ) :: is ! ndat index + logical ,intent(in ) :: init_pass ! state of "setup" parameters + + +! Declare local parameters + integer(i_kind),parameter:: fed_obs_ob_shape = 2 ! 1 = linear (Allen et al.) + ! 2 = tanh (Sebok and Back) +! coefficients for tanh operator, from Sebok and Back (2021) +! real(r_kind),parameter:: a_coeff = 8.4_r_kind ! a (flashes/min) in tanh operator +! real(r_kind),parameter:: b_coeff = 12.248_r_kind ! b (flashes/min) in tanh operator +! real(r_kind),parameter:: c_coeff = 5.0e-10_r_kind ! c (radians/kg) in tanh operator +! real(r_kind),parameter:: d_coeff = 1.68e9_r_kind ! d (kg) in tanh operator +! real(r_kind),parameter:: fed_highbnd = 18.0_r_kind ! DCD: Sebok and Back (2021, unpublished) + +! coefficients for tanh operator, from work by A. Back with regional FV3 (2023) + real(r_kind),parameter:: a_coeff = -3.645_r_kind ! a (flashes/min) in tanh operator + real(r_kind),parameter:: b_coeff = 15.75_r_kind ! b (flashes/min) in tanh operator + real(r_kind),parameter:: c_coeff = 1.939e-10_r_kind ! c (radians/kg) in tanh operator + real(r_kind),parameter:: d_coeff = -1.215e9_r_kind ! d (kg) in tanh operator + real(r_kind),parameter:: fed_highbnd = 8.0_r_kind ! DCD: Back (2023, unpublished) for FV3 + + real(r_kind),parameter:: fed_height = 6500.0_r_kind ! assumed height (m) of FED observations + real(r_kind),parameter:: r0_001 = 0.001_r_kind + real(r_kind),parameter:: r8 = 8.0_r_kind + real(r_kind),parameter:: ten = 10.0_r_kind + real(r_kind),parameter:: D608=0.608_r_kind + character(len=*),parameter:: myname='setupfed' + +! Declare external calls for code analysis + external:: tintrp2a1 + external:: tintrp2a11 + external:: tintrp2a1116 + external:: tintrp31 + external:: grdcrd1 + external:: stop2 + +! Declare local variables + real(r_kind) rlow,rhgh,rsig + real(r_kind) dz + real(r_kind) jqg_num,jqg + real(r_kind) dlnp,pobl,zob + real(r_kind) sin2,termg,termr,termrg + real(r_kind) psges,zsges + real(r_kind),dimension(nsig):: zges,hges + real(r_kind) prsltmp(nsig) + real(r_kind) sfcchk + real(r_kind) residual,obserrlm,obserror,ratio,scale,val2 + real(r_kind) ress,ressw + real(r_kind) val,valqc,rwgt + real(r_kind) cg_w,wgross,wnotgross,wgt,arg,exp_arg,term,rat_err2 + real(r_double) rstation_id + real(r_kind) dlat,dlon,dtime,dpres,ddiff,error,slat,dlat8km,dlon8km + real(r_kind) ratio_errors + real(r_kind) presw + real(r_kind) errinv_input,errinv_adjst,errinv_final + real(r_kind) err_input,err_adjst,err_final + real(r_kind),dimension(nele,nobs):: data + real(r_kind),dimension(lat2,lon2,nfldsig)::rp + real(r_single),allocatable,dimension(:,:)::rdiagbuf + real(r_kind),allocatable,dimension(:,:,: ) :: ges_z + real(r_kind),allocatable,dimension(:,:,: ) :: ges_ps + real(r_kind),allocatable,dimension(:,:,:,:) :: ges_q + real(r_kind),allocatable,dimension(:,:,:,:) :: ges_qg,ges_qg_mask + + real(r_kind) :: presq + real(r_kind) :: T1D,RHO + real(r_kind) :: glmcoeff = 2.088_r_kind*10.0**(-8.0) ! Allen et al. (2016,MWR) + real(r_kind) :: CM = 0.5_r_kind ! tuning factor in eq. 14 of Kong et al. 2020 + + integer(i_kind) i,nchar,nreal,k,j,k1,ii,jj + integer(i_kind) mm1,k2 + integer(i_kind) jsig,ikxx,nn,ibin,ioff,ioff0 + integer(i_kind) ier,ilat,ilon,ifedob,ikx,itime,iuse + integer(i_kind) id,ilone,ilate + integer(i_kind) ier2 + + integer(i_kind) nlat_ll,nlon_ll,nsig_ll,nfld_ll + + integer(i_kind) ipres,iqmax,iqc,icat,itemp + integer(i_kind) istnelv,iobshgt,izz,iprvd,isprvd,iptrb + integer(i_kind) idomsfc,iskint,isfcr,iff10 + + character(8) station_id + character(8),allocatable,dimension(:):: cdiagbuf + character(80):: string + character(128):: diag_file + logical :: diagexist + logical,dimension(nobs):: luse,muse + integer(i_kind),dimension(nobs):: ioid ! initial (pre-distribution) obs ID + logical proceed + + equivalence(rstation_id,station_id) + integer(i_kind) numequal,numnotequal + + type(fedNode),pointer:: my_head + type(obs_diag),pointer:: my_diag + type(obs_diags),pointer:: my_diagLL + + real(r_kind),dimension(nsig+1):: prsitmp + + +!------------------------------------------------! + + integer(i_kind) :: itmp,jtmp + + integer(i_kind), parameter :: ntimesfed=1 + integer(i_kind),parameter :: nxfed=99, nyfed=99, nzfed=1, nfldfed=3 + real(r_kind),dimension(nobs) :: FEDMdiag,FEDMdiagTL + integer(i_kind) :: npt + real(r_kind) :: dlat_earth,dlon_earth + +! YPW added the next lines + logical :: l_set_oerr_ratio_fed=.False. + logical :: l_gpht2gmht = .True. + real(r_kind),dimension(nobs) :: dlatobs,dlonobs + integer(i_kind):: ngx,ngy,igx,jgy + real(r_kind):: dx_m, dy_m + + type(obsLList),pointer,dimension(:):: fedhead + fedhead => obsLL(:) + +!============================================================================================ +! Read and reformat observations in work arrays. + read(lunin)data,luse,ioid + + write(6,*)myname,'(pe=',mype,') nele nobs =',nele,nobs, & + 'luse_obsdiag=',luse_obsdiag,'lat2,lon2=',lat2,lon2 + + ier=1 ! index of obs error + ilon=2 ! index of grid relative obs location (x) + ilat=3 ! index of grid relative obs location (y) + ipres=4 ! index of pressure + ifedob=5 ! index of fed observation + id=6 ! index of station id + itime=7 ! index of observation time in data array + ikxx=8 ! index of ob type + iqmax=9 ! index of max error + itemp=10 ! index of dry temperature + iqc=11 ! index of quality mark + ier2=12 ! index of original-original obs error ratio + iuse=13 ! index of use parameter + idomsfc=14 ! index of dominant surface type + iskint=15 ! index of surface skin temperature + iff10=16 ! index of 10 meter wind factor + isfcr=17 ! index of surface roughness + ilone=18 ! index of longitude (degrees) + ilate=19 ! index of latitude (degrees) + istnelv=20 ! index of station elevation (m) + iobshgt=21 ! index of observation height (m) + izz=22 ! index of surface height + iprvd=23 ! index of observation provider + isprvd=24 ! index of observation subprovider + icat =25 ! index of data level category + iptrb=26 ! index of fed perturbation + do i=1,nobs + muse(i)=nint(data(iuse,i)) <= jiter + end do + + numequal=0 + numnotequal=0 + +! +! If requested, save select data for output to diagnostic file + if(fed_diagsave)then + ii=0 + nchar=1_i_kind + ioff0=26_i_kind ! 21 + 5 (22->Zr; 23->Zs; 24->Zg; 25->tsenges;26->RHO;) + nreal=ioff0 + if (lobsdiagsave) nreal=nreal+4*miter+1 + allocate(cdiagbuf(nobs),rdiagbuf(nreal,nobs)) + rdiagbuf=zero + if(netcdf_diag) call init_netcdf_diag_ + end if + mm1=mype+1 + scale=one + rsig=nsig + + + + !============================================================================================ +! +! Check to see if required guess fields are available +! vars. list: ps, z, q +! vars. list: qr, qs, qg + !============================================================================================ + + call check_vars_(proceed) + if(.not.proceed) then + write(6,*) myname,': some or all necessary variables are not available for fed obs operator. Quit!' + return ! not all vars available, simply return + end if + +! If require guess vars available, extract from bundle ... + call init_vars_ +! qscalar=zero + + !============================================================================================ + ! 1) Calculate the graupel-mass and graupel-volume based flash extent density + ! (FED) on model space, added by R. Kong, 07/05/2018 + !============================================================================================ + ges_qg_mask=ges_qg + where(ges_qg>0.0005) !Count the volume where qg > 0.5/kg + ges_qg_mask=1.0 + elsewhere + ges_qg_mask=0.0 + endwhere + + ! Operator start here + ! set ngx and ngy =2, so the integrated domain is 15kmx15km + ngx = 2 + ngy = 2 + dx_m = 3000. + dy_m = 3000. + print*,'FED Operator start here!,ngx=',ngx,'ngy=',ngy + rp=zero + + print*, 'mype = ', mype + print*, 'nfldsig = ', nfldsig + print*, 'nsig = ', nsig + print*, 'lon2 = ', lon2 + print*, 'lat2 = ', lat2 + +! compute graupel mass, in kg per 15 km x 15 km column + do jj=1,nfldsig + do k=1,nsig + do i=1,lon2 + do j=1,lat2 !How to handle MPI???? + do igx=1,2*ngx+1 !horizontal integration of qg around point to calculate FED + do jgy=1,2*ngy+1 + itmp = i-ngx+igx-1 + jtmp = j-ngy+jgy-1 + itmp = min(max(1,itmp),lon2) + jtmp = min(max(1,jtmp),lat2) + rp(j,i,jj)=rp(j,i,jj) + ges_qg(jtmp,itmp,k,jj)* & + dx_m*dy_m*(ges_prsi(jtmp,itmp,k,jj)-ges_prsi(jtmp,itmp,k+1,jj))*& + tpwcon * r10 + end do !igx + end do !jgy + end do !j + end do !i + end do !k + end do !jj + +! compute FED, in flashes/min + do jj=1,nfldsig + do i=1,lon2 + do j=1,lat2 + if (fed_obs_ob_shape .eq. 1) then + rp(j,i,jj) = CM * glmcoeff * rp(j,i,jj) + else if (fed_obs_ob_shape .eq. 2) then + rp(j,i,jj) = a_coeff + b_coeff & + * tanh(c_coeff * (rp(j,i,jj) - d_coeff)) + else + write(6,*) ' unknown fed_obs_ob_shape: ', fed_obs_ob_shape + write(6,*) ' aborting setupfed' + call stop2(999) + end if + if (rp(j,i,jj) .gt. fed_highbnd) rp(j,i,jj) = fed_highbnd + end do !j + end do !i + end do !jj + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(6,*) 'fed_obs_ob_shape=',fed_obs_ob_shape + if (fed_obs_ob_shape .eq. 2) then + write(6,*) 'a_coeff=',a_coeff + write(6,*) 'b_coeff=',b_coeff + write(6,*) 'c_coeff=',c_coeff + write(6,*) 'd_coeff=',d_coeff + end if + write(6,*) 'fed_highbnd=',fed_highbnd + write(6,*) 'maxval(ges_qg)=',maxval(ges_qg),'pe=',mype + + + !============================================================================================ + + nlat_ll=size(ges_qg,1) + nlon_ll=size(ges_qg,2) + nsig_ll=size(ges_qg,3) + nfld_ll=size(ges_qg,4) + + +! - Observation times are checked in read routine - comment out for now + +! call dtime_setup() + +!print*,"maxval(data(ifedob,:)),mmaxval(data(ilat,:))=",minval(data(ifedob,:)),maxval(data(ifedob,:)),maxval(data(ilat,:)) +!write(6,*) "OKOKOKOKOK, nobs=", nobs + do i=1,nobs + dtime=data(itime,i) + dlat=data(ilat,i) + dlon=data(ilon,i) + + dlon8km=data(iprvd,i) !iprvd=23 + dlat8km=data(isprvd,i) !isprvd=24 + + dpres=data(ipres,i) ! from rdararef_mosaic2: this height abv MSL + ikx = nint(data(ikxx,i)) + error=data(ier2,i) + slat=data(ilate,i)*deg2rad ! needed when converting geophgt to + dlon_earth = data(ilone,i) !the lontitude and latitude on the obs pts. + dlat_earth = data(ilate,i) + ! geometric hgh (hges --> zges below) + + if (nobs_bins>1) then + ibin = NINT( dtime/hr_obsbin ) + 1 + else + ibin = 1 + end if + + IF (ibin<1.OR.ibin>nobs_bins) write(6,*)mype,'Error nobs_bins,ibin= ',nobs_bins,ibin + + if (luse_obsdiag) my_diagLL => odiagLL(ibin) + +! Link obs to diagnostics structure + if(luse_obsdiag)then + my_diag => obsdiagLList_nextNode(my_diagLL ,& + create = .not.lobsdiag_allocated ,& + idv = is ,& + iob = ioid(i) ,& + ich = 1 ,& + elat = data(ilate,i) ,& + elon = data(ilone,i) ,& + luse = luse(i) ,& + miter = miter ) + if(.not.associated(my_diag)) call die(myname, & + 'obsdiagLList_nextNode(), create =',.not.lobsdiag_allocated) + end if + +! Interpolate terrain height(model elevation) to obs location. + call tintrp2a11(ges_z,zsges,dlat,dlon,dtime,hrdifsig,& + mype,nfldsig) +! print*,'i,after tintrp2all',i,mype,dlat,zsges +! 1. dpres (MRMS obs height is height above MSL) is adjusted by zsges, so it +! is changed to height relative to model elevation (terrain). +! because in GSI, geop_hgtl is the height relative to terrain (ges_z) +! (subroutine guess_grids) + dpres=dpres-zsges + if (dpres rsig)ratio_errors = zero + +!----------------------------------------------------------------------------! +! ! +! Implementation of forward operator for flash extend densit ----------------! +! ! +!----------------------------------------------------------------------------! + + !============================================================================================ + ! 3) H(x), interpolate the FED from model space on the local domain to obs space (FEDMdiag) + !============================================================================================ + + npt = 0 + FEDMdiag(i) = 0. + call tintrp2a11(rp,FEDMdiag(i),dlat,dlon,dtime,hrdifsig,mype,nfldsig) + dlonobs(i) = dlon_earth + dlatobs(i) = dlat_earth + + ! also Jacobian used for TLM and ADM + !FEDMdiagTL, used for gsi-3dvar,will be implemented in future...... + FEDMdiagTL(i) = 0. + jqg_num = FEDMdiagTL(i) !=dFED/Dqg + jqg = jqg_num + + + !end select + + if(FEDMdiag(i)==data(ifedob,i)) then + numequal=numequal+1 + else + numnotequal=numnotequal+1 + end if + +!!!!!!!!!!!!!!!!!END H(x)!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Compute innovations + !--------------Calculate departure from observation----------------! + + ddiff = data(ifedob,i) - FEDMdiag(i) + +! If requested, setup for single obs test. +! Note: do not use this way to run single obs test for fed in the current version. (g.zhao) + if (oneobtest) then + ddiff=maginnov +! if (trim(adjustl(oneob_type))=='fed') then +! data(ifedob,i) = maginnov +! ddiff = data(ifedob,i) - FEDMdiag(i) +! end if + error=one/(magoberr) + ratio_errors=one + end if + + +! Gross error checks + obserror = one/max(ratio_errors*error,tiny_r_kind) + obserrlm = max(cermin(ikx),min(cermax(ikx),obserror)) + + residual = abs(ddiff) != y-H(xb) + ratio = residual/obserrlm != y-H(xb)/sqrt(R) + + if (l_set_oerr_ratio_fed) then + if (ratio > cgross(ikx) .or. ratio_errors < tiny_r_kind) then + if (luse(i)) awork(4) = awork(4)+one + error = zero + ratio_errors = zero + end if + else + ratio_errors = one + end if + + if (ratio_errors*error <=tiny_r_kind) muse(i)=.false. +! if (nobskeep>0 .and. luse_obsdiag) muse(i)=obsdiags(i_fed_ob_type,ibin)%tail%muse(nobskeep) + if (nobskeep>0.and.luse_obsdiag) call obsdiagNode_get(my_diag, jiter=nobskeep, muse=muse(i)) + + val = error*ddiff !=y-H(xb)/sqrt(R) + +! Compute penalty terms (linear & nonlinear qc). + if(luse(i))then + exp_arg = -half*val**2 + rat_err2 = ratio_errors**2 + val2=val*val !(o-g)**2/R, would be saved in awork + if (cvar_pg(ikx) > tiny_r_kind .and. error > tiny_r_kind) then + arg = exp(exp_arg) + wnotgross= one-cvar_pg(ikx) + cg_w=cvar_b(ikx) + wgross = cg_term*cvar_pg(ikx)/(cg_w*wnotgross) + term = log((arg+wgross)/(one+wgross)) + wgt = one-wgross/(arg+wgross) + rwgt = wgt/wgtlim + else + term = exp_arg + wgt = wgtlim + rwgt = wgt/wgtlim + end if + valqc = -two*rat_err2*term + +! print*,'Compute penalty terms' +! Accumulate statistics for obs belonging to this task + if (muse(i)) then + if(rwgt < one) awork(21) = awork(21)+one + jsig = dpres + jsig=max(1,min(jsig,nsig)) + awork(6*nsig+jsig+100)=awork(6*nsig+jsig+100)+val2*rat_err2 + awork(5*nsig+jsig+100)=awork(5*nsig+jsig+100)+one + awork(3*nsig+jsig+100)=awork(3*nsig+jsig+100)+valqc + end if +! Loop over pressure level groupings and obs to accumulate +! statistics as a function of observation type. + ress = scale*ddiff + ressw = ress*ress + nn=1 + if (.not. muse(i)) then + nn=2 + if(ratio_errors*error >=tiny_r_kind)nn=3 + end if + do k = 1,npres_print +! if(presw >=ptop(k) .and. presw<=pbot(k))then + if(presq >=ptopq(k) .and. presq<=pbotq(k))then + bwork(k,ikx,1,nn) = bwork(k,ikx,1,nn)+one ! count + bwork(k,ikx,2,nn) = bwork(k,ikx,2,nn)+ddiff ! bias + bwork(k,ikx,3,nn) = bwork(k,ikx,3,nn)+ressw ! (o-g)**2 + bwork(k,ikx,4,nn) = bwork(k,ikx,4,nn)+val2*rat_err2 ! penalty + bwork(k,ikx,5,nn) = bwork(k,ikx,5,nn)+valqc ! nonlin qc penalty + + end if + end do + end if + + if(luse_obsdiag)then + call obsdiagNode_set(my_diag, luse=luse(i), wgtjo=(error*ratio_errors)**2, & + jiter=jiter, muse=muse(i), nldepart=ddiff) + end if + +! If obs is "acceptable", load array with obs info for use +! in inner loop minimization (int* and stp* routines) + if ( .not. last .and. muse(i)) then + + allocate(my_head) ! YPW added + call fedNode_appendto(my_head,fedhead(ibin)) + + my_head%idv=is + my_head%iob=i + my_head%elat= data(ilate,i) + my_head%elon= data(ilone,i) + + my_head%dlev= dpres + call get_ijk(mm1,dlat,dlon,dpres,my_head%ij,my_head%wij) + my_head%res = ddiff ! Observation - ges + my_head%err2 = error**2 + my_head%raterr2 = ratio_errors**2 + my_head%time = dtime + my_head%b = cvar_b(ikx) + my_head%pg = cvar_pg(ikx) + my_head%luse = luse(i) + + if(oberror_tune) then + ! my_head%fedpertb=data(iptrb,i)/error/ratio_errors + my_head%kx=ikx + if(presq > ptabl(2))then + my_head%k1=1 + else if( presq <= ptabl(33)) then + my_head%k1=33 + else + k_loop: do k=2,32 + if(presq > ptabl(k+1) .and. presq <= ptabl(k)) then + my_head%k1=k + exit k_loop + end if + end do k_loop + end if + end if +!------------------------------------------------- + + if(luse_obsdiag)then + call obsdiagNode_assert(my_diag,my_head%idv,my_head%iob,1,myname,'my_diag:my_head') + my_head%diags => my_diag + end if + + my_head => null() + end if + +! Save select output for diagnostic file + if(.not.luse(i))write(6,*)' luse, mype',luse(i),mype + if(fed_diagsave .and. luse(i))then + ii=ii+1 + rstation_id = data(id,i) + err_input = data(ier2,i) + err_adjst = data(ier,i) + if (ratio_errors*error>tiny_r_kind) then + err_final = one/(ratio_errors*error) + else + err_final = huge_single + end if + errinv_input = huge_single + errinv_adjst = huge_single + errinv_final = huge_single + if (err_input>tiny_r_kind) errinv_input = one/err_input + if (err_adjst>tiny_r_kind) errinv_adjst = one/err_adjst + if (err_final>tiny_r_kind) errinv_final = one/err_final + + if(binary_diag) call contents_binary_diag_(my_diag) + if(netcdf_diag) call contents_netcdf_diag_(my_diag) + + end if + end do + +! Release memory of local guess arrays + call final_vars_ + +! Write information to diagnostic file + if(fed_diagsave .and. netcdf_diag) call nc_diag_write + if(fed_diagsave .and. binary_diag .and. ii>0)then + + write(string,600) jiter +600 format('fed_',i2.2) + diag_file=trim(dirname) // trim(string) + if(init_pass) then + open(66,file=trim(diag_file),form='unformatted',status='unknown',position='rewind') + else + inquire(file=trim(diag_file),exist=diagexist) + if (diagexist) then + open(66,file=trim(diag_file),form='unformatted',status='old',position='append') + else + open(66,file=trim(diag_file),form='unformatted',status='unknown',position='rewind') + end if + end if + if(init_pass .and. mype == 0) then + write(66) ianldate + write(6,*)'SETUPFED: write time record to file ',& + trim(diag_file), ' ',ianldate + end if + +! call dtime_show(myname,'diagsave:fed',i_fed_ob_type) + write(66)'fed',nchar,nreal,ii,mype,ioff0 + write(66)cdiagbuf(1:ii),rdiagbuf(:,1:ii) + ! write(6,*)'fed,nchar,nreal,ii,mype',nchar,nreal,ii,mype + deallocate(cdiagbuf,rdiagbuf) + close(66) + end if + +! End of routine + + +! return + + contains + + subroutine check_vars_ (proceed) + + + logical,intent(inout) :: proceed + integer(i_kind) ivar, istatus +! Check to see if required guess fields are available + call gsi_metguess_get ('var::ps', ivar, istatus ) + proceed=ivar>0 + call gsi_metguess_get ('var::z' , ivar, istatus ) + proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::q' , ivar, istatus ) + proceed=proceed.and.ivar>0 +! call gsi_metguess_get ('var::tv' , ivar, istatus ) +! proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::qs', ivar, istatus ) + proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::qg', ivar, istatus ) + proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::qr', ivar, istatus ) + proceed=proceed.and.ivar>0 + end subroutine check_vars_ + + + subroutine init_vars_ + +! use radaremul_cst, only: mphyopt + + real(r_kind),dimension(:,: ),pointer:: rank2=>NULL() + real(r_kind),dimension(:,:,:),pointer:: rank3=>NULL() + character(len=5) :: varname + integer(i_kind) ifld, istatus + +! If require guess vars available, extract from bundle ... + if(size(gsi_metguess_bundle)==nfldsig) then +! get ps ... + varname='ps' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank2,istatus) + if (istatus==0) then + if(allocated(ges_ps))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_ps(size(rank2,1),size(rank2,2),nfldsig)) + ges_ps(:,:,1)=rank2 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank2,istatus) + ges_ps(:,:,ifld)=rank2 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if +! get z ... + varname='z' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank2,istatus) + if (istatus==0) then + if(allocated(ges_z))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_z(size(rank2,1),size(rank2,2),nfldsig)) + ges_z(:,:,1)=rank2 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank2,istatus) + ges_z(:,:,ifld)=rank2 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if +! get q ... + varname='q' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus) + if (istatus==0) then + if(allocated(ges_q))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_q(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) + ges_q(:,:,:,1)=rank3 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus) + ges_q(:,:,:,ifld)=rank3 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if +! get tv ... +! varname='tv' +! call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus) +! if (istatus==0) then +! if(allocated(ges_tv))then +! write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' +! call stop2(999) +! end if +! allocate(ges_tv(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) +! ges_tv(:,:,:,1)=rank3 +! do ifld=2,nfldsig +! call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus) +! ges_tv(:,:,:,ifld)=rank3 +! ges_tv(:,:,:,ifld)=rank3 +! end do +! else +! write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus +! call stop2(999) +! end if +! get qr ... +! get qg ... + varname='qg' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus) + if (istatus==0) then + if(allocated(ges_qg))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_qg(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) + if(.not. allocated(ges_qg_mask))then + allocate(ges_qg_mask(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) + end if + + ges_qg(:,:,:,1)=rank3 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus) + ges_qg(:,:,:,ifld)=rank3 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if + else + write(6,*) trim(myname), ': inconsistent vector sizes (nfldsig,size(metguess_bundle) ',& + nfldsig,size(gsi_metguess_bundle) + call stop2(999) + end if + end subroutine init_vars_ + + subroutine init_netcdf_diag_ + character(len=80) string + character(len=128) diag_conv_file + integer(i_kind) ncd_fileid,ncd_nobs + logical append_diag + logical,parameter::verbose=.false. + write(string,900) jiter +900 format('conv_fed_',i2.2,'.nc4') + diag_conv_file=trim(dirname) // trim(string) + + inquire(file=diag_conv_file, exist=append_diag) + + if (append_diag) then + call nc_diag_read_init(diag_conv_file,ncd_fileid) + ncd_nobs = nc_diag_read_get_dim(ncd_fileid,'nobs') + call nc_diag_read_close(diag_conv_file) + + if (ncd_nobs > 0) then + if(verbose) print *,'file ' // trim(diag_conv_file) // ' exists. Appending. nobs,mype=',ncd_nobs,mype + else + if(verbose) print *,'file ' // trim(diag_conv_file) // ' exists but contains no obs. Not appending. nobs,mype=',ncd_nobs,mype + append_diag = .false. ! if there are no obs in existing file, then do not try to append + end if + end if + + call nc_diag_init(diag_conv_file, append=append_diag) + + if (.not. append_diag) then ! don't write headers on append - the module will break? + call nc_diag_header("date_time",ianldate ) + call nc_diag_header("Number_of_state_vars", nsdim ) + end if + end subroutine init_netcdf_diag_ + subroutine contents_binary_diag_(odiag) + type(obs_diag),pointer,intent(in):: odiag + + cdiagbuf(ii) = station_id ! station id + + rdiagbuf(1,ii) = ictype(ikx) ! observation type + rdiagbuf(2,ii) = icsubtype(ikx) ! observation subtype + + rdiagbuf(3,ii) = data(ilate,i) ! observation latitude (degrees) + rdiagbuf(4,ii) = data(ilone,i) ! observation longitude (degrees) + + rdiagbuf(5,ii) = data(istnelv,i) ! station elevation (meters) + rdiagbuf(6,ii) = presq ! observation pressure (hPa) + rdiagbuf(7,ii) = fed_height ! observation height (meters) + rdiagbuf(8,ii) = (dtime*r60)-time_offset ! obs time (sec relative to analysis time) + rdiagbuf(9,ii) = data(iqc,i) ! input prepbufr qc or event mark + rdiagbuf(10,ii) = rmiss_single ! setup qc or event mark + rdiagbuf(11,ii) = data(iuse,i) ! read_prepbufr data usage flag + if(muse(i)) then + rdiagbuf(12,ii) = one ! analysis usage flag (1=use, -1=not used) + else + rdiagbuf(12,ii) = -one + end if + + rdiagbuf(13,ii) = rwgt ! nonlinear qc relative weight + rdiagbuf(14,ii) = errinv_input ! prepbufr inverse obs error (dBZ)**-1 + rdiagbuf(15,ii) = errinv_adjst ! read_prepbufr inverse obs error (dBZ)**-1 + rdiagbuf(16,ii) = errinv_final ! final inverse observation error (dBZ)**-1 + rdiagbuf(17,ii) = data(ifedob,i) ! radar reflectivity observation (dBZ) + rdiagbuf(18,ii) = ddiff ! obs-ges (dBZ) + rdiagbuf(19,ii) = data(ifedob,i)-FEDMdiag(i) ! obs-ges w/o bias correction (dBZ) (future slot) + rdiagbuf(20,ii) = dlat8km ! j-index on 8km bufr obs grid + rdiagbuf(21,ii) = dlon8km ! i-index on 8km bufr obs grid + +! print*,'data(ilat,i)=',data(ilat,i),'data(ilon,i)=',data(ilon,i) + + rdiagbuf(22,ii) = FEDMdiag(i) ! dBZ from rain water + + rdiagbuf(23,ii) = T1D ! temperature (sensible, K) + rdiagbuf(24,ii) = RHO ! air density (kg/m**3) + + if (lobsdiagsave) then + write(6,*)'wrong here, stop in setupfed.f90 ' + stop + ioff=nreal + do jj=1,miter + ioff=ioff+1 + if (odiag%muse(jj)) then + rdiagbuf(ioff,ii) = one + else + rdiagbuf(ioff,ii) = -one + end if + end do + do jj=1,miter+1 + ioff=ioff+1 + rdiagbuf(ioff,ii) = odiag%nldepart(jj) + end do + do jj=1,miter + ioff=ioff+1 + rdiagbuf(ioff,ii) = odiag%tldepart(jj) + end do + do jj=1,miter + ioff=ioff+1 + rdiagbuf(ioff,ii) = odiag%obssen(jj) + end do + end if + + end subroutine contents_binary_diag_ + subroutine contents_netcdf_diag_(odiag) + type(obs_diag),pointer,intent(in):: odiag +! Observation class + character(7),parameter :: obsclass = ' fed' + real(r_kind),dimension(miter) :: obsdiag_iuse + call nc_diag_metadata("Station_ID", station_id ) + call nc_diag_metadata("Observation_Class", obsclass ) + call nc_diag_metadata("Observation_Type", ictype(ikx) ) + call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) + call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) + call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) + call nc_diag_metadata("Pressure", sngl(presq) ) + call nc_diag_metadata("Height", sngl(fed_height) ) + call nc_diag_metadata("Time", sngl(dtime*r60-time_offset)) + call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) + call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) +! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ! ) + call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + if(muse(i)) then + call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + else + call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + end if + + call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) + call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) + call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + + call nc_diag_metadata("Observation", sngl(data(ifedob,i)) ) + call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) + call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(ifedob,i)-FEDMdiag(i)) ) + if (lobsdiagsave) then + do jj=1,miter + if (odiag%muse(jj)) then + obsdiag_iuse(jj) = one + else + obsdiag_iuse(jj) = -one + end if + end do + + call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) + call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) + call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) + call nc_diag_data2d("ObsDiagSave_obssen" , odiag%obssen ) + end if + + end subroutine contents_netcdf_diag_ + + subroutine final_vars_ + if(allocated(ges_z )) deallocate(ges_z ) + if(allocated(ges_q )) deallocate(ges_q ) +! if(allocated(ges_tv)) deallocate(ges_tv) + if(allocated(ges_ps)) deallocate(ges_ps) + if(allocated(ges_qg)) deallocate(ges_qg) + end subroutine final_vars_ + + subroutine init_qcld(t_cld, qxmin_cld, icat_cld, t_dpnd) + use kinds, only: r_kind,r_single,r_double,i_kind + implicit none + real(r_kind), intent(in ) :: t_cld + real(r_kind), intent(inout) :: qxmin_cld + integer, intent(in ) :: icat_cld + logical, intent(in ) :: t_dpnd +! +! local variables + real :: tr_ll, qrmin_ll, tr_hl, qrmin_hl + real :: ts_ll, qsmin_ll, ts_hl, qsmin_hl + real :: tg_ll, qgmin_ll, tg_hl, qgmin_hl + real :: qr_min, qs_min, qg_min +!------------------------------------------------------ + + qr_min = 5.0E-6_r_kind + qs_min = 5.0E-6_r_kind + qg_min = 5.0E-6_r_kind + tr_ll = 275.65; qrmin_ll = 5.0E-6_r_kind; + tr_hl = 270.65; qrmin_hl = 1.0E-8_r_kind; + ts_ll = 275.65; qsmin_ll = 1.0E-8_r_kind; + ts_hl = 270.65; qsmin_hl = 5.0E-6_r_kind; + tg_ll = 275.65; qgmin_ll = 1.0E-6_r_kind; + tg_hl = 270.65; qgmin_hl = 5.0E-6_r_kind; + + select case (icat_cld) + case (1) + if ( t_dpnd ) then + if (t_cld <= tr_hl) then + qxmin_cld = qrmin_hl + else if (t_cld >= tr_ll) then + qxmin_cld = qrmin_ll + else + qxmin_cld = (qrmin_hl + qrmin_ll) * 0.5 + end if + else + qxmin_cld = qr_min + end if + case default + write(6,*) 'wrong cloud hydrometer category ID',icat_cld + end select + + return + + end subroutine init_qcld + +end subroutine setupfed +end module fed_setup diff --git a/src/gsi/setuplight.f90 b/src/gsi/setuplight.f90 index e9ed19d3c3..040ef19bc6 100644 --- a/src/gsi/setuplight.f90 +++ b/src/gsi/setuplight.f90 @@ -90,7 +90,7 @@ subroutine setuplight(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,light_di nobskeep,lobsdiag_allocated use obsmod, only: netcdf_diag, binary_diag, dirname, ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use obsmod, only: luse_obsdiag use m_obsNode, only: obsNode @@ -1619,25 +1619,25 @@ subroutine contents_netcdf_diag_(odiag) real(r_single),parameter:: missing = -9.99e9_r_single real(r_kind),dimension(miter) :: obsdiag_iuse - call nc_diag_metadata("GLM_Detect_Err", sngl(data(ier,i)) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Lightning_FR_Obs", sngl(dlight ) ) - call nc_diag_metadata("Time", sngl(dtime) ) - call nc_diag_metadata("GLM_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("GLM_Orig_Detect_Err", sngl(data(ier2,i)) ) - call nc_diag_metadata("GLM_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("GLM_Detect_Err", data(ier,i) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Lightning_FR_Obs", dlight ) + call nc_diag_metadata_to_single("Time", dtime ) + call nc_diag_metadata_to_single("GLM_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("GLM_Orig_Detect_Err", data(ier2,i) ) + call nc_diag_metadata_to_single("GLM_Use_Flag", data(iuse,i) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", 1._r_single ) else call nc_diag_metadata("Analysis_Use_Flag", -1._r_single ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Obs_Minus_Forecast_VarBC", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_NoVarBC", sngl(dlight-lightges0) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_VarBC",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_NoVarBC",dlight,lightges0,'-') if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then @@ -1650,7 +1650,7 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif end subroutine contents_netcdf_diag_ diff --git a/src/gsi/setuplwcp.f90 b/src/gsi/setuplwcp.f90 index 7e06144f68..7b1549aab4 100644 --- a/src/gsi/setuplwcp.f90 +++ b/src/gsi/setuplwcp.f90 @@ -68,7 +68,7 @@ subroutine setuplwcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header,nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim,nc_diag_read_close use state_vectors, only: svars3d, levels @@ -848,28 +848,28 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(data(iobsprs,i)) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(rmiss_single) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", data(iobsprs,i) ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata("Setup_QC_Mark", rmiss_single ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(dlwcp) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(dlwcp-lwcpges)) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + call nc_diag_metadata_to_single("Observation", dlwcp ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",dlwcp,lwcpges,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupoz.f90 b/src/gsi/setupoz.f90 index 2008f37559..d7a85de0b2 100644 --- a/src/gsi/setupoz.f90 +++ b/src/gsi/setupoz.f90 @@ -115,7 +115,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use state_vectors, only: svars3d, levels, nsdim - use constants, only : zero,half,one,two,tiny_r_kind + use constants, only : zero,half,one,two,tiny_r_kind,r_missing use constants, only : constoz,rozcon,cg_term,wgtlim,h300,r10,r100,r1000 use m_obsdiagNode, only : obs_diag @@ -138,7 +138,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin @@ -609,35 +609,40 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& sngl(prsitmp(1)*r1000) ) endif call nc_diag_metadata("MPI_Task_Number", mype ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Time", sngl(data(itime,i)-time_offset) ) - call nc_diag_metadata("Reference_Pressure",sngl(pobs(k)*r100) ) + call nc_diag_metadata_to_single("Latitude",(data(ilate,i)) ) + call nc_diag_metadata_to_single("Longitude",(data(ilone,i)) ) + if(isnan(dtime) .or. isnan(time_offset)) then + call nc_diag_metadata("Time",sngl(real(r_missing))) + else + call nc_diag_metadata("Time",sngl(dtime-time_offset)) + endif + call nc_diag_metadata_to_single("Reference_Pressure",(pobs(k)*r100)) call nc_diag_metadata("Analysis_Use_Flag", iouse(k) ) - call nc_diag_metadata("Observation", sngl(ozobs(k))) - call nc_diag_metadata("Inverse_Observation_Error", sngl(errorinv)) - call nc_diag_metadata("Input_Observation_Error", sngl(error(k))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ozone_inv(k))) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(ozone_inv(k))) - call nc_diag_metadata("Forecast_unadjusted", sngl(ozges(k))) - call nc_diag_metadata("Forecast_adjusted",sngl(ozges(k))) + call nc_diag_metadata_to_single("Observation",(ozobs(k))) + call nc_diag_metadata_to_single("Inverse_Observation_Error",(errorinv)) + call nc_diag_metadata_to_single("Input_Observation_Error", (error(k))) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",(ozone_inv(k))) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",(ozone_inv(k))) + call nc_diag_metadata_to_single("Forecast_unadjusted", (ozges(k))) + call nc_diag_metadata_to_single("Forecast_adjusted", (ozges(k))) if (obstype == 'gome' .or. obstype == 'omieff' .or. & obstype == 'omi' .or. obstype == 'tomseff' .or. & obstype == 'ompsnmeff' .or. obstype == 'ompsnm') then - call nc_diag_metadata("Solar_Zenith_Angle", sngl(data(isolz,i)) ) - call nc_diag_metadata("Scan_Position", sngl(data(ifovn,i)) ) + call nc_diag_metadata_to_single("Solar_Zenith_Angle",(data(isolz,i)) ) + call nc_diag_metadata_to_single("Scan_Position",(data(ifovn,i)) ) else - call nc_diag_metadata("Solar_Zenith_Angle", sngl(rmiss) ) - call nc_diag_metadata("Scan_Position", sngl(rmiss) ) + call nc_diag_metadata_to_single("Solar_Zenith_Angle",(rmiss) ) + call nc_diag_metadata_to_single("Scan_Position",(rmiss) ) endif if (obstype == 'omieff' .or. obstype == 'omi' ) then - call nc_diag_metadata("Row_Anomaly_Index", sngl(data(itoqf,i)) ) + call nc_diag_metadata_to_single("Row_Anomaly_Index",(data(itoqf,i)) ) else - call nc_diag_metadata("Row_Anomaly_Index", sngl(rmiss) ) + call nc_diag_metadata_to_single("Row_Anomaly_Index",(rmiss) ) endif if (save_jacobian) then - call fullarray(dhx_dx, dhx_dx_array) - call nc_diag_data2d("Observation_Operator_Jacobian", dhx_dx_array) + call nc_diag_data2d("Observation_Operator_Jacobian_stind", dhx_dx%st_ind) + call nc_diag_data2d("Observation_Operator_Jacobian_endind", dhx_dx%end_ind) + call nc_diag_data2d("Observation_Operator_Jacobian_val", real(dhx_dx%val,r_single)) endif !if (wrtgeovals) then ! call nc_diag_data2d("mole_fraction_of_ozone_in_air", sngl(constoz*ozgestmp)) @@ -1084,7 +1089,7 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use obsmod, only: netcdf_diag, binary_diag, dirname ! use obsmod, only: wrtgeovals use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_o3lNode, only : o3lNode @@ -1716,25 +1721,26 @@ subroutine contents_netcdf_diag_(odiag) ! Observation class character(7),parameter :: obsclass = ' ozlev' real(r_kind),dimension(miter) :: obsdiag_iuse - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) call nc_diag_metadata("MPI_Task_Number", mype ) - call nc_diag_metadata("Time", sngl(data(itime,i)-time_offset)) - call nc_diag_metadata("Inverse_Observation_Error", sngl(errorinv) ) - call nc_diag_metadata("Observation", sngl(ozlv) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ozone_inv) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(ozone_inv) ) - call nc_diag_metadata("Reference_Pressure", sngl(preso3l*r100) ) ! Pa + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Inverse_Observation_Error",errorinv ) + call nc_diag_metadata_to_single("Observation", ozlv ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ozone_inv ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",ozone_inv ) + call nc_diag_metadata_to_single("Reference_Pressure", preso3l*r100 ) ! Pa if(luse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", one ) + call nc_diag_metadata_to_single("Analysis_Use_Flag", one ) else - call nc_diag_metadata("Analysis_Use_Flag", -one ) + call nc_diag_metadata_to_single("Analysis_Use_Flag", -one ) endif - call nc_diag_metadata("Input_Observation_Error", sngl(obserror) ) + + call nc_diag_metadata_to_single("Input_Observation_Error",obserror ) if(obstype =="ompslp")then - call nc_diag_metadata("Log10 Air Number Density", sngl(airnd)) - call nc_diag_metadata("Log10 Ozone Number Density UV", sngl(uvnd)) - call nc_diag_metadata("Log10 Ozone Number Density VIS",sngl(visnd)) + call nc_diag_metadata_to_single("Log10 Air Number Density",airnd ) + call nc_diag_metadata_to_single("Log10 Ozone Number Density UV",uvnd ) + call nc_diag_metadata_to_single("Log10 Ozone Number Density VIS",visnd ) endif call nc_diag_metadata("Forecast_adjusted", sngl(o3ppmv)) call nc_diag_metadata("Forecast_unadjusted", sngl(o3ppmv)) diff --git a/src/gsi/setupps.f90 b/src/gsi/setupps.f90 index 6a0fdd4fb2..118ccb45d2 100644 --- a/src/gsi/setupps.f90 +++ b/src/gsi/setupps.f90 @@ -125,7 +125,7 @@ subroutine setupps(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa use obsmod, only: netcdf_diag, binary_diag, dirname use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gridmod, only: nsig,get_ij,twodvar_regional use constants, only: zero,one_tenth,one,half,pi,g_over_rd, & @@ -890,30 +890,31 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(data(ipres,i)*r10)) - call nc_diag_metadata("Height", sngl(dhgt) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + !Replace direct calls to nc_diag_metadata with the screening subroutine + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", data(ipres,i),r10,'*' ) + call nc_diag_metadata_to_single("Height", dhgt ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + + call nc_diag_metadata_to_single("Observation", pob ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",pob,pges,'-') + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",pob,pgesorig,'-') - call nc_diag_metadata("Observation", sngl(pob) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(pob-pges) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(pob-pgesorig)) - if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setuppw.f90 b/src/gsi/setuppw.f90 index b22d4eb661..08872c0a51 100644 --- a/src/gsi/setuppw.f90 +++ b/src/gsi/setuppw.f90 @@ -96,7 +96,7 @@ subroutine setuppw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa lobsdiagsave,nobskeep,lobsdiag_allocated,time_offset use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_pwNode, only: pwNode @@ -721,27 +721,27 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(prest) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset) ) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation", data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", prest ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) call nc_diag_metadata("Setup_QC_Mark", missing ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", 1._r_single ) else call nc_diag_metadata("Analysis_Use_Flag", -1._r_single ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(dpw) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(dpw-pwges) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + call nc_diag_metadata_to_single("Observation", dpw ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", dpw,pwges,'-' ) if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then diff --git a/src/gsi/setupq.f90 b/src/gsi/setupq.f90 index 554fe3e3dd..aa557b72c2 100644 --- a/src/gsi/setupq.f90 +++ b/src/gsi/setupq.f90 @@ -152,7 +152,7 @@ subroutine setupq(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav use obsmod, only: netcdf_diag, binary_diag, dirname use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin,min_offset use oneobmod, only: oneobtest,maginnov,magoberr @@ -1362,31 +1362,31 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) ! this is the obs height after being interpolated to the model (=model height) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(presq) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", presq ) ! this is the original obs height (= stn elevation, before being interpolated) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - - call nc_diag_metadata("Observation", sngl(data(iqob,i))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(qob-qges) ) - call nc_diag_metadata("Forecast_Saturation_Spec_Hum", sngl(qsges) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + + call nc_diag_metadata_to_single("Observation", data(iqob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",qob,qges,'-') + call nc_diag_metadata_to_single("Forecast_Saturation_Spec_Hum",qsges ) if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then @@ -1399,14 +1399,14 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif if (twodvar_regional .or. l_obsprvdiag) then call nc_diag_metadata("Dominant_Sfc_Type", data(idomsfc,i) ) call nc_diag_metadata("Model_Terrain", data(izz,i) ) r_prvstg = data(iprvd,i) - call nc_diag_metadata("Provider_Name", c_prvstg ) + call nc_diag_metadata("Provider_Name", c_prvstg ) r_sprvstg = data(isprvd,i) call nc_diag_metadata("Subprovider_Name", c_sprvstg ) endif @@ -1428,29 +1428,29 @@ subroutine contents_netcdf_diagp_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", -1 ) ! (-1 for pseudo obs sub-type) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(presq) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", presq ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - - call nc_diag_metadata("Observation", sngl(data(iqob,i))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(ddiff) ) - call nc_diag_metadata("Forecast_Saturation_Spec_Hum", sngl(qsges) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + + call nc_diag_metadata_to_single("Observation", data(iqob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",ddiff ) + call nc_diag_metadata_to_single("Forecast_Saturation_Spec_Hum",qsges ) !---- if (lobsdiagsave) then do jj=1,miter @@ -1464,14 +1464,14 @@ subroutine contents_netcdf_diagp_(odiag) call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif if (twodvar_regional .or. l_obsprvdiag) then call nc_diag_metadata("Dominant_Sfc_Type", data(idomsfc,i) ) call nc_diag_metadata("Model_Terrain", data(izz,i) ) r_prvstg = data(iprvd,i) - call nc_diag_metadata("Provider_Name", "88888888" ) + call nc_diag_metadata("Provider_Name", "88888888" ) r_sprvstg = data(isprvd,i) call nc_diag_metadata("Subprovider_Name", "88888888" ) endif diff --git a/src/gsi/setuprad.f90 b/src/gsi/setuprad.f90 index 822ec8ea22..ebdd8de52a 100644 --- a/src/gsi/setuprad.f90 +++ b/src/gsi/setuprad.f90 @@ -270,7 +270,8 @@ subroutine setuprad(obsLL,odiagLL,lunin,mype,aivals,stats,nchanl,nreal,nobs,& use obsmod, only: luse_obsdiag,dval_use use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, nc_diag_chaninfo + nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, & + nc_diag_chaninfo, nc_diag_metadata_to_single use gsi_4dvar, only: nobs_bins,hr_obsbin,l4dvar use gridmod, only: nsig,regional,get_ij use satthin, only: super_val1 @@ -551,10 +552,12 @@ subroutine setuprad(obsLL,odiagLL,lunin,mype,aivals,stats,nchanl,nreal,nobs,& end if ! Load channel numbers into local array based on satellite type + if (iuse_rad(j)==4) then + predx(:,j)=zero + endif ich(jc)=j do i=1,npred - if (iuse_rad(j)==4) predx(i,j)=zero predchan(i,jc)=predx(i,j) end do ! @@ -2567,41 +2570,41 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) do i=1,nchanl_diag call nc_diag_metadata("Channel_Index", i ) call nc_diag_metadata("Observation_Class", obsclass ) - call nc_diag_metadata("Latitude", sngl(cenlat) ) ! observation latitude (degrees) - call nc_diag_metadata("Longitude", sngl(cenlon) ) ! observation longitude (degrees) + call nc_diag_metadata_to_single("Latitude",cenlat ) ! observation latitude (degrees) + call nc_diag_metadata_to_single("Longitude",cenlon ) ! observation longitude (degrees) - call nc_diag_metadata("Elevation", sngl(zsges) ) ! model (guess) elevation at observation location + call nc_diag_metadata_to_single("Elevation",zsges ) ! model (guess) elevation at observation location - call nc_diag_metadata("Obs_Time", sngl(dtime-time_offset) ) ! observation time (hours relative to analysis time) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') - call nc_diag_metadata("Scan_Position", sngl(data_s(iscan_pos,n)) ) ! sensor scan position - call nc_diag_metadata("Sat_Zenith_Angle", sngl(zasat*rad2deg) ) ! satellite zenith angle (degrees) - call nc_diag_metadata("Sat_Azimuth_Angle", sngl(data_s(ilazi_ang,n)) ) ! satellite azimuth angle (degrees) - call nc_diag_metadata("Sol_Zenith_Angle", sngl(pangs) ) ! solar zenith angle (degrees) - call nc_diag_metadata("Sol_Azimuth_Angle", sngl(data_s(isazi_ang,n)) ) ! solar azimuth angle (degrees) - call nc_diag_metadata("Sun_Glint_Angle", sngl(sgagl) ) ! sun glint angle (degrees) (sgagl) - call nc_diag_metadata("Scan_Angle", sngl(data_s(iscan_ang,n)*rad2deg) ) ! scan angle + call nc_diag_metadata_to_single("Scan_Position",data_s(iscan_pos,n) ) ! sensor scan position + call nc_diag_metadata_to_single("Sat_Zenith_Angle", zasat,rad2deg,'*') ! satellite zenith angle (degrees) + call nc_diag_metadata_to_single("Sat_Azimuth_Angle",data_s(ilazi_ang,n) ) ! satellite azimuth angle (degrees) + call nc_diag_metadata_to_single("Sol_Zenith_Angle",pangs ) ! solar zenith angle (degrees) + call nc_diag_metadata_to_single("Sol_Azimuth_Angle",data_s(isazi_ang,n) ) ! solar azimuth angle (degrees) + call nc_diag_metadata_to_single("Sun_Glint_Angle",sgagl ) ! sun glint angle (degrees) (sgagl) + call nc_diag_metadata_to_single("Scan_Angle",data_s(iscan_ang,n),rad2deg,'*' ) ! scan angle - call nc_diag_metadata("Water_Fraction", sngl(surface(1)%water_coverage) ) ! fractional coverage by water - call nc_diag_metadata("Land_Fraction", sngl(surface(1)%land_coverage) ) ! fractional coverage by land - call nc_diag_metadata("Ice_Fraction", sngl(surface(1)%ice_coverage) ) ! fractional coverage by ice - call nc_diag_metadata("Snow_Fraction", sngl(surface(1)%snow_coverage) ) ! fractional coverage by snow + call nc_diag_metadata_to_single("Water_Fraction",surface(1)%water_coverage ) ! fractional coverage by water + call nc_diag_metadata_to_single("Land_Fraction",surface(1)%land_coverage ) ! fractional coverage by land + call nc_diag_metadata_to_single("Ice_Fraction",surface(1)%ice_coverage ) ! fractional coverage by ice + call nc_diag_metadata_to_single("Snow_Fraction",surface(1)%snow_coverage ) ! fractional coverage by snow if(.not. retrieval)then - call nc_diag_metadata("Water_Temperature", sngl(surface(1)%water_temperature) ) ! surface temperature over water (K) - call nc_diag_metadata("Land_Temperature", sngl(surface(1)%land_temperature) ) ! surface temperature over land (K) - call nc_diag_metadata("Ice_Temperature", sngl(surface(1)%ice_temperature) ) ! surface temperature over ice (K) - call nc_diag_metadata("Snow_Temperature", sngl(surface(1)%snow_temperature) ) ! surface temperature over snow (K) - call nc_diag_metadata("Soil_Temperature", sngl(surface(1)%soil_temperature) ) ! soil temperature (K) - call nc_diag_metadata("Soil_Moisture", sngl(surface(1)%soil_moisture_content) ) ! soil moisture + call nc_diag_metadata_to_single("Water_Temperature",surface(1)%water_temperature ) ! surface temperature over water (K) + call nc_diag_metadata_to_single("Land_Temperature",surface(1)%land_temperature ) ! surface temperature over land (K) + call nc_diag_metadata_to_single("Ice_Temperature",surface(1)%ice_temperature ) ! surface temperature over ice (K) + call nc_diag_metadata_to_single("Snow_Temperature",surface(1)%snow_temperature ) ! surface temperature over snow (K) + call nc_diag_metadata_to_single("Soil_Temperature",surface(1)%soil_temperature ) ! soil temperature (K) + call nc_diag_metadata_to_single("Soil_Moisture",surface(1)%soil_moisture_content ) ! soil moisture call nc_diag_metadata("Land_Type_Index", surface(1)%land_type ) ! surface land type call nc_diag_metadata("tsavg5", missing ) ! SST first guess used for SST retrieval - call nc_diag_metadata("sstcu", missing ) ! NCEP SST analysis at t - call nc_diag_metadata("sstph", missing ) ! Physical SST retrieval - call nc_diag_metadata("sstnv", missing ) ! Navy SST retrieval + call nc_diag_metadata("sstcu", missing ) ! NCEP SST analysis at t + call nc_diag_metadata("sstph", missing ) ! Physical SST retrieval + call nc_diag_metadata("sstnv", missing ) ! Navy SST retrieval call nc_diag_metadata("dta", missing ) ! d(ta) corresponding to sstph call nc_diag_metadata("dqa", missing ) ! d(qa) corresponding to sstph - call nc_diag_metadata("dtp_avh", missing ) ! data type + call nc_diag_metadata("dtp_avh", missing ) ! data type else call nc_diag_metadata("Water_Temperature", missing ) ! surface temperature over water (K) call nc_diag_metadata("Land_Temperature", missing ) ! surface temperature over land (K) @@ -2610,27 +2613,27 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) call nc_diag_metadata("Soil_Temperature", missing ) ! soil temperature (K) call nc_diag_metadata("Soil_Moisture", missing ) ! soil moisture call nc_diag_metadata("Land_Type_Index", imissing ) ! surface land type - call nc_diag_metadata("tsavg5", sngl(tsavg5) ) ! SST first guess used for SST retrieval - call nc_diag_metadata("sstcu", sngl(sstcu) ) ! NCEP SST analysis at t - call nc_diag_metadata("sstph", sngl(sstph) ) ! Physical SST retrieval - call nc_diag_metadata("sstnv", sngl(sstnv) ) ! Navy SST retrieval - call nc_diag_metadata("dta", sngl(dta) ) ! d(ta) corresponding to sstph - call nc_diag_metadata("dqa", sngl(dqa) ) ! d(qa) corresponding to sstph - call nc_diag_metadata("dtp_avh", sngl(dtp_avh) ) ! data type + call nc_diag_metadata_to_single("tsavg5",tsavg5 ) ! SST first guess used for SST retrieval + call nc_diag_metadata_to_single("sstcu",sstcu ) ! NCEP SST analysis at t + call nc_diag_metadata_to_single("sstph",sstph ) ! Physical SST retrieval + call nc_diag_metadata_to_single("sstnv",sstnv ) ! Navy SST retrieval + call nc_diag_metadata_to_single("dta",dta ) ! d(ta) corresponding to sstph + call nc_diag_metadata_to_single("dqa",dqa ) ! d(qa) corresponding to sstph + call nc_diag_metadata_to_single("dtp_avh",dtp_avh ) ! data type endif - call nc_diag_metadata("Vegetation_Fraction", sngl(surface(1)%vegetation_fraction) ) - call nc_diag_metadata("Snow_Depth", sngl(surface(1)%snow_depth) ) - call nc_diag_metadata("tpwc", sngl(tpwc_obs) ) - call nc_diag_metadata("clw_guess_retrieval", sngl(clw_guess_retrieval) ) + call nc_diag_metadata_to_single("Vegetation_Fraction",surface(1)%vegetation_fraction ) + call nc_diag_metadata_to_single("Snow_Depth",surface(1)%snow_depth ) + call nc_diag_metadata_to_single("tpwc",tpwc_obs ) + call nc_diag_metadata_to_single("clw_guess_retrieval",clw_guess_retrieval ) - call nc_diag_metadata("Sfc_Wind_Speed", sngl(surface(1)%wind_speed) ) - call nc_diag_metadata("Cloud_Frac", sngl(cld) ) - call nc_diag_metadata("CTP", sngl(cldp) ) - call nc_diag_metadata("CLW", sngl(clw_obs) ) - call nc_diag_metadata("TPWC", sngl(tpwc_obs) ) - call nc_diag_metadata("clw_obs", sngl(clw_obs) ) - call nc_diag_metadata("clw_guess", sngl(clw_guess) ) + call nc_diag_metadata_to_single("Sfc_Wind_Speed",surface(1)%wind_speed ) + call nc_diag_metadata_to_single("Cloud_Frac",cld ) + call nc_diag_metadata_to_single("CTP",cldp ) + call nc_diag_metadata_to_single("CLW",clw_obs ) + call nc_diag_metadata_to_single("TPWC",tpwc_obs ) + call nc_diag_metadata_to_single("clw_obs",clw_obs ) + call nc_diag_metadata_to_single("clw_guess",clw_guess ) if (nstinfo==0) then data_s(itref,n) = missing @@ -2639,21 +2642,21 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) data_s(itz_tr,n) = missing endif - call nc_diag_metadata("Foundation_Temperature", sngl(data_s(itref,n)) ) ! reference temperature (Tr) in NSST - call nc_diag_metadata("SST_Warm_layer_dt", sngl(data_s(idtw,n)) ) ! dt_warm at zob - call nc_diag_metadata("SST_Cool_layer_tdrop", sngl(data_s(idtc,n)) ) ! dt_cool at zob - call nc_diag_metadata("SST_dTz_dTfound", sngl(data_s(itz_tr,n)) ) ! d(Tz)/d(Tr) + call nc_diag_metadata_to_single("Foundation_Temperature",data_s(itref,n) ) ! reference temperature (Tr) in NSST + call nc_diag_metadata_to_single("SST_Warm_layer_dt",data_s(idtw,n) ) ! dt_warm at zob + call nc_diag_metadata_to_single("SST_Cool_layer_tdrop",data_s(idtc,n) ) ! dt_cool at zob + call nc_diag_metadata_to_single("SST_dTz_dTfound",data_s(itz_tr,n) ) ! d(Tz)/d(Tr) - call nc_diag_metadata("Observation", sngl(tb_obs0(ich_diag(i))) ) ! observed brightness temperature (K) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(tbcnob(ich_diag(i))) ) ! observed - simulated Tb with no bias correction (K) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(tbc0(ich_diag(i) )) ) ! observed - simulated Tb with bias corrrection (K) + call nc_diag_metadata_to_single("Observation",tb_obs0(ich_diag(i)) ) ! observed brightness temperature (K) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",tbcnob(ich_diag(i)) ) ! observed - simulated Tb with no bias correction (K) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",tbc0(ich_diag(i) ) ) ! observed - simulated Tb with bias corrrection (K) errinv = sqrt(varinv0(ich_diag(i))) - call nc_diag_metadata("Inverse_Observation_Error", sngl(errinv) ) + call nc_diag_metadata_to_single("Inverse_Observation_Error",errinv ) if (save_jacobian .and. allocated(idnames)) then - call nc_diag_metadata("Observation_scaled", sngl(tb_obs(ich_diag(i))) ) ! observed brightness temperature (K) scaled by R^{-1/2} - call nc_diag_metadata("Obs_Minus_Forecast_adjusted_scaled", sngl(tbc(ich_diag(i) )) ) ! observed - simulated Tb with bias corrrection (K) scaled by R^{-1/2} + call nc_diag_metadata_to_single("Observation_scaled",tb_obs(ich_diag(i)) ) ! observed brightness temperature (K) scaled by R^{-1/2} + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted_scaled",tbc(ich_diag(i) ) ) ! observed - simulated Tb with bias corrrection (K) scaled by R^{-1/2} errinv = sqrt(varinv(ich_diag(i))) - call nc_diag_metadata("Inverse_Observation_Error_scaled", sngl(errinv) ) + call nc_diag_metadata_to_single("Inverse_Observation_Error_scaled",errinv ) endif if (save_jacobian) then j = 1 @@ -2692,34 +2695,34 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) useflag=one if (iuse_rad(ich(ich_diag(i))) < 1) useflag=-one - call nc_diag_metadata("QC_Flag", sngl(id_qc(ich_diag(i))*useflag) ) ! quality control mark or event indicator - - call nc_diag_metadata("Emissivity", sngl(emissivity(ich_diag(i))) ) ! surface emissivity - call nc_diag_metadata("Weighted_Lapse_Rate", sngl(tlapchn(ich_diag(i))) ) ! stability index - call nc_diag_metadata("dTb_dTs", sngl(ts(ich_diag(i))) ) ! d(Tb)/d(Ts) - - call nc_diag_metadata("BC_Constant", sngl(predbias(1,ich_diag(i))) ) ! constant bias correction term - call nc_diag_metadata("BC_Scan_Angle", sngl(predbias(2,ich_diag(i))) ) ! scan angle bias correction term - call nc_diag_metadata("BC_Cloud_Liquid_Water", sngl(predbias(3,ich_diag(i))) ) ! CLW bias correction term - call nc_diag_metadata("BC_Lapse_Rate_Squared", sngl(predbias(4,ich_diag(i))) ) ! square lapse rate bias correction term - call nc_diag_metadata("BC_Lapse_Rate", sngl(predbias(5,ich_diag(i))) ) ! lapse rate bias correction term - call nc_diag_metadata("BC_Cosine_Latitude_times_Node", sngl(predbias(6,ich_diag(i))) ) ! node*cos(lat) bias correction term - call nc_diag_metadata("BC_Sine_Latitude", sngl(predbias(7,ich_diag(i))) ) ! sin(lat) bias correction term - call nc_diag_metadata("BC_Emissivity", sngl(predbias(8,ich_diag(i))) ) ! emissivity sensitivity bias correction term - call nc_diag_metadata("BC_Fixed_Scan_Position", sngl(predbias(npred+1,ich_diag(i))) ) ! external scan angle + call nc_diag_metadata("QC_Flag",sngl(id_qc(ich_diag(i))*useflag))! quality control mark or event indicator + + call nc_diag_metadata_to_single("Emissivity",emissivity(ich_diag(i)) ) ! surface emissivity + call nc_diag_metadata_to_single("Weighted_Lapse_Rate",tlapchn(ich_diag(i)) ) ! stability index + call nc_diag_metadata_to_single("dTb_dTs",ts(ich_diag(i)) ) ! d(Tb)/d(Ts) + + call nc_diag_metadata_to_single("BC_Constant",predbias(1,ich_diag(i)) ) ! constant bias correction term + call nc_diag_metadata_to_single("BC_Scan_Angle",predbias(2,ich_diag(i)) ) ! scan angle bias correction term + call nc_diag_metadata_to_single("BC_Cloud_Liquid_Water",predbias(3,ich_diag(i)) ) ! CLW bias correction term + call nc_diag_metadata_to_single("BC_Lapse_Rate_Squared",predbias(4,ich_diag(i)) ) ! square lapse rate bias correction term + call nc_diag_metadata_to_single("BC_Lapse_Rate",predbias(5,ich_diag(i)) ) ! lapse rate bias correction term + call nc_diag_metadata_to_single("BC_Cosine_Latitude_times_Node",predbias(6,ich_diag(i)) ) ! node*cos(lat) bias correction term + call nc_diag_metadata_to_single("BC_Sine_Latitude",predbias(7,ich_diag(i)) ) ! sin(lat) bias correction term + call nc_diag_metadata_to_single("BC_Emissivity",predbias(8,ich_diag(i)) ) ! emissivity sensitivity bias correction term + call nc_diag_metadata_to_single("BC_Fixed_Scan_Position",predbias(npred+1,ich_diag(i)) ) ! external scan angle if (lwrite_predterms) then - call nc_diag_metadata("BCPred_Constant", sngl(pred(1,ich_diag(i))) ) ! constant bias correction term - call nc_diag_metadata("BCPred_Scan_Angle", sngl(pred(2,ich_diag(i))) ) ! scan angle bias correction term - call nc_diag_metadata("BCPred_Cloud_Liquid_Water", sngl(pred(3,ich_diag(i))) ) ! CLW bias correction term - call nc_diag_metadata("BCPred_Lapse_Rate_Squared", sngl(pred(4,ich_diag(i))) ) ! square lapse rate bias correction term - call nc_diag_metadata("BCPred_Lapse_Rate", sngl(pred(5,ich_diag(i))) ) ! lapse rate bias correction term - call nc_diag_metadata("BCPred_Cosine_Latitude_times_Node", sngl(pred(6,ich_diag(i))) ) ! node*cos(lat) bias correction term - call nc_diag_metadata("BCPred_Sine_Latitude", sngl(pred(7,ich_diag(i))) ) ! sin(lat) bias correction term - call nc_diag_metadata("BCPred_Emissivity", sngl(pred(8,ich_diag(i))) ) ! emissivity sensitivity bias correction term + call nc_diag_metadata_to_single("BCPred_Constant",pred(1,ich_diag(i)) ) ! constant bias correction term + call nc_diag_metadata_to_single("BCPred_Scan_Angle",pred(2,ich_diag(i)) ) ! scan angle bias correction term + call nc_diag_metadata_to_single("BCPred_Cloud_Liquid_Water",pred(3,ich_diag(i)) ) ! CLW bias correction term + call nc_diag_metadata_to_single("BCPred_Lapse_Rate_Squared",pred(4,ich_diag(i)) ) ! square lapse rate bias correction term + call nc_diag_metadata_to_single("BCPred_Lapse_Rate",pred(5,ich_diag(i)) ) ! lapse rate bias correction term + call nc_diag_metadata_to_single("BCPred_Cosine_Latitude_times_Node",pred(6,ich_diag(i)) ) ! node*cos(lat) bias correction term + call nc_diag_metadata_to_single("BCPred_Sine_Latitude",pred(7,ich_diag(i)) ) ! sin(lat) bias correction term + call nc_diag_metadata_to_single("BCPred_Emissivity",pred(8,ich_diag(i)) ) ! emissivity sensitivity bias correction term endif if (lwrite_peakwt) then - call nc_diag_metadata("Press_Max_Weight_Function", sngl(weightmax(ich_diag(i))) ) + call nc_diag_metadata_to_single("Press_Max_Weight_Function",weightmax(ich_diag(i)) ) endif if (adp_anglebc) then do j=1, angord diff --git a/src/gsi/setuprhsall.f90 b/src/gsi/setuprhsall.f90 index 3efcb69859..8075956431 100644 --- a/src/gsi/setuprhsall.f90 +++ b/src/gsi/setuprhsall.f90 @@ -168,6 +168,7 @@ subroutine setuprhsall(ndata,mype,init_pass,last_pass) i_gust,i_vis,i_pblh,i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv, & i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp use m_rhs, only: i_dbz + use m_rhs, only: i_fed use m_rhs, only: i_light use m_gpsStats, only: gpsStats_genstats ! was genstats_gps() @@ -625,7 +626,7 @@ subroutine setuprhsall(ndata,mype,init_pass,last_pass) call statsconv(mype,& i_ps,i_uv,i_t,i_q,i_pw,i_rw,i_dw,i_gps,i_sst,i_tcp,i_lag, & i_gust,i_vis,i_pblh,i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv, & - i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_dbz, & + i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_fed,i_dbz, & size(awork1,2),bwork1,awork1,ndata) ! Compute and print statistics for "lightning" data diff --git a/src/gsi/setuprw.f90 b/src/gsi/setuprw.f90 index 2211ee6caa..1e3900aafa 100644 --- a/src/gsi/setuprw.f90 +++ b/src/gsi/setuprw.f90 @@ -117,7 +117,7 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa doradaroneob,oneobddiff,oneobvalue, if_vrobs_raw, if_use_w_vr use obsmod, only: netcdf_diag, binary_diag, dirname,ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_rwNode, only: rwNode @@ -1319,30 +1319,30 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(ielev,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(zero) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(ielev,i) ) + call nc_diag_metadata_to_single("Pressure",presw ) + call nc_diag_metadata_to_single("Height",data(ihgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata("Prep_QC_Mark", 0.0_r_single ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + + call nc_diag_metadata_to_single("Observation",data(irwob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",data(irwob,i),rwwind,'-') - call nc_diag_metadata("Observation", sngl(data(irwob,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(irwob,i)-rwwind) ) - if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then @@ -1351,18 +1351,18 @@ subroutine contents_netcdf_diag_(odiag) obsdiag_iuse(jj) = -one endif enddo - + call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif if (save_jacobian) then call nc_diag_data2d("Observation_Operator_Jacobian_stind", dhx_dx%st_ind) call nc_diag_data2d("Observation_Operator_Jacobian_endind", dhx_dx%end_ind) call nc_diag_data2d("Observation_Operator_Jacobian_val", real(dhx_dx%val,r_single)) endif - + end subroutine contents_netcdf_diag_ subroutine final_vars_ diff --git a/src/gsi/setupspd.f90 b/src/gsi/setupspd.f90 index 91b2467bf3..64366394cb 100644 --- a/src/gsi/setupspd.f90 +++ b/src/gsi/setupspd.f90 @@ -114,7 +114,7 @@ subroutine setupspd(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags use obsmod, only: netcdf_diag, binary_diag, dirname, ianldate use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_spdNode, only: spdNode @@ -949,29 +949,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure",presw ) + call nc_diag_metadata_to_single("Height",data(ihgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(spdob) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(spdob0-spdges) ) + call nc_diag_metadata_to_single("Observation",spdob ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", spdob0,spdges,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupsst.f90 b/src/gsi/setupsst.f90 index 6562d0392f..27d08daa86 100644 --- a/src/gsi/setupsst.f90 +++ b/src/gsi/setupsst.f90 @@ -99,7 +99,7 @@ subroutine setupsst(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags use obsmod, only: luse_obsdiag use obsmod, only: netcdf_diag, binary_diag, dirname,ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin use oneobmod, only: magoberr,maginnov,oneobtest @@ -585,35 +585,35 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) call nc_diag_metadata("Pressure", missing ) - call nc_diag_metadata("Height", sngl(data(izob,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(ipct,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Height",data(izob,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(ipct,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(data(isst,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(isst,i)-sstges) ) + call nc_diag_metadata_to_single("Observation",data(isst,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",data(isst,i),sstges,'-') if (nst_gsi>0) then - call nc_diag_metadata("FoundationTempBG", sngl(data(itref,i)) ) - call nc_diag_metadata("DiurnalWarming_at_zob", sngl(data(idtw,i)) ) - call nc_diag_metadata("SkinLayerCooling_at_zob", sngl(data(idtw,i)) ) - call nc_diag_metadata("Sensitivity_Tzob_Tr", sngl(data(itz_tr,i)) ) + call nc_diag_metadata_to_single("FoundationTempBG",data(itref,i) ) + call nc_diag_metadata_to_single("DiurnalWarming_at_zob",data(idtw,i) ) + call nc_diag_metadata_to_single("SkinLayerCooling_at_zob",data(idtw,i) ) + call nc_diag_metadata_to_single("Sensitivity_Tzob_Tr",data(itz_tr,i) ) endif if (lobsdiagsave) then diff --git a/src/gsi/setupswcp.f90 b/src/gsi/setupswcp.f90 index c65ad1495c..6797357103 100644 --- a/src/gsi/setupswcp.f90 +++ b/src/gsi/setupswcp.f90 @@ -67,7 +67,7 @@ subroutine setupswcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header,nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init,nc_diag_read_get_dim,nc_diag_read_close use state_vectors, only: svars3d, levels @@ -893,28 +893,28 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(data(iobsprs,i)) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(rmiss_single) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure",data(iobsprs,i) ) + call nc_diag_metadata_to_single("Height",data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i) ) + call nc_diag_metadata("Setup_QC_Mark",rmiss_single ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(dswcp) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(dswcp-swcpges)) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + call nc_diag_metadata_to_single("Observation",dswcp ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", dswcp,swcpges,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupt.f90 b/src/gsi/setupt.f90 index a0710e8abb..5467a6dec9 100644 --- a/src/gsi/setupt.f90 +++ b/src/gsi/setupt.f90 @@ -42,7 +42,7 @@ subroutine setupt(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav use obsmod, only: netcdf_diag, binary_diag, dirname use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use qcmod, only: npres_print,dfact,dfact1,ptop,pbot,buddycheck_t @@ -1767,42 +1767,42 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i)) + call nc_diag_metadata_to_single("Longitude",data(ilone,i)) ! this is the obs height after being interpolated to the model (=model height) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(prest) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i)) + call nc_diag_metadata_to_single("Pressure",prest) ! this is the original obs height (= stn elevation, before being interpolated) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(data(iqt,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Height",data(iobshgt,i)) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i)) + call nc_diag_metadata_to_single("Setup_QC_Mark",data(iqt,i)) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i)) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) if (hofx_2m_sfcfile ) then - call nc_diag_metadata("Observation", sngl(tob) ) + call nc_diag_metadata_to_single("Observation", tob ) else - call nc_diag_metadata("Observation", sngl(data(itob,i)) ) + call nc_diag_metadata_to_single("Observation", data(itob,i) ) endif - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(tob-tges) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",tob,tges,'-') if (aircraft_t_bc_pof .or. aircraft_t_bc .or. aircraft_t_bc_ext) then - call nc_diag_metadata("Data_Pof", sngl(data(ipof,i)) ) - call nc_diag_metadata("Data_Vertical_Velocity", sngl(data(ivvlc,i)) ) + call nc_diag_metadata_to_single("Data_Pof",data(ipof,i)) + call nc_diag_metadata_to_single("Data_Vertical_Velocity",data(ivvlc,i)) if (npredt .gt. one) then call nc_diag_data2d("Bias_Correction_Terms", sngl(predbias) ) else if (npredt .eq. one) then - call nc_diag_metadata("Bias_Correction_Terms", sngl(predbias(1)) ) + call nc_diag_metadata_to_single("Bias_Correction_Terms",predbias(1)) endif else call nc_diag_metadata("Data_Pof", missing ) @@ -1856,33 +1856,35 @@ subroutine contents_netcdf_diagp_(odiag) real(r_single),parameter:: missing = -9.99e9_r_single real(r_kind),dimension(miter) :: obsdiag_iuse + real(r_kind) :: var_jb_m call nc_diag_metadata("Station_ID", station_id ) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", -1 ) ! (-1 for pseudo obs sub-type) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(prest) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(data(iqt,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i)) + call nc_diag_metadata_to_single("Longitude",data(ilone,i)) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i)) + call nc_diag_metadata_to_single("Pressure",prest) + call nc_diag_metadata_to_single("Height",data(iobshgt,i)) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i)) + call nc_diag_metadata_to_single("Setup_QC_Mark",data(iqt,i)) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i)) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(var_jb*1.0e+6+rwgt)) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(data(itob,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(ddiff) ) + var_jb_m = var_jb * 1.0e+6 + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",var_jb_m,rwgt,'-') + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + call nc_diag_metadata_to_single("Observation",data(itob,i)) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",ddiff ) !---- if (lobsdiagsave) then diff --git a/src/gsi/setuptcp.f90 b/src/gsi/setuptcp.f90 index cfef05d06c..3d13c5fe8e 100644 --- a/src/gsi/setuptcp.f90 +++ b/src/gsi/setuptcp.f90 @@ -57,7 +57,7 @@ subroutine setuptcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags time_offset,rmiss_single,lobsdiagsave,lobsdiag_forenkf,ianldate use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_tcpNode, only: tcpNode @@ -692,29 +692,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) call nc_diag_metadata("Station_Elevation", sngl(zero) ) - call nc_diag_metadata("Pressure", sngl(data(ipres,i)*r10)) - call nc_diag_metadata("Height", sngl(zero) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) + call nc_diag_metadata_to_single("Pressure", data(ipres,i),r10,'*') + call nc_diag_metadata_to_single("Height",zero ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') call nc_diag_metadata("Prep_QC_Mark", sngl(one) ) call nc_diag_metadata("Prep_Use_Flag", sngl(one) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",(rwgt) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(pob) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(pob-pges) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(pob-pgesorig)) + call nc_diag_metadata_to_single("Observation",pob ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",pob,pges,'-') + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",pob,pgesorig,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupuwnd10m.f90 b/src/gsi/setupuwnd10m.f90 index 4552a7e81a..24a4e3d4f7 100644 --- a/src/gsi/setupuwnd10m.f90 +++ b/src/gsi/setupuwnd10m.f90 @@ -428,7 +428,7 @@ subroutine setupuwnd10m(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_d lowlevelsat=itype==242.or.itype==243.or.itype==245.or.itype==246.or. & itype==247.or.itype==250.or.itype==251.or.itype==252.or. & itype==253.or.itype==254.or.itype==257.or.itype==258.or. & - itype==259 + itype==259.or.itype==241 if (lowlevelsat .and. twodvar_regional) then call windfactor(presw,factw) data(iuob,i)=factw*data(iuob,i) diff --git a/src/gsi/setupvwnd10m.f90 b/src/gsi/setupvwnd10m.f90 index 0c601e716b..0f5b46900a 100644 --- a/src/gsi/setupvwnd10m.f90 +++ b/src/gsi/setupvwnd10m.f90 @@ -428,7 +428,7 @@ subroutine setupvwnd10m(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_d lowlevelsat=itype==242.or.itype==243.or.itype==245.or.itype==246.or. & itype==247.or.itype==250.or.itype==251.or.itype==252.or. & itype==253.or.itype==254.or.itype==257.or.itype==258.or. & - itype==259 + itype==259.or.itype==241 if (lowlevelsat .and. twodvar_regional) then call windfactor(presw,factw) data(iuob,i)=factw*data(iuob,i) diff --git a/src/gsi/setupw.f90 b/src/gsi/setupw.f90 index 97ed1f8883..784df1dfbe 100644 --- a/src/gsi/setupw.f90 +++ b/src/gsi/setupw.f90 @@ -44,7 +44,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav use obsmod, only: l_obsprvdiag use obsmod, only: neutral_stability_windfact_2dvar,use_similarity_2dvar use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin,min_offset use qcmod, only: npres_print,ptop,pbot,dfact,dfact1,qc_satwnds,njqc,vqc @@ -877,7 +877,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav lowlevelsat=itype==242.or.itype==243.or.itype==245.or.itype==246.or. & itype==247.or.itype==250.or.itype==251.or.itype==252.or. & itype==253.or.itype==254.or.itype==257.or.itype==258.or. & - itype==259 + itype==259.or.itype==241 if (lowlevelsat .and. twodvar_regional) then call windfactor(presw,factw) data(iuob,i)=factw*data(iuob,i) @@ -1146,7 +1146,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav if(itype ==244) then ! AVHRR, use same as MODIS qcgross=r0_7*cgross(ikx) endif - if( itype == 245 .or. itype ==246) then + if( itype == 245 .or. itype ==246 .or. itype ==241) then if(presw <400.0_r_kind .and. presw >300.0_r_kind ) qcgross=r0_7*cgross(ikx) endif if(itype == 253 .or. itype ==254) then @@ -1782,37 +1782,37 @@ subroutine contents_netcdf_diag_(udiag,vdiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(ielev,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(ielev,i) ) + call nc_diag_metadata_to_single("Pressure",presw ) + call nc_diag_metadata_to_single("Height",data(ihgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i) ) ! call nc_diag_metadata("Setup_QC_Mark", rmiss_single ) - call nc_diag_metadata("Setup_QC_Mark", sngl(bmiss) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Setup_QC_Mark",bmiss ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Wind_Reduction_Factor_at_10m", sngl(factw) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + call nc_diag_metadata_to_single("Wind_Reduction_Factor_at_10m",factw ) if (.not. regional .or. fv3_regional) then - call nc_diag_metadata("u_Observation", sngl(data(iuob,i)) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_adjusted", sngl(dudiff) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_unadjusted", sngl(uob-ugesin) ) + call nc_diag_metadata_to_single("u_Observation",data(iuob,i) ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_adjusted",dudiff ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_unadjusted",uob,ugesin,'-') - call nc_diag_metadata("v_Observation", sngl(data(ivob,i)) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_adjusted", sngl(dvdiff) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_unadjusted", sngl(vob-vgesin) ) + call nc_diag_metadata_to_single("v_Observation",data(ivob,i) ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_adjusted",dvdiff ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_unadjusted",vob,vgesin,'-') else ! (if regional) ! replace positions 17-22 with earth relative wind component information @@ -1823,13 +1823,13 @@ subroutine contents_netcdf_diag_(udiag,vdiag) call rotate_wind_xy2ll(ugesin,vgesin,uges_e,vges_e,dlon_e,dlon,dlat) call rotate_wind_xy2ll(dudiff,dvdiff,dudiff_e,dvdiff_e,dlon_e,dlon,dlat) - call nc_diag_metadata("u_Observation", sngl(uob_e) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_adjusted", sngl(dudiff_e) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_unadjusted", sngl(uob_e-uges_e) ) + call nc_diag_metadata_to_single("u_Observation",uob_e ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_adjusted",dudiff_e ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_unadjusted",uob_e,uges_e,'-') - call nc_diag_metadata("v_Observation", sngl(vob_e) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_adjusted", sngl(dvdiff_e) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_unadjusted", sngl(vob_e-vges_e) ) + call nc_diag_metadata_to_single("v_Observation",vob_e ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_adjusted",dvdiff_e ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_unadjusted",vob_e,vges_e,'-') endif if (lobsdiagsave) then diff --git a/src/gsi/setupwspd10m.f90 b/src/gsi/setupwspd10m.f90 index 22618fbf9e..ad50c5b0c1 100644 --- a/src/gsi/setupwspd10m.f90 +++ b/src/gsi/setupwspd10m.f90 @@ -635,7 +635,7 @@ subroutine setupwspd10m(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_d lowlevelsat=itype==242.or.itype==243.or.itype==245.or.itype==246.or. & itype==247.or.itype==250.or.itype==251.or.itype==252.or. & itype==253.or.itype==254.or.itype==257.or.itype==258.or. & - itype==259 + itype==259.or.itype==241 if (lowlevelsat .and. twodvar_regional) then call windfactor(presw,factw) data(iuob,i)=factw*data(iuob,i) diff --git a/src/gsi/statsconv.f90 b/src/gsi/statsconv.f90 index a01675d8d0..0da8606f24 100644 --- a/src/gsi/statsconv.f90 +++ b/src/gsi/statsconv.f90 @@ -2,7 +2,7 @@ subroutine statsconv(mype,& i_ps,i_uv,i_t,i_q,i_pw,i_rw,i_dw,i_gps,i_sst,i_tcp,i_lag, & i_gust,i_vis,i_pblh,i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv, & i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,& - i_swcp,i_lwcp,i_dbz,i_ref,bwork,awork,ndata) + i_swcp,i_lwcp,i_fed,i_dbz,i_ref,bwork,awork,ndata) !$$$ subprogram documentation block ! . . . . ! subprogram: statconv prints statistics for conventional data @@ -74,6 +74,7 @@ subroutine statsconv(mype,& ! i_vwnd10m- index in awork array holding vwnd10m info ! i_swcp - index in awork array holding swcp info ! i_lwcp - index in awork array holding lwcp info +! i_fed - index in awork array holding fed info ! i_dbz - index in awork array holding dbz info ! i_ref - size of second dimension of awork array ! bwork - array containing information for statistics @@ -96,12 +97,12 @@ subroutine statsconv(mype,& iout_gust,iout_vis,iout_pblh,iout_wspd10m,iout_td2m,& iout_mxtm,iout_mitm,iout_pmsl,iout_howv,iout_tcamt,iout_lcbas,iout_cldch,& iout_uwnd10m,iout_vwnd10m,& - iout_dbz,iout_swcp,iout_lwcp,& + iout_fed,iout_dbz,iout_swcp,iout_lwcp,& mype_dw,mype_rw,mype_sst,mype_gps,mype_uv,mype_ps,& mype_t,mype_pw,mype_q,mype_tcp,ndat,dtype,mype_lag,mype_gust,& mype_vis,mype_pblh,mype_wspd10m,mype_td2m,mype_mxtm,mype_mitm,& mype_pmsl,mype_howv,mype_tcamt,mype_lcbas,mype_cldch,mype_uwnd10m,mype_vwnd10m,& - mype_dbz,mype_swcp,mype_lwcp + mype_fed,mype_dbz,mype_swcp,mype_lwcp use qcmod, only: npres_print,ptop,pbot,ptopq,pbotq use jfunc, only: first,jiter use gridmod, only: nsig @@ -112,7 +113,7 @@ subroutine statsconv(mype,& integer(i_kind) ,intent(in ) :: mype,i_ps,i_uv,& i_t,i_q,i_pw,i_rw,i_dw,i_gps,i_sst,i_tcp,i_lag,i_gust,i_vis,i_pblh,& i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv,i_tcamt,i_lcbas,& - i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_dbz,i_ref + i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_fed,i_dbz,i_ref real(r_kind),dimension(7*nsig+100,i_ref) ,intent(in ) :: awork real(r_kind),dimension(npres_print,nconvtype,5,3),intent(in ) :: bwork integer(i_kind),dimension(ndat,3) ,intent(in ) :: ndata @@ -136,6 +137,7 @@ subroutine statsconv(mype,& real(r_kind) dwqcplty,tqcplty,qctt,qctrw,rwqcplty,qctdw,qqcplty,qctgps real(r_kind) gpsqcplty,tpw3,pw3,qctq real(r_kind) tswcp3,tlwcp3,qctdbz,dbzqcplty + real(r_kind) fedmplty,tfed,qctfed,fedqcplty real(r_kind),dimension(1):: pbotall,ptopall logical,dimension(nconvtype):: pflag @@ -1325,6 +1327,68 @@ subroutine statsconv(mype,& end if end if +! Summary report for flash extent density + if(mype==mype_fed) then + nread=0 + nkeep=0 + do i=1,ndat + if(dtype(i)== 'fed')then + nread=nread+ndata(i,2) + nkeep=nkeep+ndata(i,3) + end if + end do + if(nread > 0)then + if(first)then + open(iout_fed) + else + open(iout_fed,position='append') + end if + + fedmplty=zero; fedqcplty=zero ; ntot=0 + tfed=zero ; qctfed=zero + if(nkeep > 0)then + mesage='current vfit of flash extent density, ranges in flashes per minute$' + do j=1,nconvtype + pflag(j)=trim(ioctype(j)) == 'fed' + end do + call dtast(bwork,npres_print,pbot,ptop,mesage,jiter,iout_fed,pflag) + + numgross=nint(awork(4,i_fed)) + numfailqc=nint(awork(21,i_fed)) + do k=1,nsig + num(k)=nint(awork(k+5*nsig+100,i_fed)) + rat=zero + rat3=zero + if(num(k) > 0) then + rat=awork(6*nsig+k+100,i_fed)/float(num(k)) + rat3=awork(3*nsig+k+100,i_fed)/float(num(k)) + end if + ntot=ntot+num(k) + fedmplty=fedmplty+awork(6*nsig+k+100,i_fed) + fedqcplty=fedqcplty+awork(3*nsig+k+100,i_fed) + write(iout_fed,240) 'r',num(k),k,awork(6*nsig+k+100,i_fed), & + awork(3*nsig+k+100,i_fed),rat,rat3 + end do + if(ntot > 0) then + tfed=fedmplty/float(ntot) + qctfed=fedqcplty/float(ntot) + end if + write(iout_fed,925) 'fed',numgross,numfailqc + numlow = nint(awork(2,i_fed)) + numhgh = nint(awork(3,i_fed)) + nhitopo = nint(awork(5,i_fed)) + ntoodif = nint(awork(6,i_fed)) + write(iout_fed,900) 'fed',numhgh,numlow + write(iout_fed,905) 'fed',nhitopo,ntoodif + end if + write(iout_fed,950) 'fed',jiter,nread,nkeep,ntot + write(iout_fed,951) 'fed',fedmplty,fedqcplty,tfed,qctfed + + close(iout_fed) + end if + end if + + if(mype==mype_tcp) then nread=0 nkeep=0 diff --git a/src/gsi/stpcalc.f90 b/src/gsi/stpcalc.f90 index 30387341e3..dd60703ce2 100644 --- a/src/gsi/stpcalc.f90 +++ b/src/gsi/stpcalc.f90 @@ -263,7 +263,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & real(r_quad),parameter:: one_tenth_quad = 0.1_r_quad ! Declare local variables - integer(i_kind) i,j,mm1,ii,iis,ibin,ipenloc,it + integer(i_kind) i,j,mm1,ii,iis,final_ii,ibin,ipenloc,it integer(i_kind) istp_use,nstep,nsteptot,kprt real(r_quad),dimension(4,ipen):: pbc real(r_quad),dimension(4,nobs_type):: pbcjo @@ -299,6 +299,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & kprt=3 pjcalc=.false. pj=zero_quad + final_ii=1 ! Begin calculating contributions to penalty and stepsize for various terms ! @@ -779,6 +780,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & write(iout_iter,*) ' early termination due to cx or stp <=0 ',cx,stp(ii) write(iout_iter,*) ' better stepsize found',cx,stp(ii) end if + final_ii=ii exit stepsize else if(ii == istp_iter)then if(mype == minmype)then @@ -786,6 +788,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & end if stp(istp_use)=zero end_iter = .true. + final_ii=ii exit stepsize else ! Try different (better?) stepsize @@ -810,12 +813,16 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & end_iter = .true. ! Finalize timer call timer_fnl('stpcalc') + final_ii=ii exit stepsize end if ! Check for convergence in stepsize estimation stprat(ii)=zero if(stp(ii) > zero_quad)stprat(ii)=abs((stp(ii)-stp(ii-1))/stp(ii)) - if(stprat(ii) < 1.e-4_r_kind) exit stepsize + if(stprat(ii) < 1.e-4_r_kind) then + final_ii=ii + exit stepsize + end if dels = one_tenth_quad*dels end if @@ -842,7 +849,10 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & istp_use=i end if end do - if(istp_use /= istp_iter)exit stepsize + if(istp_use /= istp_iter) then + final_ii=ii + exit stepsize + end if ! If no best stepsize set to zero and end minimization if(mype == minmype)then write(iout_iter,141)(outpen(i),i=1,nsteptot) @@ -850,8 +860,10 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & end_iter = .true. stp(ii)=zero_quad istp_use=ii + final_ii=ii exit stepsize end if + final_ii=ii end do stepsize if(kprt >= 2 .and. iter == 0)then call mpl_allreduce(ipen,nobs_bins,pj) @@ -882,7 +894,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & if(print_verbose)then write(iout_iter,200) (stp(i),i=0,istp_use) - write(iout_iter,199) (stprat(ii),ii=1,istp_use) + write(iout_iter,199) (stprat(i),i=1,istp_use) write(iout_iter,201) (outstp(i),i=1,nsteptot) write(iout_iter,202) (outpen(i)-outpen(4),i=1,nsteptot) end if @@ -890,7 +902,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & ! Check for final stepsize negative (probable error) if(stpinout <= zero)then if(mype == minmype)then - write(iout_iter,130) ii,bx,cx,stp(ii) + write(iout_iter,130) final_ii,bx,cx,stp(final_ii) write(iout_iter,105) (bsum(i),i=1,ipen) write(iout_iter,110) (csum(i),i=1,ipen) write(iout_iter,101) (pbc(1,i)-pen_est(i),i=1,ipen) diff --git a/ush/build.sh b/ush/build.sh index 71674c4f4c..9a280c4e55 100755 --- a/ush/build.sh +++ b/ush/build.sh @@ -30,7 +30,6 @@ set -x # Set CONTROLPATH variable to user develop installation CONTROLPATH="$DIR_ROOT/../develop/install/bin" - # Collect BUILD Options CMAKE_OPTS+=" -DCMAKE_BUILD_TYPE=$BUILD_TYPE" diff --git a/ush/detect_machine.sh b/ush/detect_machine.sh index ecd1ad536e..6f0673ce29 100755 --- a/ush/detect_machine.sh +++ b/ush/detect_machine.sh @@ -3,7 +3,7 @@ case $(hostname -f) in adecflow0[12].acorn.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### acorn - alogin0[12].acorn.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### acorn + alogin0[1-3].acorn.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### acorn clogin0[1-9].cactus.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### cactus01-9 clogin10.cactus.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### cactus10 dlogin0[1-9].dogwood.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### dogwood01-9 @@ -28,6 +28,7 @@ case $(hostname -f) in cheyenne[1-6].cheyenne.ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 cheyenne[1-6].ib0.cheyenne.ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 chadmin[1-6].ib0.cheyenne.ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 + chadmin[1-6].ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 login[1-4].stampede2.tacc.utexas.edu) MACHINE_ID=stampede ;; ### stampede1-4 diff --git a/ush/module-setup.sh b/ush/module-setup.sh index 469fd4a3c5..ab92477a56 100755 --- a/ush/module-setup.sh +++ b/ush/module-setup.sh @@ -18,7 +18,7 @@ elif [[ $MACHINE_ID = hera* ]] ; then elif [[ $MACHINE_ID = orion* ]] ; then # We are on Orion if ( ! eval module help > /dev/null 2>&1 ) ; then - source /apps/lmod/init/bash + source /apps/lmod/lmod/init/bash fi module purge @@ -57,33 +57,10 @@ elif [[ $MACHINE_ID = gaea* ]] ; then # /etc/profile here. source /etc/profile __ms_source_etc_profile=yes - else - __ms_source_etc_profile=no - fi - module purge - # clean up after purge - unset _LMFILES_ - unset _LMFILES_000 - unset _LMFILES_001 - unset LOADEDMODULES - module load modules - if [[ -d /opt/cray/ari/modulefiles ]] ; then - module use -a /opt/cray/ari/modulefiles - fi - if [[ -d /opt/cray/pe/ari/modulefiles ]] ; then - module use -a /opt/cray/pe/ari/modulefiles - fi - if [[ -d /opt/cray/pe/craype/default/modulefiles ]] ; then - module use -a /opt/cray/pe/craype/default/modulefiles - fi - if [[ -s /etc/opt/cray/pe/admin-pe/site-config ]] ; then - source /etc/opt/cray/pe/admin-pe/site-config - fi - if [[ "$__ms_source_etc_profile" == yes ]] ; then - source /etc/profile - unset __ms_source_etc_profile fi + source /lustre/f2/dev/role.epic/contrib/Lmod_init.sh + elif [[ $MACHINE_ID = expanse* ]]; then # We are on SDSC Expanse if ( ! eval module help > /dev/null 2>&1 ) ; then diff --git a/ush/sub_cheyenne b/ush/sub_cheyenne new file mode 100644 index 0000000000..7389bfeb24 --- /dev/null +++ b/ush/sub_cheyenne @@ -0,0 +1,169 @@ +#!/bin/sh --login +set -x +echo "starting sub_cheyenne" +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 + +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 "#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 $accnt" >> $cfile +echo "#PBS -V" >> $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 "cfile = $cfile" +echo "source /glade/u/apps/ch/modulefiles/default/localinit/localinit.sh >> $cfile" +echo "module purge" >> $cfile +echo "module use $modulefiles" >> $cfile +echo "module load gsi_cheyenne.intel" >> $cfile +echo "module list" >> $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 +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_cheyenne" +exit $rc + diff --git a/ush/sub_discover b/ush/sub_discover index 835cd37ace..583ffbef86 100755 --- a/ush/sub_discover +++ b/ush/sub_discover @@ -129,7 +129,7 @@ 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 $gsisrc/modulefiles" >> $cfile +echo "module use -a $modulefiles" >> $cfile echo "module load gsi_discover" >> $cfile echo "" >>$cfile echo "jobname=$jobname" >>$cfile diff --git a/ush/sub_gaea b/ush/sub_gaea new file mode 100755 index 0000000000..6fed1b3c10 --- /dev/null +++ b/ush/sub_gaea @@ -0,0 +1,170 @@ +#!/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 /lustre/f2/scratch/$LOGNAME ]; then + DATA=/lustre/f2/scratch/$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=c4" >> $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 "source /lustre/f2/dev/role.epic/contrib/Lmod_init.sh" >> $cfile +echo "module use $modulefiles" >> $cfile +echo "module load gsi_gaea" >> $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 --export=ALL $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_hera b/ush/sub_hera index d904417190..610756af00 100755 --- a/ush/sub_hera +++ b/ush/sub_hera @@ -137,7 +137,7 @@ echo "" >>$cfile echo ". /apps/lmod/lmod/init/sh" >> $cfile echo "module purge" >> $cfile -echo "module use $gsisrc/modulefiles" >> $cfile +echo "module use $modulefiles" >> $cfile echo "module load gsi_hera.intel" >> $cfile echo "module list" >> $cfile echo "" >>$cfile diff --git a/ush/sub_jet b/ush/sub_jet index e11be1280c..d30c566ce3 100755 --- a/ush/sub_jet +++ b/ush/sub_jet @@ -98,16 +98,10 @@ 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 "#SBATCH --output=$output" >> $cfile @@ -115,24 +109,24 @@ echo "#SBATCH --job-name=$jobname" echo "#SBATCH --qos=$queue" >> $cfile echo "#SBATCH --time=$timew" >> $cfile echo "#SBATCH --nodes=$nodes --ntasks-per-node=$procs --cpus-per-task=$threads" >> $cfile -#echo "#SBATCH -j oe" >> $cfile echo "#SBATCH --account=$accnt" >> $cfile echo "#SBATCH --mem=0" >> $cfile echo "#SBATCH --partition=kjet" >> $cfile -#echo "#SBATCH -V" >> $cfile -#echo "#PBS -d" >> $cfile -#. $exec >> $cfile -#echo "/bin/sh -x $exec" >> $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 $gsisrc/modulefiles" >> $cfile +echo "module use $modulefiles" >> $cfile echo "module load gsi_jet" >> $cfile echo "module list" >> $cfile echo "" >>$cfile @@ -146,40 +140,6 @@ 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 diff --git a/ush/sub_orion b/ush/sub_orion index 065e7c8ab0..1bcce5cc4f 100755 --- a/ush/sub_orion +++ b/ush/sub_orion @@ -126,7 +126,7 @@ echo "" >>$cfile echo ". /apps/lmod/lmod/init/sh" >> $cfile echo "module purge" >> $cfile -echo "module use $gsisrc/modulefiles" >> $cfile +echo "module use $modulefiles" >> $cfile echo "module load gsi_orion" >> $cfile echo "module list" >> $cfile echo "" >> $cfile diff --git a/ush/sub_wcoss2 b/ush/sub_wcoss2 index 57115ef7c6..f2df099f23 100755 --- a/ush/sub_wcoss2 +++ b/ush/sub_wcoss2 @@ -123,19 +123,14 @@ echo "" >> $cfile echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile echo "" >> $cfile -echo "module purge" >> $cfile -echo "module load envvar/1.0" >> $cfile -echo "module load PrgEnv-intel/8.2.0" >> $cfile -echo "module load intel/19.1.3.304" >> $cfile -echo "module load craype/2.7.13" >> $cfile -echo "module load cray-mpich/8.1.12" >> $cfile -echo "module load cray-pals/1.1.3" >> $cfile -echo "module load prod_util/2.0.14" >> $cfile -echo "module load prod_envir/2.0.6" >> $cfile -echo "module load crtm/2.4.0" >> $cfile -echo "module load cfp/2.0.4" >> $cfile -echo "module load netcdf/4.7.4" >> $cfile -echo "module list" >> $cfile +echo "module reset" >> $cfile +echo "module use $modulefiles" >> $cfile +echo "module load gsi_wcoss2" >> $cfile +echo "module load envvar/1.0" >> $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 + echo "" >> $cfile cat $exec >> $cfile