diff --git a/.gitmodules b/.gitmodules index ce86baf4e..5f9320a3d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,11 +1,11 @@ [submodule "ufs-weather-model"] path = sorc/hafs_forecast.fd url = https://github.com/hafs-community/ufs-weather-model.git - branch = support/HAFS + branch = support/HAFS [submodule "UFS_UTILS"] path = sorc/hafs_utils.fd url = https://github.com/hafs-community/UFS_UTILS.git - branch = support/HAFS + branch = support/HAFS [submodule "gfdl-tracker"] path = sorc/hafs_tracker.fd url = https://github.com/hafs-community/gfdl-tracker.git diff --git a/jobs/JHAFS_ANALYSIS b/jobs/JHAFS_ANALYSIS index 2228fbcfb..2e66aa8aa 100755 --- a/jobs/JHAFS_ANALYSIS +++ b/jobs/JHAFS_ANALYSIS @@ -13,12 +13,16 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then - #module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles - #module load modulefile.ProdGSI.${machine} + module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles + if [ ${machine} = "hera" ]; then + module load gsi_${machine}.intel + else + module load gsi_${machine} + fi module list fi diff --git a/jobs/JHAFS_ANALYSIS_VR b/jobs/JHAFS_ANALYSIS_VR index 14ec9096d..340db66fa 100755 --- a/jobs/JHAFS_ANALYSIS_VR +++ b/jobs/JHAFS_ANALYSIS_VR @@ -13,12 +13,16 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then - #module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles - #module load modulefile.ProdGSI.${machine} + module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles + if [ ${machine} = "hera" ]; then + module load gsi_${machine}.intel + else + module load gsi_${machine} + fi module list fi diff --git a/jobs/JHAFS_ATM_IC b/jobs/JHAFS_ATM_IC index 2c3c902b5..e72b3efb2 100755 --- a/jobs/JHAFS_ATM_IC +++ b/jobs/JHAFS_ATM_IC @@ -13,7 +13,7 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then diff --git a/jobs/JHAFS_ATM_INIT b/jobs/JHAFS_ATM_INIT index d23167e7c..6c603c98a 100755 --- a/jobs/JHAFS_ATM_INIT +++ b/jobs/JHAFS_ATM_INIT @@ -13,18 +13,10 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then - #module list - #module unload intelpython - #module use ${HOMEhafs}/sorc/hafs_forecast.fd/modulefiles - #if [ "${machine}" = "wcoss_cray" ] || [ "${machine}" = "wcoss_dell_p3" ]; then - # module load ufs_${machine} - #else - # module load ufs_${machine}.intel - #fi module list fi @@ -243,13 +235,7 @@ echo "export neststr=$neststr tilestr=${tilestr} gridstr=${gridstr}; ${HOMEhafs} done chmod +x cmdfile_product -if [ ${machine} = "wcoss_cray" ]; then - export OMP_NUM_THREADS=1 - export APRUNF="aprun -b -j1 -n2 -N1 -d1 -cc depth cfp" - ${APRUNF} cmdfile_product -else - ${APRUNC} ${MPISERIAL} -m cmdfile_product -fi +${APRUNC} ${MPISERIAL} -m cmdfile_product for ng in $(seq 1 ${ngrids}); do diff --git a/jobs/JHAFS_ATM_LBC b/jobs/JHAFS_ATM_LBC index b05367cd8..292c57a94 100755 --- a/jobs/JHAFS_ATM_LBC +++ b/jobs/JHAFS_ATM_LBC @@ -13,7 +13,7 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then @@ -37,7 +37,7 @@ export COMIN=${COMIN:?} export COMOUT=${COMOUT:?} export COMhafs=${COMhafs:-${COMOUT}} -export COMgfs=${COMgfs:-/gpfs/dell1/nco/ops/com/gfs/para} +export COMgfs=${COMgfs:-/lfs/h2/emc/hur/noscrub/hafs-input/COMGFSv16} export CDATE=${CDATE:-${YMDH}} export cyc=${cyc:?} diff --git a/jobs/JHAFS_ATM_POST b/jobs/JHAFS_ATM_POST index ce8efb18c..b5b258cd1 100755 --- a/jobs/JHAFS_ATM_POST +++ b/jobs/JHAFS_ATM_POST @@ -13,10 +13,11 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then +# module purge module use ${HOMEhafs}/sorc/hafs_post.fd/modulefiles module load ${machine} module list diff --git a/jobs/JHAFS_ATM_PREP b/jobs/JHAFS_ATM_PREP index f0e21d819..d6fccb074 100755 --- a/jobs/JHAFS_ATM_PREP +++ b/jobs/JHAFS_ATM_PREP @@ -13,7 +13,7 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then @@ -61,6 +61,12 @@ if [ ${ENSDA} = YES ]; then export target_lon=${target_lon_ens:--62.0} export target_lat=${target_lat_ens:-22.0} export refine_ratio=${refine_ratio_ens:-4} + export regional_esg=${regional_esg_ens:-no} + export idim_nest=${idim_nest_ens:-1320} + export jdim_nest=${jdim_nest_ens:-1320} + export delx_nest=${delx_nest_ens:-0.03} + export dely_nest=${dely_nest_ens:-0.03} + export halop2=${halop2_ens:-5} export OUTDIR=${OUTDIR:-${WORKhafs}/intercom/grid_ens/${CASE}} export DATA=${WORKhafs}/atm_prep_ens else @@ -113,6 +119,12 @@ export istart_nest=${istart_nest_mvnest1res:-46} export jstart_nest=${jstart_nest_mvnest1res:-238} export iend_nest=${iend_nest_mvnest1res:-1485} export jend_nest=${jend_nest_mvnest1res:-1287} +export regional_esg=${regional_esg_mvnest1res:-no} +export idim_nest=${idim_nest_mvnest1res:-3960} +export jdim_nest=${jdim_nest_mvnest1res:-3960} +export delx_nest=${delx_nest_mvnest1res:-0.01} +export dely_nest=${dely_nest_mvnest1res:-0.01} +export halop2=${halop2_mvnest1res:-15} export OUTDIR=${WORKhafs}/intercom/grid_mvnest1res/${CASE} export DATA=${WORKhafs}/atm_prep_mvnest1res diff --git a/jobs/JHAFS_ATM_VI b/jobs/JHAFS_ATM_VI index 4dfb06b27..bdefa8a74 100755 --- a/jobs/JHAFS_ATM_VI +++ b/jobs/JHAFS_ATM_VI @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list fi diff --git a/jobs/JHAFS_EMCGRAPHICS b/jobs/JHAFS_EMCGRAPHICS index 6ec84468a..4e23ac0b6 100755 --- a/jobs/JHAFS_EMCGRAPHICS +++ b/jobs/JHAFS_EMCGRAPHICS @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/sorc/hafs_graphics.fd/emc_graphics/modulefiles - module load modulefile.graphics.run.${machine} + module load graphics.run.${machine} module list fi diff --git a/jobs/JHAFS_ENKF_HX b/jobs/JHAFS_ENKF_HX index 32afbce87..e32561c21 100755 --- a/jobs/JHAFS_ENKF_HX +++ b/jobs/JHAFS_ENKF_HX @@ -13,7 +13,7 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then diff --git a/jobs/JHAFS_ENKF_MEAN b/jobs/JHAFS_ENKF_MEAN index d3e819fc8..ad88e4605 100755 --- a/jobs/JHAFS_ENKF_MEAN +++ b/jobs/JHAFS_ENKF_MEAN @@ -13,12 +13,16 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then - #module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles - #module load modulefile.ProdGSI.${machine} + module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles + if [ ${machine} = "hera" ]; then + module load gsi_${machine}.intel + else + module load gsi_${machine} + fi module list fi diff --git a/jobs/JHAFS_ENKF_RECENTER b/jobs/JHAFS_ENKF_RECENTER index fddd08227..81329abaf 100755 --- a/jobs/JHAFS_ENKF_RECENTER +++ b/jobs/JHAFS_ENKF_RECENTER @@ -13,12 +13,16 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then - #module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles - #module load modulefile.ProdGSI.${machine} + module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles + if [ ${machine} = "hera" ]; then + module load gsi_${machine}.intel + else + module load gsi_${machine} + fi module list fi diff --git a/jobs/JHAFS_ENKF_UPDATE b/jobs/JHAFS_ENKF_UPDATE index 45673da6f..6750fcdc0 100755 --- a/jobs/JHAFS_ENKF_UPDATE +++ b/jobs/JHAFS_ENKF_UPDATE @@ -13,12 +13,16 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then - #module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles - #module load modulefile.ProdGSI.${machine} + module use $HOMEhafs/sorc/hafs_gsi.fd/modulefiles + if [ ${machine} = "hera" ]; then + module load gsi_${machine}.intel + else + module load gsi_${machine} + fi module list fi diff --git a/jobs/JHAFS_FORECAST b/jobs/JHAFS_FORECAST index 26dc1d03c..632c9e575 100755 --- a/jobs/JHAFS_FORECAST +++ b/jobs/JHAFS_FORECAST @@ -13,18 +13,13 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then #module list #module unload intelpython #module use ${HOMEhafs}/sorc/hafs_forecast.fd/modulefiles - #if [ "${machine}" = "wcoss_cray" ] || [ "${machine}" = "wcoss_dell_p3" ]; then - # module load ufs_${machine} - #else - # module load ufs_${machine}.intel - #fi module list fi diff --git a/jobs/JHAFS_HRDGRAPHICS b/jobs/JHAFS_HRDGRAPHICS index cd43b8554..e0c2eb63a 100755 --- a/jobs/JHAFS_HRDGRAPHICS +++ b/jobs/JHAFS_HRDGRAPHICS @@ -16,7 +16,7 @@ export GPLOT_DIR=${GPLOThafs} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then diff --git a/jobs/JHAFS_MERGE b/jobs/JHAFS_MERGE index 51c36f056..a714d17b8 100755 --- a/jobs/JHAFS_MERGE +++ b/jobs/JHAFS_MERGE @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list fi diff --git a/jobs/JHAFS_OBS_PROC b/jobs/JHAFS_OBS_PROC index c3d2f9dea..5a9b6dec9 100755 --- a/jobs/JHAFS_OBS_PROC +++ b/jobs/JHAFS_OBS_PROC @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list fi diff --git a/jobs/JHAFS_OCN_POST b/jobs/JHAFS_OCN_POST index 388129022..a81f1038b 100755 --- a/jobs/JHAFS_OCN_POST +++ b/jobs/JHAFS_OCN_POST @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list fi diff --git a/jobs/JHAFS_OCN_PREP b/jobs/JHAFS_OCN_PREP index 66204b602..aef5b20c8 100755 --- a/jobs/JHAFS_OCN_PREP +++ b/jobs/JHAFS_OCN_PREP @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list fi diff --git a/jobs/JHAFS_PRODUCT b/jobs/JHAFS_PRODUCT index 60582a94e..2bf1dcffe 100755 --- a/jobs/JHAFS_PRODUCT +++ b/jobs/JHAFS_PRODUCT @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list fi @@ -89,11 +89,7 @@ echo "export neststr=$neststr tilestr=${tilestr} gridstr=${gridstr}; ${HOMEhafs} done chmod +x cmdfile_product -if [ ${machine} = "wcoss_cray" ]; then - export OMP_NUM_THREADS=1 - export APRUNF="aprun -b -j1 -n2 -N1 -d1 -cc depth cfp" - ${APRUNF} cmdfile_product -elif [ ${machine} = "wcoss2" ]; then +if [ ${machine} = "wcoss2" ]; then ncmd=$(cat ./cmdfile_product | wc -l) ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) ${APRUNCFP} -n ${ncmd_max} cfp ./cmdfile_product diff --git a/jobs/JHAFS_WAV_POST b/jobs/JHAFS_WAV_POST index 06a1bbada..e3426886d 100755 --- a/jobs/JHAFS_WAV_POST +++ b/jobs/JHAFS_WAV_POST @@ -13,12 +13,12 @@ export FIXhafs=${FIXhafs:-${HOMEhafs}/fix} source ${USHhafs}/hafs_pre_job.sh.inc source ${HOLDVARS:-storm1.holdvars.txt} -export machine=${WHERE_AM_I:-wcoss_cray} +export machine=${WHERE_AM_I:-wcoss2} export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list fi diff --git a/jobs/JHAFS_WAV_PREP b/jobs/JHAFS_WAV_PREP index b450d78ce..9a3d8bf0e 100755 --- a/jobs/JHAFS_WAV_PREP +++ b/jobs/JHAFS_WAV_PREP @@ -18,7 +18,7 @@ export envir=${envir:-prod} # prod, para, test export RUN_ENVIR=${RUN_ENVIR:-dev} # nco or dev if [ "${RUN_ENVIR^^}" != NCO ]; then module use ${HOMEhafs}/modulefiles - module load modulefile.hafs.${machine} + module load hafs.${machine} module list # A temporary workaround due to the hpc-stack version of wgrib2 does not work # on Orion to convert grib2 files into netcdf format. @@ -52,6 +52,7 @@ if [ "${SCRUBDATA}" = YES ]; then rm -rf $DATA fi +mkdir -p ${WORKhafs}/intercom/ww3 mkdir -p $DATA cd $DATA diff --git a/modulefiles/hafs.hera.lua b/modulefiles/hafs.hera.lua new file mode 100644 index 000000000..b14025afb --- /dev/null +++ b/modulefiles/hafs.hera.lua @@ -0,0 +1,136 @@ +help([[ +loads HAFS application level modulefile on Hera +]]) + +prepend_path("MODULEPATH", "/contrib/sutils/modulefiles") +load("sutils") +load("hpss") + +cmake_ver=os.getenv("cmake_ver") or "3.20.1" +load(pathJoin("cmake", cmake_ver)) + +prepend_path("MODULEPATH", "/scratch1/NCEPDEV/hwrf/noscrub/local/modulefiles") +load(pathJoin("python","wcoss2_env")) + +prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") +hpc_ver=os.getenv("hpc_ver") or "1.2.0" +load(pathJoin("hpc", hpc_ver)) + +hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +load(pathJoin("hpc-intel", hpc_intel_ver)) + +hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" +load(pathJoin("hpc-impi", hpc_impi_ver)) + +jasper_ver=os.getenv("jasper_ver") or "2.0.25" +load(pathJoin("jasper", jasper_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +zstd_ver=os.getenv("zstd_ver") or "1.5.0" +load(pathJoin("zstd", zstd_ver)) + +libpng_ver=os.getenv("libpng_ver") or "1.6.37" +load(pathJoin("libpng", libpng_ver)) + +hdf5_ver=os.getenv("hdf5_ver") or "1.10.6" +load(pathJoin("hdf5", hdf5_ver)) + +netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" +load(pathJoin("netcdf", netcdf_ver)) + +pio_ver=os.getenv("pio_ver") or "2.5.7" +load(pathJoin("pio", pio_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8.3.0b09" +load(pathJoin("esmf", esmf_ver)) + +fms_ver=os.getenv("fms_ver") or "2022.01" +load(pathJoin("fms",fms_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +crtm_ver=os.getenv("crtm_ver") or "2.4.0" +load(pathJoin("crtm", crtm_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.5" +load(pathJoin("g2", g2_ver)) + +g2tmpl_ver=os.getenv("g2tmpl_ver") or "1.10.0" +load(pathJoin("g2tmpl", g2tmpl_ver)) + +ip_ver=os.getenv("ip_ver") or "3.3.3" +load(pathJoin("ip", ip_ver)) + +nemsio_ver_ver=os.getenv("nemsio_ver") or "2.5.4" +load(pathJoin("nemsio", nemsio_ver)) + +sp_ver=os.getenv("sp_ver") or "2.3.3" +load(pathJoin("sp", sp_ver)) + +w3emc_ver=os.getenv("w3emc_ver") or "2.9.2" +load(pathJoin("w3emc", w3emc_ver)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_ver)) + +gftl_shared_ver=os.getenv("gftl_shared_ver") or "v1.5.0" +load(pathJoin("gftl-shared", gftl_shared_ver)) + +yafyaml_ver=os.getenv("yafyaml_ver") or "v0.5.1" +load(pathJoin("yafyaml", yafyaml_ver)) + +mapl_ver=os.getenv("mapl_ver") or "2.22.0-esmf-8.3.0b09" +load(pathJoin("mapl", mapl_ver)) + +bufr_ver=os.getenv("bufr_ver") or "11.4.0" +load(pathJoin("bufr", bufr_ver)) + +gfsio_ver=os.getenv("gfsio_ver") or "1.4.1" +load(pathJoin("gfsio", gfsio_ver)) + +landsfcutil_ver=os.getenv("landsfcutil_ver") or "2.4.1" +load(pathJoin("landsfcutil", landsfcutil_ver)) + +nemsiogfs_ver=os.getenv("nemsiogfs_ver") or "2.5.3" +load(pathJoin("nemsiogfs", nemsiogfs_ver)) + +sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" +load(pathJoin("sfcio", sfcio_ver)) + +sigio_ver=os.getenv("sigio_ver") or "2.3.2" +load(pathJoin("sigio", sigio_ver)) + +szip_ver=os.getenv("szip_ver") or "2.1.1" +load(pathJoin("szip", szip_ver)) + +wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" +load(pathJoin("wrf_io", wrf_io_ver)) + +prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +load(pathJoin("prod_util", prod_util_ver)) + +grib_util_ver=os.getenv("grib_util_ver") or "1.2.4" +load(pathJoin("grib_util", grib_util_ver)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) +setenv("WGRIB2", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/intel-18.0.5.274/impi-2018.0.4/wgrib2/2.0.8/bin/wgrib2") + +nco_ver=os.getenv("nco_ver") or "5.0.6" +load(pathJoin("nco", nco_ver)) + +rocoto_ver=os.getenv("rocoto_ver") or "1.3.3" +load(pathJoin("rocoto", rocoto_ver)) + +cdo_ver=os.getenv("cdo_ver") or "1.9.8" +load(pathJoin("cdo", cdo_ver)) + +setenv("CMAKE_C_COMPILER", "mpiicc") +setenv("CMAKE_CXX_COMPILER", "mpiicpc") +setenv("CMAKE_Fortran_COMPILER", "mpiifort") +setenv("CMAKE_Platform", "jet.intel") + +whatis("Description: HAFS Application environment") diff --git a/modulefiles/hafs.jet.lua b/modulefiles/hafs.jet.lua new file mode 100644 index 000000000..053013782 --- /dev/null +++ b/modulefiles/hafs.jet.lua @@ -0,0 +1,134 @@ +help([[ +loads HAFS application level modulefile on Jet +]]) + +prepend_path("MODULEPATH", "/contrib/sutils/modulefiles") +load("sutils") +load("hpss") + +cmake_ver=os.getenv("cmake_ver") or "3.20.1" +load(pathJoin("cmake", cmake_ver)) + +prepend_path("MODULEPATH", "/mnt/lfs4/HFIP/hwrfv3/local/modulefiles") +load(pathJoin("python", "wcoss2_env")) + +prepend_path("MODULEPATH", "/lfs4/HFIP/hfv3gfs/nwprod/hpc-stack/libs/modulefiles/stack") + +hpc_ver=os.getenv("hpc_ver") or "1.2.0" +load(pathJoin("hpc", hpc_ver)) + +hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +load(pathJoin("hpc-intel", hpc_intel_ver)) + +hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" +load(pathJoin("hpc-impi", hpc_impi_ver)) + +jasper_ver=os.getenv("jasper_ver") or "2.0.25" +load(pathJoin("jasper", jasper_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +libpng_ver=os.getenv("libpng_ver") or "1.6.37" +load(pathJoin("libpng", libpng_ver)) + +hdf5_ver=os.getenv("hdf5_ver") or "1.10.6" +load(pathJoin("hdf5", hdf5_ver)) + +netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" +load(pathJoin("netcdf", netcdf_ver)) + +pio_ver=os.getenv("pio_ver") or "2.5.7" +load(pathJoin("pio", pio_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8.3.0b09" +load(pathJoin("esmf", esmf_ver)) + +fms_ver=os.getenv("fms_ver") or "2022.01" +load(pathJoin("fms",fms_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +crtm_ver=os.getenv("crtm_ver") or "2.4.0" +load(pathJoin("crtm", crtm_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.5" +load(pathJoin("g2", g2_ver)) + +g2tmpl_ver=os.getenv("g2tmpl_ver") or "1.10.0" +load(pathJoin("g2tmpl", g2tmpl_ver)) + +ip_ver=os.getenv("ip_ver") or "3.3.3" +load(pathJoin("ip", ip_ver)) + +nemsio_ver_ver=os.getenv("nemsio_ver") or "2.5.4" +load(pathJoin("nemsio", nemsio_ver)) + +sp_ver=os.getenv("sp_ver") or "2.3.3" +load(pathJoin("sp", sp_ver)) + +w3emc_ver=os.getenv("w3emc_ver") or "2.9.2" +load(pathJoin("w3emc", w3emc_ver)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_ver)) + +gftl_shared_ver=os.getenv("gftl_shared_ver") or "v1.5.0" +load(pathJoin("gftl-shared", gftl_shared_ver)) + +yafyaml_ver=os.getenv("yafyaml_ver") or "v0.5.1" +load(pathJoin("yafyaml", yafyaml_ver)) + +mapl_ver=os.getenv("mapl_ver") or "2.22.0-esmf-8.3.0b09" +load(pathJoin("mapl", mapl_ver)) + +bufr_ver=os.getenv("bufr_ver") or "11.6.0" +load(pathJoin("bufr", bufr_ver)) + +gfsio_ver=os.getenv("gfsio_ver") or "1.4.1" +load(pathJoin("gfsio", gfsio_ver)) + +landsfcutil_ver=os.getenv("landsfcutil_ver") or "2.4.1" +load(pathJoin("landsfcutil", landsfcutil_ver)) + +nemsiogfs_ver=os.getenv("nemsiogfs_ver") or "2.5.3" +load(pathJoin("nemsiogfs", nemsiogfs_ver)) + +sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" +load(pathJoin("sfcio", sfcio_ver)) + +sigio_ver=os.getenv("sigio_ver") or "2.3.2" +load(pathJoin("sigio", sigio_ver)) + +szip_ver=os.getenv("szip_ver") or "2.1.1" +load(pathJoin("szip", szip_ver)) + +wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" +load(pathJoin("wrf_io", wrf_io_ver)) + +prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +load(pathJoin("prod_util", prod_util_ver)) + +grib_util_ver=os.getenv("grib_util_ver") or "1.2.4" +load(pathJoin("grib_util", grib_util_ver)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) +setenv("WGRIB2", "/lfs4/HFIP/hfv3gfs/nwprod/hpc-stack/libs/intel-2022.1.2/wgrib2/2.0.8/bin/wgrib2") + +nco_ver=os.getenv("nco_ver") or "5.0.6" +load(pathJoin("nco", nco_ver)) + +rocoto_ver=os.getenv("rocoto_ver") or "1.3.3" +load(pathJoin("rocoto", rocoto_ver)) + +cdo_ver=os.getenv("cdo_ver") or "1.9.10" +load(pathJoin("cdo", cdo_ver)) + +setenv("CMAKE_C_COMPILER", "mpiicc") +setenv("CMAKE_CXX_COMPILER", "mpiicpc") +setenv("CMAKE_Fortran_COMPILER", "mpiifort") +setenv("CMAKE_Platform", "jet.intel") + +whatis("Description: HAFS Application environment") diff --git a/modulefiles/hafs.orion.lua b/modulefiles/hafs.orion.lua new file mode 100644 index 000000000..2c6ebe345 --- /dev/null +++ b/modulefiles/hafs.orion.lua @@ -0,0 +1,133 @@ +help([[ +loads HAFS application level modulefile on Orion +]]) + +load("contrib") +load("noaatools") + +cmake_ver=os.getenv("cmake_ver") or "3.22.1" +load(pathJoin("cmake", cmake_ver)) + +prepend_path("MODULEPATH", "/work/noaa/hwrf/noscrub/local/modulefiles") +load(pathJoin("python", "wcoss2_env")) + +prepend_path("MODULEPATH", "/work/noaa/epic-ps/hpc-stack/libs/intel/2022.1.2/modulefiles/stack") + +hpc_ver=os.getenv("hpc_ver") or "1.2.0" +load(pathJoin("hpc", hpc_ver)) + +hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +load(pathJoin("hpc-intel", hpc_intel_ver)) + +hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" +load(pathJoin("hpc-impi", hpc_impi_ver)) + +jasper_ver=os.getenv("jasper_ver") or "2.0.25" +load(pathJoin("jasper", jasper_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +libpng_ver=os.getenv("libpng_ver") or "1.6.37" +load(pathJoin("libpng", libpng_ver)) + +hdf5_ver=os.getenv("hdf5_ver") or "1.10.6" +load(pathJoin("hdf5", hdf5_ver)) + +netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" +load(pathJoin("netcdf", netcdf_ver)) + +pio_ver=os.getenv("pio_ver") or "2.5.7" +load(pathJoin("pio", pio_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8.3.0b09" +load(pathJoin("esmf", esmf_ver)) + +fms_ver=os.getenv("fms_ver") or "2022.01" +load(pathJoin("fms",fms_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +crtm_ver=os.getenv("crtm_ver") or "2.4.0" +load(pathJoin("crtm", crtm_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.5" +load(pathJoin("g2", g2_ver)) + +g2tmpl_ver=os.getenv("g2tmpl_ver") or "1.10.0" +load(pathJoin("g2tmpl", g2tmpl_ver)) + +ip_ver=os.getenv("ip_ver") or "3.3.3" +load(pathJoin("ip", ip_ver)) + +nemsio_ver_ver=os.getenv("nemsio_ver") or "2.5.4" +load(pathJoin("nemsio", nemsio_ver)) + +sp_ver=os.getenv("sp_ver") or "2.3.3" +load(pathJoin("sp", sp_ver)) + +w3emc_ver=os.getenv("w3emc_ver") or "2.9.2" +load(pathJoin("w3emc", w3emc_ver)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_ver)) + +gftl_shared_ver=os.getenv("gftl_shared_ver") or "v1.5.0" +load(pathJoin("gftl-shared", gftl_shared_ver)) + +yafyaml_ver=os.getenv("yafyaml_ver") or "v0.5.1" +load(pathJoin("yafyaml", yafyaml_ver)) + +mapl_ver=os.getenv("mapl_ver") or "2.22.0-esmf-8.3.0b09" +load(pathJoin("mapl", mapl_ver)) + +bufr_ver=os.getenv("bufr_ver") or "11.5.0" +load(pathJoin("bufr", bufr_ver)) + +gfsio_ver=os.getenv("gfsio_ver") or "1.4.1" +load(pathJoin("gfsio", gfsio_ver)) + +landsfcutil_ver=os.getenv("landsfcutil_ver") or "2.4.1" +load(pathJoin("landsfcutil", landsfcutil_ver)) + +nemsiogfs_ver=os.getenv("nemsiogfs_ver") or "2.5.3" +load(pathJoin("nemsiogfs", nemsiogfs_ver)) + +sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" +load(pathJoin("sfcio", sfcio_ver)) + +sigio_ver=os.getenv("sigio_ver") or "2.3.2" +load(pathJoin("sigio", sigio_ver)) + +szip_ver=os.getenv("szip_ver") or "2.1.1" +load(pathJoin("szip", szip_ver)) + +wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" +load(pathJoin("wrf_io", wrf_io_ver)) + +prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +load(pathJoin("prod_util", prod_util_ver)) + +grib_util_ver=os.getenv("grib_util_ver") or "1.2.4" +load(pathJoin("grib_util", grib_util_ver)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) +setenv("WGRIB2", "/apps/contrib/NCEP/libs/hpc-stack/intel-2018.4/impi-2018.4/wgrib2/2.0.8/bin/wgrib2") + +nco_ver=os.getenv("nco_ver") or "5.0.6" +load(pathJoin("nco", nco_ver)) + +rocoto_ver=os.getenv("rocoto_ver") or "1.3.3" +load(pathJoin("rocoto", rocoto_ver)) + +cdo_ver=os.getenv("cdo_ver") or "1.9.10" +load(pathJoin("cdo", cdo_ver)) + +setenv("CMAKE_C_COMPILER", "mpiicc") +setenv("CMAKE_CXX_COMPILER", "mpiicpc") +setenv("CMAKE_Fortran_COMPILER", "mpiifort") +setenv("CMAKE_Platform", "jet.intel") + +whatis("Description: HAFS Application environment") diff --git a/modulefiles/hafs.wcoss2.lua b/modulefiles/hafs.wcoss2.lua new file mode 100644 index 000000000..cd670e545 --- /dev/null +++ b/modulefiles/hafs.wcoss2.lua @@ -0,0 +1,152 @@ +help([[ +loads HAFS application level modulefile on WCOSS2 (Cactus and Dogwood) +]]) + +envvar_ver=os.getenv("envvar_ver") or "1.0" +load(pathJoin("envvar", envvar_ver)) + +PrgEnv_intel_ver=os.getenv("PrgEnv_intel_ver") or "8.1.0" +load(pathJoin("PrgEnv-intel", PrgEnv_intel_ver)) + +intel_ver=os.getenv("intel_ver") or "19.1.3.304" +load(pathJoin("intel", intel_ver)) + +craype_ver=os.getenv("craype_ver") or "2.7.13" +load(pathJoin("craype", craype_ver)) + +cray_mpich_ver=os.getenv("cray_mpich_ver") or "8.1.7" +load(pathJoin("cray-mpich", cray_mpich_ver)) + +cray_pals_ver=os.getenv("cray_pals_ver") or "1.0.12" +load(pathJoin("cray-pals", cray_pals_ver)) + +python_ver=os.getenv("python_ver") or "3.8.6" +load(pathJoin("python", python_ver)) + +cmake_ver=os.getenv("cmake_ver") or "3.20.2" +load(pathJoin("cmake", cmake_ver)) + +setenv("HPC_OPT", "/apps/ops/para/libs") +prepend_path("MODULEPATH", "/apps/ops/para/libs/modulefiles/compiler/intel/19.1.3.304") +prepend_path("MODULEPATH", "/apps/ops/para/libs/modulefiles/mpi/intel/19.1.3.304/cray-mpich/8.1.7") + +jasper_ver=os.getenv("jasper_ver") or "2.0.25" +load(pathJoin("jasper", jasper_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +libpng_ver=os.getenv("libpng_ver") or "1.6.37" +load(pathJoin("libpng", libpng_ver)) + +libjpeg_ver=os.getenv("libjpeg_ver") or "9c" +load(pathJoin("libjpeg", libjpeg_ver)) +setenv("JPEG_LIBRARIES", "/apps/spack/libjpeg/9c/intel/19.1.3.304/jkr3isi257ktoouprwaxcn4twtye747z/lib") + +hdf5_ver=os.getenv("hdf5_ver") or "1.10.6" +load(pathJoin("hdf5", hdf5_ver)) + +netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" +load(pathJoin("netcdf", netcdf_ver)) + +pio_ver=os.getenv("pio_ver") or "2.5.7" +load(pathJoin("pio", pio_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8.3.0b09" +load(pathJoin("esmf", esmf_ver)) + +fms_ver=os.getenv("fms_ver") or "2022.01" +load(pathJoin("fms", fms_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +crtm_ver=os.getenv("crtm_ver") or "2.4.0" +load(pathJoin("crtm", crtm_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.5" +load(pathJoin("g2", g2_ver)) + +g2tmpl_ver=os.getenv("g2tmpl_ver") or "1.10.0" +load(pathJoin("g2tmpl", g2tmpl_ver)) + +ip_ver=os.getenv("ip_ver") or "3.3.3" +load(pathJoin("ip", ip_ver)) + +nemsio_ver=os.getenv("nemsio_ver") or "2.5.2" +load(pathJoin("nemsio", nemsio_ver)) + +sp_ver=os.getenv("sp_ver") or "2.3.3" +load(pathJoin("sp", sp_ver)) + +w3emc_ver=os.getenv("w3emc_ver") or "2.9.2" +load(pathJoin("w3emc", w3emc_ver)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nmc_ver)) + +g2c_ver=os.getenv("g2c_ver") or "1.6.4" +load(pathJoin("g2c", g2c_ver)) + +bufr_ver=os.getenv("bufr_ver") or "11.6.0" +load(pathJoin("bufr", bufr_ver)) + +gfsio_ver=os.getenv("gfsio_ver") or "1.4.1" +load(pathJoin("gfsio", gfsio_ver)) + +landsfcutil_ver=os.getenv("landsfcutil_ver") or "2.4.1" +load(pathJoin("landsfcutil", landsfcutil_ver)) + +nemsiogfs_ver=os.getenv("nemsiogfs_ver") or "2.5.3" +load(pathJoin("nemsiogfs", nemsiogfs_ver)) + +sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" +load(pathJoin("sfcio", sfcio_ver)) + +sigio_ver=os.getenv("sigio_ver") or "2.3.2" +load(pathJoin("sigio", sigio_ver)) + +wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" +load(pathJoin("wrf_io", wrf_io_ver)) + +prod_util_ver=os.getenv("prod_util_ver") or "2.0.13" +load(pathJoin("prod_util", prod_util_ver)) + +grib_util_ver=os.getenv("grib_util_ver") or "1.2.4" +load(pathJoin("grib_util", grib_util_ver)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8_wmo" +load(pathJoin("wgrib2", wgrib2_ver)) + +cfp_ver=os.getenv("cfp_ver") or "2.0.4" +load(pathJoin("cfp", cfp_ver)) + +gsl_ver=os.getenv("gsl_ver") or "2.7" +load(pathJoin("gsl", gsl_ver)) + +udunits_ver=os.getenv("udunits_ver") or "2.2.28" +load(pathJoin("udunits", udunits_ver)) + +nco_ver=os.getenv("nco_ver") or "4.7.9" +load(pathJoin("nco", nco_ver)) + +ncio_ver=os.getenv("ncio_ver") or "1.1.2" +load(pathJoin("ncio",ncio_ver)) + +ncdiag_ver=os.getenv("ncdiag_ver") or "1.0.0" +load(pathJoin("ncdiag",ncdiag_ver)) + +setenv("CMAKE_C_COMPILER", "cc") +setenv("CMAKE_CXX_COMPILER", "CC") +setenv("CMAKE_Fortran_COMPILER", "ftn") +setenv("CMAKE_Platform", "wcoss2") + +prepend_path("MODULEPATH", "/apps/ops/test/nco/modulefiles") + +rocoto_ver=os.getenv("rocoto_ver") or "1.3.5" +load(pathJoin("core", "rocoto", rocoto_ver)) + +cdo_ver=os.getenv("cdo_ver") or "1.9.8" +load(pathJoin("cdo", cdo_ver)) + +whatis("Description: HAFS Applicationenvironment") diff --git a/modulefiles/modulefile.hafs.hera b/modulefiles/modulefile.hafs.hera deleted file mode 100644 index 29dac72f1..000000000 --- a/modulefiles/modulefile.hafs.hera +++ /dev/null @@ -1,73 +0,0 @@ -#%Module##################################################### -## Module file for hafs -############################################################# -proc ModulesHelp { } { - puts stderr "Set environment veriables for compiling or running HAFS" -} -module-whatis " HAFS model prerequisites" - -module use /contrib/sutils/modulefiles -module load sutils -module load hpss - -module load cmake/3.20.1 -setenv CMAKE_C_COMPILER mpiicc -setenv CMAKE_CXX_COMPILER mpiicpc -setenv CMAKE_Fortran_COMPILER mpiifort -setenv CMAKE_Platform hera.intel - -module use /scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack -module load hpc/1.1.0 -module load hpc-intel/18.0.5.274 -module load hpc-impi/2018.0.4 - -module load jasper/2.0.22 -module load zlib/1.2.11 -module load png/1.6.35 - -module load hdf5/1.10.6 -module load netcdf/4.7.4 -module load pio/2.5.2 -module load esmf/8.3.0b09 -module load fms/2022.01 - -module load bacio/2.4.1 -module load crtm/2.3.0 -module load g2tmpl/1.10.0 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3emc/2.7.3 -module load w3nco/2.4.1 - -module load gftl-shared/v1.3.3 -module load yafyaml/v0.5.1 -module load mapl/2.11.0-esmf-8.3.0b09 - -module load g2/3.4.3 - -module load bufr/11.4.0 -module load gfsio/1.4.1 -module load landsfcutil/2.4.1 -module load nemsiogfs/2.5.3 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load szip/2.1.1 -module load wrf_io/1.1.1 - -module load prod_util/1.2.2 -module load grib_util/1.2.2 - -module load wgrib2/2.0.8 -setenv WGRIB2 /scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/intel-18.0.5.274/impi-2018.0.4/wgrib2/2.0.8/bin/wgrib2 - -module use /scratch2/NCEPDEV/nwprod/NCEPLIBS/modulefiles -module load nco/4.9.1 - -module use -a /scratch1/NCEPDEV/nems/emc.nemspara/soft/modulefiles -module load rocoto/1.3.3 - -module load intelpython/3.6.8 - -# For CDEPS data models: -module load cdo/1.9.10 diff --git a/modulefiles/modulefile.hafs.jet b/modulefiles/modulefile.hafs.jet deleted file mode 100644 index 2f84a9599..000000000 --- a/modulefiles/modulefile.hafs.jet +++ /dev/null @@ -1,70 +0,0 @@ -#%Module##################################################### -## Module file for hafs -############################################################# -proc ModulesHelp { } { - puts stderr "Set environment veriables for compiling or running HAFS" -} -module-whatis " HAFS model prerequisites" - -module use /contrib/sutils/modulefiles -module load sutils -module load hpss - -module load cmake/3.20.1 -setenv CMAKE_C_COMPILER mpiicc -setenv CMAKE_CXX_COMPILER mpiicpc -setenv CMAKE_Fortran_COMPILER mpiifort -setenv CMAKE_Platform jet.intel - -module use /lfs4/HFIP/hfv3gfs/nwprod/hpc-stack/libs/modulefiles/stack -module load hpc/1.1.0 -module load hpc-intel/18.0.5.274 -module load hpc-impi/2018.4.274 - -module load jasper/2.0.22 -module load zlib/1.2.11 -module load png/1.6.35 - -module load hdf5/1.10.6 -module load netcdf/4.7.4 -module load pio/2.5.2 -module load esmf/8.3.0b09 -module load fms/2022.01 - -module load bacio/2.4.1 -module load crtm/2.3.0 -module load g2tmpl/1.10.0 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3emc/2.7.3 -module load w3nco/2.4.1 - -module load gftl-shared/v1.3.3 -module load yafyaml/v0.5.1 -module load mapl/2.11.0-esmf-8.3.0b09 - -module load g2/3.4.3 - -module load bufr/11.4.0 -module load gfsio/1.4.1 -module load landsfcutil/2.4.1 -module load nemsiogfs/2.5.3 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load szip/2.1.1 -module load wrf_io/1.1.1 - -module load prod_util/1.2.2 -module load grib_util/1.2.2 - -module load wgrib2/2.0.8 -#setenv WGRIB2 /lfs4/HFIP/hfv3gfs/nwprod/hpc-stack/libs/intel-18.0.5.274/impi-2018.4.274/wgrib2/2.0.8/bin/wgrib2 -setenv WGRIB2 /apps/wgrib2/2.0.8/intel/18.0.5.274/bin/wgrib2 -module load nco/4.9.1 -module load rocoto/1.3.3 - -module load intelpython/3.6.5 - -# For CDEPS data models: -module load cdo diff --git a/modulefiles/modulefile.hafs.orion b/modulefiles/modulefile.hafs.orion deleted file mode 100644 index f87a1931f..000000000 --- a/modulefiles/modulefile.hafs.orion +++ /dev/null @@ -1,69 +0,0 @@ -#%Module##################################################### -## Module file for hafs -############################################################# -proc ModulesHelp { } { - puts stderr "Set environment veriables for compiling or running HAFS" -} -module-whatis " HAFS model prerequisites" - -module load contrib noaatools - -module load cmake/3.18.1 -setenv CMAKE_C_COMPILER mpiicc -setenv CMAKE_CXX_COMPILER mpiicpc -setenv CMAKE_Fortran_COMPILER mpiifort -setenv CMAKE_Platform orion.intel - -module use /apps/contrib/NCEP/libs/hpc-stack/modulefiles/stack -module load hpc/1.1.0 -module load hpc-intel/2018.4 -module load hpc-impi/2018.4 - -module load jasper/2.0.22 -module load zlib/1.2.11 -module load png/1.6.35 - -module load hdf5/1.10.6 -module load netcdf/4.7.4 -module load pio/2.5.2 -module load esmf/8.3.0b09 -module load fms/2022.01 - -module load bacio/2.4.1 -module load crtm/2.3.0 -module load g2tmpl/1.10.0 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3emc/2.7.3 -module load w3nco/2.4.1 - -module load gftl-shared/v1.3.3 -module load yafyaml/v0.5.1 -module load mapl/2.11.0-esmf-8.3.0b09 - -module load g2/3.4.3 - -module load bufr/11.4.0 -module load gfsio/1.4.1 -module load landsfcutil/2.4.1 -module load nemsiogfs/2.5.3 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load szip/2.1.1 -module load wrf_io/1.1.1 - -module load prod_util/1.2.2 -module load grib_util/1.2.2 - -module load wgrib2/2.0.8 -setenv WGRIB2 /apps/contrib/NCEP/libs/hpc-stack/intel-2018.4/impi-2018.4/wgrib2/2.0.8/bin/wgrib2 - -module load nco/4.9.3 - -module load rocoto/1.3.3 - -module load intelpython3/2020 - -# For CDEPS data models: -module load cdo diff --git a/modulefiles/modulefile.hafs.wcoss2 b/modulefiles/modulefile.hafs.wcoss2 deleted file mode 100644 index 97bf92ad2..000000000 --- a/modulefiles/modulefile.hafs.wcoss2 +++ /dev/null @@ -1,88 +0,0 @@ -#%Module##################################################### -## Biju.Thomas@noaa.gov -## NOAA NCEP EMC, IMSG contractor -## HAFS prerequisites for WCOSS2 -############################################################# -proc ModulesHelp { } { - puts stderr "Set environment veriables for compiling or running HAFS" -} -module-whatis " HAFS model prerequisites" - -# System and compiler prereqs: -module purge -module load envvar/1.0 -module load PrgEnv-intel/8.1.0 -module load intel/19.1.3.304 -module load craype/2.7.13 -module load cray-mpich/8.1.9 #might not be used with cfp/mpiserial -module load cray-mpich/8.1.7 -module load cray-pals/1.0.12 - -module load python/3.8.6 - -module load cmake/3.20.2 - -setenv HPC_OPT /apps/ops/para/libs -module use /apps/ops/para/libs/modulefiles/compiler/intel/19.1.3.304 -module use /apps/ops/para/libs/modulefiles/mpi/intel/19.1.3.304/cray-mpich/8.1.7 - -module load jasper/2.0.25 -module load zlib/1.2.11 -module load libpng/1.6.37 -module load libjpeg/9c -setenv JPEG_LIBRARIES /apps/spack/libjpeg/9c/intel/19.1.3.304/jkr3isi257ktoouprwaxcn4twtye747z/lib -module load hdf5/1.10.6 -module load netcdf/4.7.4 -module load pio/2.5.2 -module load esmf/8.3.0b09 -module load fms/2022.01 - -module load bacio/2.4.1 -module load crtm/2.3.0 -module load g2tmpl/1.10.0 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3emc/2.9.1 -module load w3nco/2.4.1 - -#module load gftl-shared/v1.3.3 -#module load yafyaml/v0.5.1 -#module load mapl/2.11.0-esmf-8.3.0b09 - -module load g2c/1.6.4 -module load g2/3.4.5 - -module load bufr/11.6.0 -module load gfsio/1.4.1 -module load landsfcutil/2.4.1 -module load nemsiogfs/2.5.3 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load szip/2.1.1 -module load wrf_io/1.2.0 - -module load prod_util/2.0.13 -module load grib_util/1.2.4 - -#module load wgrib2/2.0.8 -#setenv WGRIB2 /apps/ops/prod/libs/intel/19.1.3.304/wgrib2/2.0.8_wmo/bin/wgrib2 -module load wgrib2/2.0.8_wmo -#module load HPSS/5.0.2.5 -module load cfp/2.0.4 -#module load prod_envir/1.0.3 - -module load gsl/2.7 -module load udunits/2.2.28 -module load nco/4.7.9 - -setenv CMAKE_C_COMPILER cc -setenv CMAKE_CXX_COMPILER CC -setenv CMAKE_Fortran_COMPILER ftn -setenv CMAKE_Platform wcoss2 - -module use /apps/ops/test/nco/modulefiles/ -module load core/rocoto/1.3.4 - -# For CDEPS data models: -module load cdo/1.9.8 diff --git a/modulefiles/modulefile.hafs.wcoss_cray b/modulefiles/modulefile.hafs.wcoss_cray deleted file mode 100644 index 4104e9848..000000000 --- a/modulefiles/modulefile.hafs.wcoss_cray +++ /dev/null @@ -1,92 +0,0 @@ -#%Module##################################################### -## Module file for hafs -############################################################# -proc ModulesHelp { } { - puts stderr "Set environment veriables for compiling or running HAFS" -} -module-whatis " HAFS model prerequisites" - -module load PrgEnv-intel -module rm intel -module load intel/18.1.163 -module rm NetCDF-intel-sandybridge/4.2 -module load xt-lsfhpc/9.1.3 -module load craype-haswell -#module load python/3.6.3 - -module load hpss/4.1.0.3 -module load cfp-intel-sandybridge/2.0.1 -module load cray-mpich/7.2.0 - -module load cmake/3.16.2 -module load gcc/5.3.0 -# -module use /usrx/local/dev/modulefiles -module load HDF5-parallel-intel-sandybridge/1.10.6 -module load NetCDF-intel-sandybridge/4.7.4 - -module load jasper-gnu-sandybridge/1.900.1 -setenv Jasper_ROOT /usrx/local/prod/jasper/1.900.1/gnu/sandybridge -module load zlib-intel-sandybridge/1.2.7 -module load png-intel-sandybridge/1.2.49 -setenv PNG_ROOT /usrx/local/prod//png/1.2.49/intel/sandybridge - -module use /usrx/local/nceplibs/NCEPLIBS/cmake/install/NCEPLIBS-v1.3.0/modules -module load pio/2.5.2 -module load bacio/2.4.1 -module load crtm/2.3.0 -module load g2tmpl/1.10.0 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3emc/2.7.3 -module load w3nco/2.4.1 - -module load g2/3.4.3 - -module load bufr/11.4.0 -module load gfsio/1.4.1 -module load landsfcutil/2.4.1 -module load nemsiogfs/2.5.3 -module load sfcio/1.4.1 -module load sigio/2.3.2 -#module load szip/2.1.1 -module load wrf_io/1.1.1 - -#module load prod_util/1.2.2 -#module load grib_util/1.2.2 - -module load wgrib2/2.0.8 -#doesn't work setenv WGRIB2 /usrx/local/nceplibs/NCEPLIBS/cmake/install/NCEPLIBS-v1.3.0/wgrib2/wgrib2-2.0.8/bin/wgrib2 - -module load esmf/8.3.0b09 -module load fms/2022.01 - -## WCOSS Cray execution prereqs: -module load rca -module load alps -module load xpmem -module load gni-headers -module load udreg -module load ugni -module swap pmi pmi/5.0.11 - -module use /gpfs/hps/nco/ops/nwprod/modulefiles -module load grib_util/1.1.0 -module load prod_util/1.1.3 - -module load nco-gnu-sandybridge/4.4.4 - -module use /usrx/local/emc_rocoto/modulefiles -module load rocoto/1.3.0rc2 - -module load intelpython/3.6.8 - -setenv WGRIB2 /gpfs/hps3/emc/hwrf/noscrub/emc.hurpara/local/bin/wgrib2.v2.0.8b9 -## -## load cmake -## -setenv CMAKE_C_COMPILER cc -setenv CMAKE_CXX_COMPILER CC -setenv CMAKE_Fortran_COMPILER ftn -setenv CMAKE_Platform wcoss_cray diff --git a/modulefiles/modulefile.hafs.wcoss_dell_p3 b/modulefiles/modulefile.hafs.wcoss_dell_p3 deleted file mode 100644 index 5da908bd4..000000000 --- a/modulefiles/modulefile.hafs.wcoss_dell_p3 +++ /dev/null @@ -1,77 +0,0 @@ -#%Module##################################################### -## Module file for hafs -############################################################# -proc ModulesHelp { } { - puts stderr "Set environment veriables for compiling or running HAFS" -} -module-whatis " HAFS model prerequisites" - -module load ips/18.0.5.274 -module load impi/18.0.1 -module load lsf/10.1 -module load python/3.6.3 - -module use /usrx/local/nceplibs/dev/hpc-stack/libs/hpc-stack/modulefiles/stack - -module load hpc/1.1.0 -module load cmake/3.20.0 -module load hpc-ips/18.0.5.274 -module load hpc-impi/18.0.1 - -module load jasper/2.0.25 -module load zlib/1.2.11 -module load png/1.6.35 - -module load hdf5/1.10.6 -module load netcdf/4.7.4 -module load pio/2.5.2 -module load esmf/8.3.0b09 -module load fms/2022.01 - -module load bacio/2.4.1 -module load crtm/2.3.0 -module load g2tmpl/1.10.0 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3emc/2.7.3 -module load w3nco/2.4.1 - -module load gftl-shared/v1.3.3 -module load yafyaml/v0.5.1 -module load mapl/2.11.0-esmf-8.3.0b09 - -module load g2/3.4.3 - -module load bufr/11.6.0 -module load gfsio/1.4.1 -module load landsfcutil/2.4.1 -module load nemsiogfs/2.5.3 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load szip/2.1.1 -module load wrf_io/1.2.0 - -module load prod_util/1.2.2 -module load grib_util/1.2.2 - -module load wgrib2/2.0.8 -setenv WGRIB2 /gpfs/dell2/usrx/local/nceplibs/dev/hpc-stack/libs/hpc-stack/ips-18.0.1.163/impi-18.0.1/wgrib2/2.0.8/bin/wgrib2 - -module load HPSS/5.0.2.5 -module load CFP/2.0.1 -#module load prod_envir/1.0.3 - -module load NCO/4.7.0 - -setenv CMAKE_C_COMPILER mpiicc -setenv CMAKE_CXX_COMPILER mpiicpc -setenv CMAKE_Fortran_COMPILER mpiifort -setenv CMAKE_Platform wcoss_dell_p3 - -module use /usrx/local/dev/emc_rocoto/modulefiles -module load ruby/2.5.1 -module load rocoto/1.3.0rc2 - -# For CDEPS data models: -module load cdo diff --git a/parm/analysis/gsi/gsiparm.anl.tmp b/parm/analysis/gsi/gsiparm.anl.tmp index a44b0733c..ee4e570da 100644 --- a/parm/analysis/gsi/gsiparm.anl.tmp +++ b/parm/analysis/gsi/gsiparm.anl.tmp @@ -167,7 +167,7 @@ OBS_INPUT:: ahibufr ahi himawari8 ahi_himawari8 0.0 3 0 :: &SUPEROB_RADAR - del_azimuth=5.,del_elev=.25,del_range=10000.,del_time=.1,elev_angle_max=5.,minnum=1,range_max=100000., + del_azimuth=5.,del_elev=.25,del_range=10000.,del_time=1.0,elev_angle_max=5.,minnum=1,range_max=200000., l2superob_only=.false.,radar_sites=.false., radar_box=.true.,radar_rmesh=10,radar_zmesh=500, / diff --git a/parm/forecast/globnest/diag_table.tmp b/parm/forecast/globnest/diag_table.tmp index 05ab3afff..421304289 100644 --- a/parm/forecast/globnest/diag_table.tmp +++ b/parm/forecast/globnest/diag_table.tmp @@ -211,8 +211,11 @@ ufs.hafs "gfs_phys", "USWRF", "uswrf_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "USWRFI", "uswrf", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "DSWRFtoa", "dswrf_avetoa","fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "DSWRFItoa", "dswrf_toa", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "USWRFtoa", "uswrf_avetoa","fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "USWRFItoa", "uswrf_toa", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "ULWRFtoa", "ulwrf_avetoa","fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "ULWRFItoa", "ulwrf_toa", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "gflux_ave", "gflux_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "hpbl", "hpbl", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "lhtfl_ave", "lhtfl_ave", "fv3_history2d", "all", .false., "none", 2 @@ -239,7 +242,9 @@ ufs.hafs "gfs_phys", "u-gwd_ave", "u-gwd_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "v-gwd_ave", "v-gwd_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "dusfc", "uflx_ave", "fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "dusfci", "uflx", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "dvsfc", "vflx_ave", "fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "dvsfci", "vflx", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "psurf", "pressfc", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "u10m", "ugrd10m", "fv3_history2d", "all", .false., "none", 2 diff --git a/parm/forecast/globnest/input.nml.tmp b/parm/forecast/globnest/input.nml.tmp index 3e7e6f5d5..fdd5bdb3e 100644 --- a/parm/forecast/globnest/input.nml.tmp +++ b/parm/forecast/globnest/input.nml.tmp @@ -53,11 +53,14 @@ fv_debug = .false. range_warn = .true. reset_eta = .false. + upoff = 2 n_sponge = 24 nudge_qv = .false. nudge_dz = .false. tau = 5. rf_cutoff = 30.e2 + sg_cutoff = -1. + rf_fast = .false. d2_bg_k1 = 0.16 d2_bg_k2 = 0.05 kord_tm = -9 @@ -83,6 +86,7 @@ d4_bg = 0.15 vtdm4 = 0.04 delt_max = 0.002 + dz_min = 2.0 ke_bg = 0. do_vort_damp = .true. external_ic = @[external_ic] diff --git a/parm/forecast/globnest/input_nest.nml.tmp b/parm/forecast/globnest/input_nest.nml.tmp index b20b0852d..36c83663a 100644 --- a/parm/forecast/globnest/input_nest.nml.tmp +++ b/parm/forecast/globnest/input_nest.nml.tmp @@ -53,11 +53,14 @@ fv_debug = .false. range_warn = .true. reset_eta = .false. + upoff = 2 n_sponge = 24 nudge_qv = .false. nudge_dz = .false. tau = 5. rf_cutoff = 50.e2 + sg_cutoff = -1. + rf_fast = .false. d2_bg_k1 = 0.20 d2_bg_k2 = 0.15 kord_tm = -11 @@ -83,6 +86,7 @@ d4_bg = 0.15 vtdm4 = 0.04 delt_max = 0.008 + dz_min = 2.0 ke_bg = 0. do_vort_damp = .true. external_ic = @[external_ic] diff --git a/parm/forecast/regional/diag_table.tmp b/parm/forecast/regional/diag_table.tmp index 05ab3afff..421304289 100644 --- a/parm/forecast/regional/diag_table.tmp +++ b/parm/forecast/regional/diag_table.tmp @@ -211,8 +211,11 @@ ufs.hafs "gfs_phys", "USWRF", "uswrf_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "USWRFI", "uswrf", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "DSWRFtoa", "dswrf_avetoa","fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "DSWRFItoa", "dswrf_toa", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "USWRFtoa", "uswrf_avetoa","fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "USWRFItoa", "uswrf_toa", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "ULWRFtoa", "ulwrf_avetoa","fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "ULWRFItoa", "ulwrf_toa", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "gflux_ave", "gflux_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "hpbl", "hpbl", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "lhtfl_ave", "lhtfl_ave", "fv3_history2d", "all", .false., "none", 2 @@ -239,7 +242,9 @@ ufs.hafs "gfs_phys", "u-gwd_ave", "u-gwd_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "v-gwd_ave", "v-gwd_ave", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "dusfc", "uflx_ave", "fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "dusfci", "uflx", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "dvsfc", "vflx_ave", "fv3_history2d", "all", .false., "none", 2 +"gfs_phys", "dvsfci", "vflx", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "psurf", "pressfc", "fv3_history2d", "all", .false., "none", 2 "gfs_phys", "u10m", "ugrd10m", "fv3_history2d", "all", .false., "none", 2 diff --git a/parm/forecast/regional/input.nml.tmp b/parm/forecast/regional/input.nml.tmp index 8ed3fbc27..2249b7198 100644 --- a/parm/forecast/regional/input.nml.tmp +++ b/parm/forecast/regional/input.nml.tmp @@ -53,11 +53,14 @@ fv_debug = .false. range_warn = .true. reset_eta = .false. + upoff = 2 n_sponge = 24 nudge_qv = .false. nudge_dz = .false. tau = 5. rf_cutoff = 50.e2 + sg_cutoff = -1. + rf_fast = .false. d2_bg_k1 = 0.20 d2_bg_k2 = 0.15 kord_tm = -11 @@ -83,6 +86,7 @@ d4_bg = 0.15 vtdm4 = 0.04 delt_max = 0.008 + dz_min = 2.0 ke_bg = 0. do_vort_damp = .true. external_ic = @[external_ic] @@ -119,6 +123,7 @@ regional = .true. bc_update_interval = @[bc_update_interval] nrows_blend = @[nrows_blend] + psm_bc = 1 full_zs_filter = @[full_zs_filter_nml] n_zs_filter = @[n_zs_filter_nml] diff --git a/parm/forecast/regional/input_nest.nml.tmp b/parm/forecast/regional/input_nest.nml.tmp index b20b0852d..36c83663a 100644 --- a/parm/forecast/regional/input_nest.nml.tmp +++ b/parm/forecast/regional/input_nest.nml.tmp @@ -53,11 +53,14 @@ fv_debug = .false. range_warn = .true. reset_eta = .false. + upoff = 2 n_sponge = 24 nudge_qv = .false. nudge_dz = .false. tau = 5. rf_cutoff = 50.e2 + sg_cutoff = -1. + rf_fast = .false. d2_bg_k1 = 0.20 d2_bg_k2 = 0.15 kord_tm = -11 @@ -83,6 +86,7 @@ d4_bg = 0.15 vtdm4 = 0.04 delt_max = 0.008 + dz_min = 2.0 ke_bg = 0. do_vort_damp = .true. external_ic = @[external_ic] diff --git a/parm/forecast/regional/nems.configure.cpl.tmp b/parm/forecast/regional/nems.configure.cpl.tmp index 3d2774ac4..6afcba475 100644 --- a/parm/forecast/regional/nems.configure.cpl.tmp +++ b/parm/forecast/regional/nems.configure.cpl.tmp @@ -73,6 +73,7 @@ ALLCOMP_attributes:: ATM_attributes:: Verbosity = 1 Diagnostic = 0 + mesh_atm = _mesh_atm_ stop_n = _end_hour_ stop_option = nhours stop_ymd = -999 @@ -110,8 +111,8 @@ WAV_attributes:: Diagnostic = 0 OverwriteSlice = false merge_import = .true. - mask_value_water = 1 - mask_value_land = 0 + mesh_wav = _mesh_wav_ + multigrid = _multigrid_ :: # The following are only used by the hycom ocean model. # diff --git a/parm/hafs.conf b/parm/hafs.conf index 99ff207ca..14952779c 100644 --- a/parm/hafs.conf +++ b/parm/hafs.conf @@ -203,6 +203,14 @@ jend_nest=1307 halo=3 ;; halo size to be used in the atmosphere cubic sphere model for the grid tile. halop1=4 ;; halo size that will be used for the orography and grid tile in chgres halo0=0 ;; no halo, used to shave the filtered orography for use in the model +# Regional ESG grid related options +regional_esg=no ;; Use regional ESG grid, yes, or no +idim_nest=1320 +jdim_nest=1320 +delx_nest=0.03 +dely_nest=0.03 +halop2=5 +pazi=-180. [grid_mvnest1res] CASE_mvnest1res=C1536 @@ -220,6 +228,12 @@ istart_nest_mvnest1res=97 jstart_nest_mvnest1res=97 iend_nest_mvnest1res=2976 jend_nest_mvnest1res=2976 +regional_esg_mvnest1res={grid/regional_esg} +idim_nest_mvnest1res=3960 +jdim_nest_mvnest1res=3960 +delx_nest_mvnest1res=0.01 +dely_nest_mvnest1res=0.01 +halop2_mvnest1res=15 [grid_ens] CASE_ENS={grid/CASE} ;; FV3 resolution @@ -235,6 +249,12 @@ istart_nest_ens={grid/istart_nest} jstart_nest_ens={grid/jstart_nest} iend_nest_ens={grid/iend_nest} jend_nest_ens={grid/jend_nest} +regional_esg_ens={grid/regional_esg} +idim_nest_ens={grid/idim_nest} +jdim_nest_ens={grid/jdim_nest} +delx_nest_ens={grid/delx_nest} +dely_nest_ens={grid/dely_nest} +halop2_ens={grid/halop2} [input] @@ -287,6 +307,7 @@ ww3_rst = yes ;; Option controlling how to use initial wa grid_gnh_10m_inp = {PARMww3}/ww3_grid_gnh_10m.inp grid_inp = {PARMww3}/ww3_grid_{vit[basin1lc]}.inp +grid_mesh = {FIXww3}/ww3_mesh_{vit[basin1lc]}.nc grid_bot = {FIXww3}/ww3_grid_{vit[basin1lc]}.bot grid_msk = {FIXww3}/ww3_grid_{vit[basin1lc]}.msk grid_msk2 = {FIXww3}/ww3_grid_{vit[basin1lc]}.msk2 diff --git a/parm/hafs_basic.conf b/parm/hafs_basic.conf index 4c7b27c79..c954835f3 100644 --- a/parm/hafs_basic.conf +++ b/parm/hafs_basic.conf @@ -11,6 +11,11 @@ EXPT=HAFS # domlat=25.0 # domlon=-75.3 +# If domlon and domlat are not set, where to put the parent domain center? +# storm: centered at current storm center according to tcvitals +# auto: automatically determined based on storm's current and 72-h forecast locations +parent_domain_center=storm + ## The storm label: storm1, storm2, etc. stormlabel=storm{storm_num} # Useful when running multiple storms in a workflow. @@ -36,6 +41,7 @@ bctype_ens=gfsnetcdf ;; Input boundary condition type for ensembles: gfsnetcdf, vcoord_file_target_grid={PARMhafs}/levels/hafs_hyblev.l{LEVS}.txt ;; Vertical level distributions with ak, bk values halo_blend=10 ;; Number of rows for lateral boundary blending for the regional configuration +use_orog_gsl=no ;; Use gsl orography files or not # Enable or disable parts of the workflow run_atm_mvnest=no diff --git a/parm/hafs_holdvars.conf b/parm/hafs_holdvars.conf index 5eec2758c..634267115 100644 --- a/parm/hafs_holdvars.conf +++ b/parm/hafs_holdvars.conf @@ -80,6 +80,13 @@ jend_nest={grid/jend_nest} halo={grid/halo} halop1={grid/halop1} halo0={grid/halo0} +regional_esg={grid/regional_esg} +idim_nest={grid/idim_nest} +jdim_nest={grid/jdim_nest} +delx_nest={grid/delx_nest} +dely_nest={grid/dely_nest} +halop2={grid/halop2} +pazi={grid/pazi} # moving nest related items CASE_mvnest1res={grid_mvnest1res/CASE_mvnest1res} @@ -97,6 +104,12 @@ istart_nest_mvnest1res={grid_mvnest1res/istart_nest_mvnest1res} jstart_nest_mvnest1res={grid_mvnest1res/jstart_nest_mvnest1res} iend_nest_mvnest1res={grid_mvnest1res/iend_nest_mvnest1res} jend_nest_mvnest1res={grid_mvnest1res/jend_nest_mvnest1res} +regional_esg_mvnest1res={grid_mvnest1res/regional_esg_mvnest1res} +idim_nest_mvnest1res={grid_mvnest1res/idim_nest_mvnest1res} +jdim_nest_mvnest1res={grid_mvnest1res/jdim_nest_mvnest1res} +delx_nest_mvnest1res={grid_mvnest1res/delx_nest_mvnest1res} +dely_nest_mvnest1res={grid_mvnest1res/dely_nest_mvnest1res} +halop2_mvnest1res={grid_mvnest1res/halop2_mvnest1res} is_moving_nest={forecast/is_moving_nest} vortex_tracker={forecast/vortex_tracker} @@ -224,6 +237,12 @@ istart_nest_ens={grid_ens/istart_nest_ens} jstart_nest_ens={grid_ens/jstart_nest_ens} iend_nest_ens={grid_ens/iend_nest_ens} jend_nest_ens={grid_ens/jend_nest_ens} +regional_esg_ens={grid_ens/regional_esg_ens} +idim_nest_ens={grid_ens/idim_nest_ens} +jdim_nest_ens={grid_ens/jdim_nest_ens} +delx_nest_ens={grid_ens/delx_nest_ens} +dely_nest_ens={grid_ens/dely_nest_ens} +halop2_ens={grid_ens/halop2_ens} ccpp_suite_regional_ens={forecast_ens/ccpp_suite_regional_ens} ccpp_suite_glob_ens={forecast_ens/ccpp_suite_glob_ens} diff --git a/parm/hafs_holdvars.txt b/parm/hafs_holdvars.txt index c3b8e2611..a6dba6538 100644 --- a/parm/hafs_holdvars.txt +++ b/parm/hafs_holdvars.txt @@ -106,6 +106,7 @@ export bctype={bctype} export ictype_ens={ictype_ens} export bctype_ens={bctype_ens} export halo_blend={halo_blend} +export use_orog_gsl={use_orog_gsl} export CASE={CASE} export LEVS={LEVS} @@ -125,6 +126,13 @@ export jend_nest={jend_nest} export halo={halo} export halop1={halop1} export halo0={halo0} +export regional_esg={regional_esg} +export idim_nest={idim_nest} +export jdim_nest={jdim_nest} +export delx_nest={delx_nest} +export dely_nest={dely_nest} +export halop2={halop2} +export pazi={pazi} export CASE_mvnest1res={CASE_mvnest1res} export LEVS_mvnest1res={LEVS_mvnest1res} @@ -141,6 +149,12 @@ export istart_nest_mvnest1res={istart_nest_mvnest1res} export jstart_nest_mvnest1res={jstart_nest_mvnest1res} export iend_nest_mvnest1res={iend_nest_mvnest1res} export jend_nest_mvnest1res={jend_nest_mvnest1res} +export regional_esg_mvnest1res={regional_esg_mvnest1res} +export idim_nest_mvnest1res={idim_nest_mvnest1res} +export jdim_nest_mvnest1res={jdim_nest_mvnest1res} +export delx_nest_mvnest1res={delx_nest_mvnest1res} +export dely_nest_mvnest1res={dely_nest_mvnest1res} +export halop2_mvnest1res={halop2_mvnest1res} export is_moving_nest={is_moving_nest} export vortex_tracker={vortex_tracker} @@ -278,6 +292,12 @@ export istart_nest_ens={istart_nest_ens} export jstart_nest_ens={jstart_nest_ens} export iend_nest_ens={iend_nest_ens} export jend_nest_ens={jend_nest_ens} +export regional_esg_ens={regional_esg_ens} +export idim_nest_ens={idim_nest_ens} +export jdim_nest_ens={jdim_nest_ens} +export delx_nest_ens={delx_nest_ens} +export dely_nest_ens={dely_nest_ens} +export halop2_ens={halop2_ens} export ccpp_suite_regional_ens={ccpp_suite_regional_ens} export ccpp_suite_glob_ens={ccpp_suite_glob_ens} export ccpp_suite_nest_ens={ccpp_suite_nest_ens} diff --git a/parm/hafsv0p2aL81_phase3_AL.conf b/parm/hafsv0p2aL81_phase3_AL.conf deleted file mode 100644 index 79a2fbc07..000000000 --- a/parm/hafsv0p2aL81_phase3_AL.conf +++ /dev/null @@ -1,72 +0,0 @@ -# This is a UNIX conf file that contains ALL information relating to -# the HAFS basin-focused standalone regional configuration. -# -[config] -# Specify the domain center Latitude and Longitude -domlat=25.0 -domlon=-62.0 -# Same as domlat and domlon but vitals formatted -vitalsdomlat=250N -vitalsdomlon=620W - -# HAFS launcher requires vitals and a storm. -# This is a default minimum vitals file for a fake storm. -# The format of the missing value fields was based on the log -# output returned when running the launcher after the vitals have -# been "cleaned" up. That is, if you enter the fields as all -999 values, -# the "cleaned" output is returned. In essence I'm treating the vitals -# module as a factory in the sense that it knows the correct format. -# NHC 00L FAKE 20120710 0000 250N 0800W -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M -# fakestormid is a config option set in the launcher and is the -# last storm id in the list of storms. -fakestormid=00L -fakestormname=NATL -fakestormorg=NHC -fakestorm_vitals={fakestormorg} {fakestormid} {fakestormname} {YMD} {HH}{min} {vitalsdomlat} {vitalsdomlon} -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M - -[dir] -PARMforecast={PARMhafs}/forecast/regional - -[grid] -CASE=C3089 ;; FV3 resolution -LEVS=82 ;; Model vertical levels: 65, 128, 76, 86, and 97 -gtype=regional ;; grid type: uniform, stretch, nest, or regional -# If gridfixdir is provided and the dir exists, then use the pre-generated static grid fix files under gridfixdir -#gridfixdir=/let/hafs_grid/generate/grid -gridfixdir={HOMEhafs}/fix/fix_fv3/ESG_C3089_62W25N_3120x2160 -# Otherwise, will generate the model grid according to the following grid parameters -# Need for grid types: stretch, nest and regional -stretch_fac=1.0001 ;; Stretching factor for the grid -target_lon={domlon} ;; center longitude of the highest resolution tile -target_lat={domlat} ;; center latitude of the highest resolution tile -# Need for grid types: nest and regional -refine_ratio=4 ;; Specify the refinement ratio for nest grid -istart_nest=46 -jstart_nest=168 -iend_nest=1485 -jend_nest=1367 - -[forecast] -k_split=3 -n_split=5 -layoutx=40 -layouty=30 -npx=3121 -npy=2161 -npz=81 - -restart_interval="240" ;; restart interval in hours for the forecast - -write_dopost=.true. -output_history=.false. - -output_grid=regional_latlon -output_grid_cen_lon=-62.0 ;; central longitude -output_grid_cen_lat=25.8 ;; central latitude -output_grid_lon_span=109.5 ;; output domain span for longitude in regular latlon coordinate system (in degrees) -output_grid_lat_span=63.6 ;; output domain span for latitude in regular latlon coordinate system (in degrees) -output_grid_dlon=0.03 ;; output grid spacing dlon . . . . -output_grid_dlat=0.03 ;; output grid spacing dlat . . . . - -[rocotostr] -FORECAST_RESOURCES=FORECAST_RESOURCES_regional_{forecast/layoutx}x{forecast/layouty}io{forecast/write_groups}x{forecast/write_tasks_per_group}_omp2 diff --git a/parm/hafsv0p2a_da_AL.conf b/parm/hafsv0p2a_da_AL.conf deleted file mode 100644 index f1c62b255..000000000 --- a/parm/hafsv0p2a_da_AL.conf +++ /dev/null @@ -1,103 +0,0 @@ -# This is a UNIX conf file that contains ALL information relating to -# the HAFS basin-focused standalone regional configuration. -# -[config] -# Specify the domain center Latitude and Longitude -domlat=24.0 -domlon=-62.0 -# Same as domlat and domlon but vitals formatted -vitalsdomlat=240N -vitalsdomlon=620W - -# HAFS launcher requires vitals and a storm. -# This is a default minimum vitals file for a fake storm. -# The format of the missing value fields was based on the log -# output returned when running the launcher after the vitals have -# been "cleaned" up. That is, if you enter the fields as all -999 values, -# the "cleaned" output is returned. In essence I'm treating the vitals -# module as a factory in the sense that it knows the correct format. -# NHC 00L FAKE 20120710 0000 250N 0800W -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M -# fakestormid is a config option set in the launcher and is the -# last storm id in the list of storms. -fakestormid=00L -fakestormname=NATL -fakestormorg=NHC -fakestorm_vitals={fakestormorg} {fakestormid} {fakestormname} {YMD} {HH}{min} {vitalsdomlat} {vitalsdomlon} -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M - -# Dual-resolution ensemble members -GRID_RATIO_ENS=2 - -[dir] -PARMforecast={PARMhafs}/forecast/regional - -[grid] -CASE=C3099 ;; FV3 resolution -LEVS=92 ;; Model vertical levels: 65, 128, 76, 86, and 97 -gtype=regional ;; grid type: uniform, stretch, nest, or regional -# If gridfixdir is provided and the dir exists, then use the pre-generated static grid fix files under gridfixdir -#gridfixdir=/let/hafs_grid/generate/grid -gridfixdir={HOMEhafs}/fix/fix_fv3/ESG_C3099_62W24N_3120x2400 -# Otherwise, will generate the model grid according to the following grid parameters -# Need for grid types: stretch, nest and regional -stretch_fac=1.0001 ;; Stretching factor for the grid -target_lon={domlon} ;; center longitude of the highest resolution tile -target_lat={domlat} ;; center latitude of the highest resolution tile -# Need for grid types: nest and regional -refine_ratio=4 ;; Specify the refinement ratio for nest grid -istart_nest=46 -jstart_nest=168 -iend_nest=1485 -jend_nest=1367 - -[grid_ens] -CASE_ENS=C1550 ;; FV3 resolution -LEVS_ENS=92 ;; Model vertical levels: 65 -gtype_ens=regional ;; grid type: uniform, stretch, nest, or regional -#gridfixdir_ens=/let/hafs_grid/generate/grid_ens -gridfixdir_ens={HOMEhafs}/fix/fix_fv3/ESG_C1550_62W24N_1560x1200 -stretch_fac_ens=1.0001 ;; Stretching factor for the grid -target_lon_ens={domlon} ;; center longitude of the highest resolution tile -target_lat_ens={domlat} ;; center latitude of the highest resolution tile -refine_ratio_ens=2 ;; Specify the refinement ratio for nest grid -istart_nest_ens=46 -jstart_nest_ens=168 -iend_nest_ens=1485 -jend_nest_ens=1376 - - -[forecast] -k_split=3 -n_split=5 -layoutx=48 -layouty=30 -npx=3121 -npy=2401 -npz=91 - -restart_interval="3 6 9" ;; restart interval in hours for the forecast - -output_grid=regional_latlon -output_grid_cen_lon=-62.0 ;; central longitude -output_grid_cen_lat=24.00 ;; central latitude -output_grid_lon_span=109.5 ;; output domain span for longitude in regular latlon coordinate system (in degrees) -output_grid_lat_span=71.7 ;; output domain span for latitude in regular latlon coordinate system (in degrees) -output_grid_dlon=0.03 ;; output grid spacing dlon . . . . -output_grid_dlat=0.03 ;; output grid spacing dlat . . . . - -[forecast_ens] -k_split_ens=2 -n_split_ens=5 -layoutx_ens=20 -layouty_ens=15 -npx_ens=1561 -npy_ens=1201 -npz_ens=91 - -restart_interval_ens="6 12" ;; restart interval in hours for the ensda member forecast -# place holder not yet working, currently using the same output grid as the deterministic forecast -output_grid_dlon_ens=0.06 ;; output grid spacing dlon . . . . -output_grid_dlat_ens=0.06 ;; output grid spacing dlat . . . . - -[rocotostr] -FORECAST_RESOURCES=FORECAST_RESOURCES_regional_{forecast/layoutx}x{forecast/layouty}io{forecast/write_groups}x{forecast/write_tasks_per_group}_omp2 -FORECAST_ENS_RESOURCES=FORECAST_ENS_RESOURCES_regional_{forecast_ens/layoutx_ens}x{forecast_ens/layouty_ens}io{forecast_ens/write_groups_ens}x{forecast_ens/write_tasks_per_group_ens}_omp2 diff --git a/parm/hafsv0p2a_phase3_AL.conf b/parm/hafsv0p2a_phase3_AL.conf deleted file mode 100644 index e4f809c56..000000000 --- a/parm/hafsv0p2a_phase3_AL.conf +++ /dev/null @@ -1,72 +0,0 @@ -# This is a UNIX conf file that contains ALL information relating to -# the HAFS basin-focused standalone regional configuration. -# -[config] -# Specify the domain center Latitude and Longitude -domlat=25.0 -domlon=-62.0 -# Same as domlat and domlon but vitals formatted -vitalsdomlat=250N -vitalsdomlon=620W - -# HAFS launcher requires vitals and a storm. -# This is a default minimum vitals file for a fake storm. -# The format of the missing value fields was based on the log -# output returned when running the launcher after the vitals have -# been "cleaned" up. That is, if you enter the fields as all -999 values, -# the "cleaned" output is returned. In essence I'm treating the vitals -# module as a factory in the sense that it knows the correct format. -# NHC 00L FAKE 20120710 0000 250N 0800W -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M -# fakestormid is a config option set in the launcher and is the -# last storm id in the list of storms. -fakestormid=00L -fakestormname=NATL -fakestormorg=NHC -fakestorm_vitals={fakestormorg} {fakestormid} {fakestormname} {YMD} {HH}{min} {vitalsdomlat} {vitalsdomlon} -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M - -[dir] -PARMforecast={PARMhafs}/forecast/regional - -[grid] -CASE=C3089 ;; FV3 resolution -LEVS=92 ;; Model vertical levels: 65, 128, 76, 86, and 97 -gtype=regional ;; grid type: uniform, stretch, nest, or regional -# If gridfixdir is provided and the dir exists, then use the pre-generated static grid fix files under gridfixdir -#gridfixdir=/let/hafs_grid/generate/grid -gridfixdir={HOMEhafs}/fix/fix_fv3/ESG_C3089_62W25N_3120x2160 -# Otherwise, will generate the model grid according to the following grid parameters -# Need for grid types: stretch, nest and regional -stretch_fac=1.0001 ;; Stretching factor for the grid -target_lon={domlon} ;; center longitude of the highest resolution tile -target_lat={domlat} ;; center latitude of the highest resolution tile -# Need for grid types: nest and regional -refine_ratio=4 ;; Specify the refinement ratio for nest grid -istart_nest=46 -jstart_nest=168 -iend_nest=1485 -jend_nest=1367 - -[forecast] -k_split=3 -n_split=5 -layoutx=40 -layouty=30 -npx=3121 -npy=2161 -npz=91 - -restart_interval="240" ;; restart interval in hours for the forecast - -write_dopost=.true. -output_history=.false. - -output_grid=regional_latlon -output_grid_cen_lon=-62.0 ;; central longitude -output_grid_cen_lat=25.8 ;; central latitude -output_grid_lon_span=109.5 ;; output domain span for longitude in regular latlon coordinate system (in degrees) -output_grid_lat_span=63.6 ;; output domain span for latitude in regular latlon coordinate system (in degrees) -output_grid_dlon=0.03 ;; output grid spacing dlon . . . . -output_grid_dlat=0.03 ;; output grid spacing dlat . . . . - -[rocotostr] -FORECAST_RESOURCES=FORECAST_RESOURCES_regional_{forecast/layoutx}x{forecast/layouty}io{forecast/write_groups}x{forecast/write_tasks_per_group}_omp2 diff --git a/parm/hafsv0p2a_phase3_da_AL.conf b/parm/hafsv0p2a_phase3_da_AL.conf deleted file mode 100644 index 6d22d5041..000000000 --- a/parm/hafsv0p2a_phase3_da_AL.conf +++ /dev/null @@ -1,105 +0,0 @@ -# This is a UNIX conf file that contains ALL information relating to -# the HAFS basin-focused standalone regional configuration. -# -[config] -# Specify the domain center Latitude and Longitude -domlat=25.0 -domlon=-62.0 -# Same as domlat and domlon but vitals formatted -vitalsdomlat=250N -vitalsdomlon=620W - -# HAFS launcher requires vitals and a storm. -# This is a default minimum vitals file for a fake storm. -# The format of the missing value fields was based on the log -# output returned when running the launcher after the vitals have -# been "cleaned" up. That is, if you enter the fields as all -999 values, -# the "cleaned" output is returned. In essence I'm treating the vitals -# module as a factory in the sense that it knows the correct format. -# NHC 00L FAKE 20120710 0000 250N 0800W -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M -# fakestormid is a config option set in the launcher and is the -# last storm id in the list of storms. -fakestormid=00L -fakestormname=NATL -fakestormorg=NHC -fakestorm_vitals={fakestormorg} {fakestormid} {fakestormname} {YMD} {HH}{min} {vitalsdomlat} {vitalsdomlon} -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M - -# Dual-resolution ensemble members -GRID_RATIO_ENS=2 - -[dir] -PARMforecast={PARMhafs}/forecast/regional - -[grid] -CASE=C3089 ;; FV3 resolution -LEVS=92 ;; Model vertical levels: 65, 128, 76, 86, and 97 -gtype=regional ;; grid type: uniform, stretch, nest, or regional -# If gridfixdir is provided and the dir exists, then use the pre-generated static grid fix files under gridfixdir -#gridfixdir=/let/hafs_grid/generate/grid -gridfixdir={HOMEhafs}/fix/fix_fv3/ESG_C3089_62W25N_3120x2160 -# Otherwise, will generate the model grid according to the following grid parameters -# Need for grid types: stretch, nest and regional -stretch_fac=1.0001 ;; Stretching factor for the grid -target_lon={domlon} ;; center longitude of the highest resolution tile -target_lat={domlat} ;; center latitude of the highest resolution tile -# Need for grid types: nest and regional -refine_ratio=4 ;; Specify the refinement ratio for nest grid -istart_nest=46 -jstart_nest=168 -iend_nest=1485 -jend_nest=1367 - -[grid_ens] -CASE_ENS=C1545 ;; FV3 resolution -LEVS_ENS=92 ;; Model vertical levels: 65 -gtype_ens=regional ;; grid type: uniform, stretch, nest, or regional -#gridfixdir_ens=/let/hafs_grid/generate/grid_ens -gridfixdir_ens={HOMEhafs}/fix/fix_fv3/ESG_C1545_62W25N_1560x1080 -stretch_fac_ens=1.0001 ;; Stretching factor for the grid -target_lon_ens={domlon} ;; center longitude of the highest resolution tile -target_lat_ens={domlat} ;; center latitude of the highest resolution tile -refine_ratio_ens=2 ;; Specify the refinement ratio for nest grid -istart_nest_ens=46 -jstart_nest_ens=168 -iend_nest_ens=1485 -jend_nest_ens=1376 - -[forecast] -k_split=3 -n_split=5 -layoutx=40 -layouty=30 -npx=3121 -npy=2161 -npz=91 - -restart_interval="3 6 9" ;; restart interval in hours for the forecast - -write_dopost=.true. -output_history=.false. - -output_grid=regional_latlon -output_grid_cen_lon=-62.0 ;; central longitude -output_grid_cen_lat=25.8 ;; central latitude -output_grid_lon_span=109.5 ;; output domain span for longitude in regular latlon coordinate system (in degrees) -output_grid_lat_span=63.6 ;; output domain span for latitude in regular latlon coordinate system (in degrees) -output_grid_dlon=0.03 ;; output grid spacing dlon . . . . -output_grid_dlat=0.03 ;; output grid spacing dlat . . . . - -[forecast_ens] -k_split_ens=2 -n_split_ens=5 -layoutx_ens=20 -layouty_ens=12 -npx_ens=1561 -npy_ens=1081 -npz_ens=91 - -restart_interval_ens="6 12" ;; restart interval in hours for the ensda member forecast - -output_grid_dlon_ens=0.06 ;; output grid spacing dlon . . . . -output_grid_dlat_ens=0.06 ;; output grid spacing dlat . . . . - -[rocotostr] -FORECAST_RESOURCES=FORECAST_RESOURCES_regional_{forecast/layoutx}x{forecast/layouty}io{forecast/write_groups}x{forecast/write_tasks_per_group}_omp2 -FORECAST_ENS_RESOURCES=FORECAST_ENS_RESOURCES_regional_{forecast_ens/layoutx_ens}x{forecast_ens/layouty_ens}io{forecast_ens/write_groups_ens}x{forecast_ens/write_tasks_per_group_ens}_omp2 diff --git a/parm/hafsv0p3_regional_conus_3km.conf b/parm/hafsv0p3_regional_conus_3km.conf deleted file mode 100644 index 8017e82e6..000000000 --- a/parm/hafsv0p3_regional_conus_3km.conf +++ /dev/null @@ -1,71 +0,0 @@ -[config] -domlat=38.5 -domlon=-97.5 -vitalsdomlat=385N -vitalsdomlon=975W -fakestormid=00L -fakestormname=CONUS -fakestormorg=NHC -fakestorm_vitals={fakestormorg} {fakestormid} {fakestormname} {YMD} {HH}{min} {vitalsdomlat} {vitalsdomlon} -99 -99 -999 -999 -099 -9 -99 -999 -999 -999 -999 M - -[dir] -PARMforecast={PARMhafs}/forecast/regional - -[grid] -CASE=C3357 ;; FV3 resolution -LEVS=82 ;; Model vertical levels -gtype=regional ;; grid type: uniform, stretch, nest, or regional -# If gridfixdir is provided and the dir exists, then use the pre-generated static grid fix files under gridfixdir -#gridfixdir=/let/hafs_grid/generate/grid -gridfixdir={HOMEhafs}/fix/fix_fv3/ESG0p03_C3357_CONUS_1748x1038 -stretch_fac=1.0001 ;; Stretching factor for the grid -target_lon={domlon} ;; center longitude of the highest resolution tile -target_lat={domlat} ;; center latitude of the highest resolution tile -nest_grids=1 -parent_grid_num=1 -parent_tile=6 -refine_ratio=4 -istart_nest=46 -jstart_nest=168 -iend_nest=1485 -jend_nest=1367 - -[forecast] -dt_atmos=90 -npx=1748 -npy=1038 -npz=81 -k_split=3 -n_split=5 -layoutx=30 -layouty=20 -io_layoutx=1 -io_layouty=1 -full_zs_filter=.true. -n_zs_filter=1 -n_del2_weak=15 -max_slope=0.25 -shal_cnv=.true. -do_deep=.true. - -restart_interval="240" - -quilting=.true. -write_groups=2 -write_tasks_per_group=40 -write_dopost=.false. -output_history=.true. - -output_grid=regional_latlon -output_grid_cen_lon=-97.5 ;; central longitude -output_grid_cen_lat=38.5 ;; central latitude -output_grid_lon_span=72.00 ;; output domain span for longitude in regular latlon coordinate system (in degrees) -output_grid_lat_span=36.00 ;; output domain span for latitude in regular latlon coordinate system (in degrees) -output_grid_dlon=0.03 ;; output grid spacing dlon . . . . -output_grid_dlat=0.03 ;; output grid spacing dlat . . . . - -[atm_post] -satpost=.false. - -[rocotostr] -FORECAST_RESOURCES=FORECAST_RESOURCES_680PE diff --git a/parm/hafsv0p3c.conf b/parm/hafsv1a_baseline.conf similarity index 59% rename from parm/hafsv0p3c.conf rename to parm/hafsv1a_baseline.conf index 14ff9d9e6..225c73938 100644 --- a/parm/hafsv0p3c.conf +++ b/parm/hafsv1a_baseline.conf @@ -1,10 +1,28 @@ [config] +parent_domain_center=auto + run_atm_mvnest=yes run_wave=no ww3_model=ww3 run_ocean=yes ocean_model=hycom +run_atm_init=yes +run_atm_init_fgat=yes +run_atm_vi=yes +run_atm_vi_fgat=yes +run_gsi=yes +run_fgat=yes +run_envar=yes +gsi_d01=no +gsi_d02=yes +run_analysis_merge=yes + +halo_blend=20 + +[hycominit1] +hycom_domain=large + [dir] PARMforecast={PARMhafs}/forecast/regional @@ -13,20 +31,27 @@ CASE=C512 ;; FV3 resolution LEVS=82 ;; Model vertical levels gtype=regional ;; grid type: uniform, stretch, nest, or regional gridfixdir=/let/hafs_grid/generate/grid -stretch_fac=1.05 ;; Stretching factor for the grid +stretch_fac=1.0001 ;; Stretching factor for the grid target_lon={domlon} ;; center longitude of the highest resolution tile target_lat={domlat} ;; center latitude of the highest resolution tile nest_grids=2 parent_grid_num=1,2 parent_tile=6,7 refine_ratio=3,3 -istart_nest=33,1201 -jstart_nest=33,1201 -iend_nest=992,1680 -jend_nest=992,1680 +istart_nest=73,-999 +jstart_nest=113,-999 +iend_nest=952,-999 +jend_nest=912,-999 +regional_esg=yes +idim_nest=1320,600 +jdim_nest=1200,600 +delx_nest=0.03,0.01 +dely_nest=0.03,0.01 +halop2=5 +pazi=-180. [grid_mvnest1res] -CASE_mvnest1res=C1536 +CASE_mvnest1res=C512 LEVS_mvnest1res={grid/LEVS} gtype_mvnest1res={grid/gtype} gridfixdir_mvnest1res=/let/hafs_grid/generate/grid_mvnest1res @@ -36,27 +61,43 @@ target_lat_mvnest1res={grid/target_lat} nest_grids_mvnest1res=1 parent_grid_num_mvnest1res=1 parent_tile_mvnest1res=6 -refine_ratio_mvnest1res=3 -istart_nest_mvnest1res=97 -jstart_nest_mvnest1res=97 -iend_nest_mvnest1res=2976 -jend_nest_mvnest1res=2976 +refine_ratio_mvnest1res=9 +istart_nest_mvnest1res=73 +jstart_nest_mvnest1res=113 +iend_nest_mvnest1res=952 +jend_nest_mvnest1res=912 +regional_esg_mvnest1res={grid/regional_esg} +idim_nest_mvnest1res=3960 +jdim_nest_mvnest1res=3600 +delx_nest_mvnest1res=0.01 +dely_nest_mvnest1res=0.01 +halop2_mvnest1res=15 [atm_init] -# ccpp suites -ccpp_suite_regional_init=FV3_HAFS_v0_thompson_noahmp -ccpp_suite_glob_init=FV3_HAFS_v0_thompson_noahmp -ccpp_suite_nest_init=FV3_HAFS_v0_thompson_noahmp layoutx_init=12,12 layouty_init=20,20 +[atm_merge] +atm_merge_method=vortexreplace + +[vi] +vi_storm_env=init ;; init: from gfs/gdas init; pert: from the same source for the storm perturbation +vi_storm_modification=yes ;; yes: always VM; no: no VM; auto: do VM based on vmax diff; vmax_threshold: do VM based on vmax threshold + +[gsi] +use_bufr_nr=yes +grid_ratio_fv3_regional=1 + +[analysis_merge] +analysis_merge_method=vortexreplace + [forecast] dt_atmos=90 -npx=1441,721 -npy=1441,721 +npx=1321,601 +npy=1201,601 npz=81 k_split=2,4 -n_split=6,9 +n_split=5,9 layoutx=30,30 layouty=20,20 io_layoutx=1,1 @@ -64,35 +105,21 @@ io_layouty=1,1 full_zs_filter=.true.,.true. n_zs_filter=1,1 n_del2_weak=15,24 -max_slope=0.25,0.25 -rlmx=300.,200. -elmx=300.,200. +max_slope=0.15,0.15 +rlmx=300.,300. +elmx=300.,300. sfc_rlm=1,1 shal_cnv=.true.,.true. do_deep=.true.,.true. - -# ccpp suites -ccpp_suite_regional=FV3_HAFS_v0_thompson_noahmp_nonsst -ccpp_suite_glob=FV3_HAFS_v0_thompson_noahmp_nonsst -ccpp_suite_nest=FV3_HAFS_v0_thompson_noahmp_nonsst - -# Thompson MP related options -imp_physics=8 -iovr=3 -dt_inner=45 -dnats=0 -do_sat_adj=.false. -lgfdlmprad=.false. - -# Noah LSM related options -lsm=2 -ialb=2 -iems=2 - fhswr=900. fhlwr=900. iaer=1011 +# ccpp suites +ccpp_suite_regional=FV3_HAFS_v0_gfdlmp_tedmf_nonsst +ccpp_suite_glob=FV3_HAFS_v0_gfdlmp_tedmf_nonsst +ccpp_suite_nest=FV3_HAFS_v0_gfdlmp_tedmf_nonsst + # Choose nstf_name=0,0,0,0,0 nstf_n1=0 nstf_n2=0 @@ -118,8 +145,8 @@ output_history=.true. output_grid=regional_latlon,regional_latlon_moving output_grid_cen_lon={domlon},{domlon} ;; central longitude output_grid_cen_lat={domlat},{domlat} ;; central latitude -output_grid_lon_span=100.8,24.0 ;; output domain span for longitude in regular latlon coordinate system (in degrees) -output_grid_lat_span=81.6,20.0 ;; output domain span for latitude in regular latlon coordinate system (in degrees) +output_grid_lon_span=100.8,20.0 ;; output domain span for longitude in regular latlon coordinate system (in degrees) +output_grid_lat_span=81.6,16.0 ;; output domain span for latitude in regular latlon coordinate system (in degrees) output_grid_dlon=0.06,0.02 ;; output grid spacing dlon . . . . output_grid_dlat=0.06,0.02 ;; output grid spacing dlat . . . . diff --git a/parm/hafsv0p3b.conf b/parm/hafsv1b_baseline.conf similarity index 64% rename from parm/hafsv0p3b.conf rename to parm/hafsv1b_baseline.conf index bda16fd9d..3bb323664 100644 --- a/parm/hafsv0p3b.conf +++ b/parm/hafsv1b_baseline.conf @@ -1,10 +1,28 @@ [config] +parent_domain_center=auto + run_atm_mvnest=yes run_wave=no ww3_model=ww3 run_ocean=yes ocean_model=hycom +run_atm_init=yes +run_atm_init_fgat=yes +run_atm_vi=yes +run_atm_vi_fgat=yes +run_gsi=yes +run_fgat=yes +run_envar=yes +gsi_d01=no +gsi_d02=yes +run_analysis_merge=yes + +halo_blend=20 + +[hycominit1] +hycom_domain=large + [dir] PARMforecast={PARMhafs}/forecast/regional @@ -13,20 +31,27 @@ CASE=C512 ;; FV3 resolution LEVS=82 ;; Model vertical levels gtype=regional ;; grid type: uniform, stretch, nest, or regional gridfixdir=/let/hafs_grid/generate/grid -stretch_fac=1.05 ;; Stretching factor for the grid +stretch_fac=1.0001 ;; Stretching factor for the grid target_lon={domlon} ;; center longitude of the highest resolution tile target_lat={domlat} ;; center latitude of the highest resolution tile nest_grids=2 parent_grid_num=1,2 parent_tile=6,7 refine_ratio=3,3 -istart_nest=33,1201 -jstart_nest=33,1201 -iend_nest=992,1680 -jend_nest=992,1680 +istart_nest=113,-999 +jstart_nest=113,-999 +iend_nest=912,-999 +jend_nest=912,-999 +regional_esg=yes +idim_nest=1200,600 +jdim_nest=1200,600 +delx_nest=0.03,0.01 +dely_nest=0.03,0.01 +halop2=5 +pazi=-180. [grid_mvnest1res] -CASE_mvnest1res=C1536 +CASE_mvnest1res=C512 LEVS_mvnest1res={grid/LEVS} gtype_mvnest1res={grid/gtype} gridfixdir_mvnest1res=/let/hafs_grid/generate/grid_mvnest1res @@ -36,11 +61,17 @@ target_lat_mvnest1res={grid/target_lat} nest_grids_mvnest1res=1 parent_grid_num_mvnest1res=1 parent_tile_mvnest1res=6 -refine_ratio_mvnest1res=3 -istart_nest_mvnest1res=97 -jstart_nest_mvnest1res=97 -iend_nest_mvnest1res=2976 -jend_nest_mvnest1res=2976 +refine_ratio_mvnest1res=9 +istart_nest_mvnest1res=113 +jstart_nest_mvnest1res=113 +iend_nest_mvnest1res=912 +jend_nest_mvnest1res=912 +regional_esg_mvnest1res={grid/regional_esg} +idim_nest_mvnest1res=3600 +jdim_nest_mvnest1res=3600 +delx_nest_mvnest1res=0.01 +dely_nest_mvnest1res=0.01 +halop2_mvnest1res=15 [atm_init] # ccpp suites @@ -50,13 +81,27 @@ ccpp_suite_nest_init=FV3_HAFS_v0_thompson layoutx_init=12,12 layouty_init=20,20 +[atm_merge] +atm_merge_method=vortexreplace + +[vi] +vi_storm_env=init ;; init: from gfs/gdas init; pert: from the same source for the storm perturbation +vi_storm_modification=auto ;; yes: always VM; no: no VM; auto: do VM based on vmax diff; vmax_threshold: do VM based on vmax threshold + +[gsi] +use_bufr_nr=yes +grid_ratio_fv3_regional=1 + +[analysis_merge] +analysis_merge_method=vortexreplace + [forecast] dt_atmos=90 -npx=1441,721 -npy=1441,721 +npx=1201,601 +npy=1201,601 npz=81 k_split=2,4 -n_split=6,9 +n_split=5,9 layoutx=30,30 layouty=20,20 io_layoutx=1,1 @@ -64,10 +109,11 @@ io_layouty=1,1 full_zs_filter=.true.,.true. n_zs_filter=1,1 n_del2_weak=15,24 -max_slope=0.25,0.25 -rlmx=300.,200. -elmx=300.,200. -sfc_rlm=1,1 +max_slope=0.15,0.15 +rlmx=300.,75. +elmx=300.,75. +sfc_rlm=0,0 +tc_pbl=1,1 shal_cnv=.true.,.true. do_deep=.true.,.true. @@ -89,8 +135,8 @@ lsm=1 ialb=1 iems=1 -fhswr=900. -fhlwr=900. +fhswr=1800. +fhlwr=1800. iaer=1011 # Choose nstf_name=0,0,0,0,0 @@ -118,8 +164,8 @@ output_history=.true. output_grid=regional_latlon,regional_latlon_moving output_grid_cen_lon={domlon},{domlon} ;; central longitude output_grid_cen_lat={domlat},{domlat} ;; central latitude -output_grid_lon_span=100.8,24.0 ;; output domain span for longitude in regular latlon coordinate system (in degrees) -output_grid_lat_span=81.6,20.0 ;; output domain span for latitude in regular latlon coordinate system (in degrees) +output_grid_lon_span=100.8,20.0 ;; output domain span for longitude in regular latlon coordinate system (in degrees) +output_grid_lat_span=81.6,16.0 ;; output domain span for latitude in regular latlon coordinate system (in degrees) output_grid_dlon=0.06,0.02 ;; output grid spacing dlon . . . . output_grid_dlat=0.06,0.02 ;; output grid spacing dlat . . . . diff --git a/parm/post/postcntrl_hafs_nosat.xml b/parm/post/postcntrl_hafs_nosat.xml deleted file mode 120000 index 1900ba4f1..000000000 --- a/parm/post/postcntrl_hafs_nosat.xml +++ /dev/null @@ -1 +0,0 @@ -../../sorc/hafs_post.fd/parm/postcntrl_hafs_nosat.xml \ No newline at end of file diff --git a/parm/post/postcntrl_hafs_nosat.xml b/parm/post/postcntrl_hafs_nosat.xml new file mode 100755 index 000000000..3f8f4ec9a --- /dev/null +++ b/parm/post/postcntrl_hafs_nosat.xml @@ -0,0 +1,521 @@ + + + + + HURPRS + 32769 + ncep_nco + v2003 + local_tab_yes1 + fcst + oper + fcst + fcst + hour + nws_ncep + hafs + complex_packing_spatial_diff + 2nd_ord_sptdiff + fltng_pnt + lossless + + + HGT_ON_ISOBARIC_SFC + HGT + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 6.0 + + + + TMP_ON_ISOBARIC_SFC + TMP + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 4.0 + + + + SPFH_ON_ISOBARIC_SFC + SPFH + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 7.0 + + + + RH_ON_ISOBARIC_SFC + RH + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 3.0 + + + + UGRD_ON_ISOBARIC_SFC + UGRD + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 4.0 + + + + VGRD_ON_ISOBARIC_SFC + VGRD + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 4.0 + + + + DZDT_ON_ISOBARIC_SFC + DZDT + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 5.0 + + + + VVEL_ON_ISOBARIC_SFC + VVEL + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 5.0 + + + + ABSV_ON_ISOBARIC_SFC + ABSV + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 4.0 + + + + CLWMR_ON_ISOBARIC_SFC + CLWMR + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 6.0 + + + + ICMR_ON_ISOBARIC_SFC + ICMR + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 6.0 + + + + RWMR_ON_ISOBARIC_SFC + RWMR + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 6.0 + + + + SNMR_ON_ISOBARIC_SFC + SNMR + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 6.0 + + + + GRLE_ON_ISOBARIC_SFC + GRLE + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 6.0 + + + + REFD_ON_ISOBARIC_SFC + REFD + 200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. +47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. + 4.0 + + + + MSLET_ON_MEAN_SEA_LVL + MSLET + NCEP + 6.0 + + + + PRES_ON_MEAN_SEA_LVL + PRMSL + 6.0 + + + + TMP_ON_SPEC_HGT_LVL_ABOVE_GRND_2m + TMP + 4.0 + + + + SPFH_ON_SPEC_HGT_LVL_ABOVE_GRND_2m + SPFH + 7.0 + + + + DPT_ON_SPEC_HGT_LVL_ABOVE_GRND_2m + DPT + 4.0 + + + + RH_ON_SPEC_HGT_LVL_ABOVE_GRND_2m + RH + 3.0 + + + + UGRD_ON_SPEC_HGT_LVL_ABOVE_GRND_10m + UGRD + 10. + 4.0 + + + + VGRD_ON_SPEC_HGT_LVL_ABOVE_GRND_10m + VGRD + 10. + 4.0 + + + + PRES_ON_SURFACE + PRES + 6.0 + + + + HGT_ON_SURFACE + HGT + 6.0 + + + + TMP_ON_SURFACE + TMP + 4.0 + + + + SFEXC_ON_SURFACE + SFEXC + NCEP + 4.0 + + + + CAPE_ON_SURFACE + CAPE + 4.0 + + + + CIN_ON_SURFACE + CIN + 4.0 + + + + PWAT_ON_ENTIRE_ATMOS_SINGLE_LYR + PWAT + 6.0 + + + + HLCY_ON_SPEC_HGT_LVL_ABOVE_GRND + HLCY + 3000. + 4.0 + + + + ACM_APCP_ON_SURFACE + APCP + -4.0 + + + + ACM_ACPCP_ON_SURFACE + ACPCP + -4.0 + + + + ACM_NCPCP_ON_SURFACE + NCPCP + -4.0 + + + + INST_PRATE_ON_SURFACE + PRATE + 6.0 + + + + INST_TCDC_ON_ENTIRE_ATMOS + TCDC + 4.0 + + + + AVE_TCDC_ON_ENTIRE_ATMOS + TCDC + 4.0 + + + + INST_USWRF_ON_SURFACE + USWRF + NCEP + 6.0 + + + + INST_ULWRF_ON_SURFACE + ULWRF + NCEP + 6.0 + + + + AVE_DSWRF_ON_SURFACE + DSWRF + NCEP + 6.0 + + + + AVE_DLWRF_ON_SURFACE + DLWRF + NCEP + 4.0 + + + + AVE_USWRF_ON_SURFACE + USWRF + NCEP + 6.0 + + + + AVE_ULWRF_ON_SURFACE + ULWRF + NCEP + 4.0 + + + + AVE_USWRF_ON_TOP_OF_ATMOS + USWRF + NCEP + 6.0 + + + + AVE_ULWRF_ON_TOP_OF_ATMOS + ULWRF + NCEP + 4.0 + + + + INST_ULWRF_ON_TOP_OF_ATMOS + ULWRF + NCEP + 4.0 + + + + INST_DSWRF_ON_SURFACE + DSWRF + NCEP + 6.0 + + + + INST_DLWRF_ON_SURFACE + DLWRF + NCEP + 4.0 + + + + SFCR_ON_SURFACE + SFCR + 6.0 + + + + FRICV_ON_SURFACE + FRICV + NCEP + 4.0 + + + + UFLX_ON_SURFACE + UFLX + 4.0 + + + + VFLX_ON_SURFACE + VFLX + 4.0 + + + + INST_SHTFL_ON_SURFACE + SHTFL + 4.0 + + + + INST_LHTFL_ON_SURFACE + LHTFL + 4.0 + + + + NLAT_ON_SURFACE + NLAT + NCEP + 4.0 + + + + ELON_ON_SURFACE + ELON + NCEP + 4.0 + + + + LAND_ON_SURFACE + LAND + 1.0 + + + + WTMP_ON_SURFACE + WTMP + 4.0 + + + + PRES_ON_TROPOPAUSE + PRES + 6.0 + + + + HGT_ON_TROPOPAUSE + HGT + 6.0 + + + + TMP_ON_TROPOPAUSE + TMP + 4.0 + + + + UGRD_ON_TROPOPAUSE + UGRD + 4.0 + + + + VGRD_ON_TROPOPAUSE + VGRD + 4.0 + + + + VWSH_ON_TROPOPAUSE + VWSH + NCEP + 3.0 + + + + TMP_ON_CLOUD_TOP + TMP + 4.0 + + + + REFC_ON_ENTIRE_ATMOS + REFC + NCEP + 4.0 + + + + HPBL_ON_SURFACE + HPBL + NCEP + 6.0 + + + + TCOLW_ON_ENTIRE_ATMOS + TCOLW + NCEP + 5.0 + + + + TCOLI_ON_ENTIRE_ATMOS + TCOLI + NCEP + 5.0 + + + + TCOLR_ON_ENTIRE_ATMOS + TCOLR + NCEP + 5.0 + + + + TCOLS_ON_ENTIRE_ATMOS + TCOLS + NCEP + 5.0 + + + + TCOLC_ON_ENTIRE_ATMOS + TCOLC + NCEP + 5.0 + + + + MAX_WIND_ON_SPEC_HGT_LVL_ABOVE_GRND_10m + WIND + -4.0 + + + + + + + diff --git a/parm/post/postxconfig-NT-hafs_nosat.txt b/parm/post/postxconfig-NT-hafs_nosat.txt deleted file mode 120000 index 6164b2006..000000000 --- a/parm/post/postxconfig-NT-hafs_nosat.txt +++ /dev/null @@ -1 +0,0 @@ -../../sorc/hafs_post.fd/parm/postxconfig-NT-hafs_nosat.txt \ No newline at end of file diff --git a/parm/post/postxconfig-NT-hafs_nosat.txt b/parm/post/postxconfig-NT-hafs_nosat.txt new file mode 100644 index 000000000..8c8492d0f --- /dev/null +++ b/parm/post/postxconfig-NT-hafs_nosat.txt @@ -0,0 +1,2682 @@ +1 +72 +HURPRS +32769 +ncep_nco +v2003 +local_tab_yes1 +fcst +oper +fcst +fcst +hour +nws_ncep +hafs +complex_packing_spatial_diff +2nd_ord_sptdiff +fltng_pnt +lossless +12 +HGT_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +HGT +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +13 +TMP_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +TMP +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +16 +SPFH_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +SPFH +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +7.0 +0 +0 +0 +? +? +? +17 +RH_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +RH +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +3.0 +0 +0 +0 +? +? +? +18 +UGRD_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +UGRD +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +19 +VGRD_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +VGRD +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +284 +DZDT_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +DZDT +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +5.0 +0 +0 +0 +? +? +? +20 +VVEL_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +VVEL +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +5.0 +0 +0 +0 +? +? +? +21 +ABSV_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +ABSV +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +166 +ICMR_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +ICMR +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +183 +RWMR_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +RWMR +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +184 +SNMR_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +SNMR +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +416 +GRLE_ON_ISOBARIC_SFC +Graupel mixing ration on isobaric surface +1 +tmpl4_0 +GRLE +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +251 +REFD_ON_ISOBARIC_SFC +? +1 +tmpl4_0 +REFD +? +? +isobaric_sfc +0 +? +45 +200. 500. 700. 1000. 2000. 3000. 5000. 7000. 10000. 12500. 15000. 17500. 20000. 22500. 25000. 27500. 30000. 32500. 35000. 37500. 40000. 42500. 45000. 47500. 50000. 52500. 55000. 57500. 60000. 62500. 65000. 67500. 70000. 72500. 75000. 77500. 80000. 82500. 85000. 87500. 90000. 92500. 95000. 97500. 100000. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +23 +MSLET_ON_MEAN_SEA_LVL +? +1 +tmpl4_0 +MSLET +NCEP +? +mean_sea_lvl +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +105 +PRES_ON_MEAN_SEA_LVL +? +1 +tmpl4_0 +PRMSL +? +? +mean_sea_lvl +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +106 +TMP_ON_SPEC_HGT_LVL_ABOVE_GRND_2m +? +1 +tmpl4_0 +TMP +? +? +spec_hgt_lvl_above_grnd +0 +? +1 +2. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +112 +SPFH_ON_SPEC_HGT_LVL_ABOVE_GRND_2m +? +1 +tmpl4_0 +SPFH +? +? +spec_hgt_lvl_above_grnd +0 +? +1 +2. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +7.0 +0 +0 +0 +? +? +? +113 +DPT_ON_SPEC_HGT_LVL_ABOVE_GRND_2m +? +1 +tmpl4_0 +DPT +? +? +spec_hgt_lvl_above_grnd +0 +? +1 +2. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +114 +RH_ON_SPEC_HGT_LVL_ABOVE_GRND_2m +? +1 +tmpl4_0 +RH +? +? +spec_hgt_lvl_above_grnd +0 +? +1 +2. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +3.0 +0 +0 +0 +? +? +? +64 +UGRD_ON_SPEC_HGT_LVL_ABOVE_GRND_10m +? +1 +tmpl4_0 +UGRD +? +? +spec_hgt_lvl_above_grnd +0 +? +1 +10. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +65 +VGRD_ON_SPEC_HGT_LVL_ABOVE_GRND_10m +? +1 +tmpl4_0 +VGRD +? +? +spec_hgt_lvl_above_grnd +0 +? +1 +10. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +24 +PRES_ON_SURFACE +? +1 +tmpl4_0 +PRES +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +25 +HGT_ON_SURFACE +? +1 +tmpl4_0 +HGT +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +26 +TMP_ON_SURFACE +? +1 +tmpl4_0 +TMP +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +169 +SFEXC_ON_SURFACE +? +1 +tmpl4_0 +SFEXC +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +32 +CAPE_ON_SURFACE +? +1 +tmpl4_0 +CAPE +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +107 +CIN_ON_SURFACE +? +1 +tmpl4_0 +CIN +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +80 +PWAT_ON_ENTIRE_ATMOS_SINGLE_LYR +? +1 +tmpl4_0 +PWAT +? +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +162 +HLCY_ON_SPEC_HGT_LVL_ABOVE_GRND +? +1 +tmpl4_0 +HLCY +? +? +spec_hgt_lvl_above_grnd +0 +? +1 +3000. +spec_hgt_lvl_above_grnd +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +87 +ACM_APCP_ON_SURFACE +? +1 +tmpl4_8 +APCP +? +ACM +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +-4.0 +0 +0 +0 +? +? +? +33 +ACM_ACPCP_ON_SURFACE +? +1 +tmpl4_8 +ACPCP +? +ACM +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +-4.0 +0 +0 +0 +? +? +? +34 +ACM_NCPCP_ON_SURFACE +? +1 +tmpl4_8 +NCPCP +? +ACM +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +-4.0 +0 +0 +0 +? +? +? +167 +INST_PRATE_ON_SURFACE +? +1 +tmpl4_0 +PRATE +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +161 +INST_TCDC_ON_ENTIRE_ATMOS +? +1 +tmpl4_0 +TCDC +? +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +144 +AVE_TCDC_ON_ENTIRE_ATMOS +? +1 +tmpl4_8 +TCDC +? +AVE +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +141 +INST_USWRF_ON_SURFACE +? +1 +tmpl4_0 +USWRF +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +142 +INST_ULWRF_ON_SURFACE +? +1 +tmpl4_0 +ULWRF +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +126 +AVE_DSWRF_ON_SURFACE +? +1 +tmpl4_8 +DSWRF +NCEP +AVE +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +127 +AVE_DLWRF_ON_SURFACE +? +1 +tmpl4_8 +DLWRF +NCEP +AVE +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +128 +AVE_USWRF_ON_SURFACE +? +1 +tmpl4_8 +USWRF +NCEP +AVE +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +129 +AVE_ULWRF_ON_SURFACE +? +1 +tmpl4_8 +ULWRF +NCEP +AVE +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +130 +AVE_USWRF_ON_TOP_OF_ATMOS +? +1 +tmpl4_8 +USWRF +NCEP +AVE +top_of_atmos +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +131 +AVE_ULWRF_ON_TOP_OF_ATMOS +? +1 +tmpl4_8 +ULWRF +NCEP +AVE +top_of_atmos +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +274 +INST_ULWRF_ON_TOP_OF_ATMOS +? +1 +tmpl4_0 +ULWRF +NCEP +? +top_of_atmos +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +156 +INST_DSWRF_ON_SURFACE +? +1 +tmpl4_0 +DSWRF +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +157 +INST_DLWRF_ON_SURFACE +? +1 +tmpl4_0 +DLWRF +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +44 +SFCR_ON_SURFACE +? +1 +tmpl4_0 +SFCR +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +45 +FRICV_ON_SURFACE +? +1 +tmpl4_0 +FRICV +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +133 +UFLX_ON_SURFACE +? +1 +tmpl4_0 +UFLX +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +134 +VFLX_ON_SURFACE +? +1 +tmpl4_0 +VFLX +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +154 +INST_SHTFL_ON_SURFACE +? +1 +tmpl4_0 +SHTFL +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +155 +INST_LHTFL_ON_SURFACE +? +1 +tmpl4_0 +LHTFL +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +48 +NLAT_ON_SURFACE +? +1 +tmpl4_0 +NLAT +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +49 +ELON_ON_SURFACE +? +1 +tmpl4_0 +ELON +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +50 +LAND_ON_SURFACE +? +1 +tmpl4_0 +LAND +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +1.0 +0 +0 +0 +? +? +? +151 +WTMP_ON_SURFACE +? +1 +tmpl4_0 +WTMP +? +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +54 +PRES_ON_TROPOPAUSE +? +1 +tmpl4_0 +PRES +? +? +tropopause +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +177 +HGT_ON_TROPOPAUSE +? +1 +tmpl4_0 +HGT +? +? +tropopause +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +55 +TMP_ON_TROPOPAUSE +? +1 +tmpl4_0 +TMP +? +? +tropopause +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +56 +UGRD_ON_TROPOPAUSE +? +1 +tmpl4_0 +UGRD +? +? +tropopause +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +57 +VGRD_ON_TROPOPAUSE +? +1 +tmpl4_0 +VGRD +? +? +tropopause +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +58 +VWSH_ON_TROPOPAUSE +? +1 +tmpl4_0 +VWSH +NCEP +? +tropopause +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +3.0 +0 +0 +0 +? +? +? +168 +TMP_ON_CLOUD_TOP +? +1 +tmpl4_0 +TMP +? +? +cloud_top +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +252 +REFC_ON_ENTIRE_ATMOS +? +1 +tmpl4_0 +REFC +NCEP +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +4.0 +0 +0 +0 +? +? +? +221 +HPBL_ON_SURFACE +? +1 +tmpl4_0 +HPBL +NCEP +? +surface +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +6.0 +0 +0 +0 +? +? +? +200 +TCOLW_ON_ENTIRE_ATMOS +? +1 +tmpl4_0 +TCOLW +NCEP +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +5.0 +0 +0 +0 +? +? +? +201 +TCOLI_ON_ENTIRE_ATMOS +? +1 +tmpl4_0 +TCOLI +NCEP +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +5.0 +0 +0 +0 +? +? +? +202 +TCOLR_ON_ENTIRE_ATMOS +? +1 +tmpl4_0 +TCOLR +NCEP +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +5.0 +0 +0 +0 +? +? +? +203 +TCOLS_ON_ENTIRE_ATMOS +? +1 +tmpl4_0 +TCOLS +NCEP +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +5.0 +0 +0 +0 +? +? +? +204 +TCOLC_ON_ENTIRE_ATMOS +? +1 +tmpl4_0 +TCOLC +NCEP +? +entire_atmos_single_lyr +0 +? +0 +? +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +5.0 +0 +0 +0 +? +? +? +422 +MAX_WIND_ON_SPEC_HGT_LVL_ABOVE_GRND_10m +maximum wind speed on 10 meter Above Ground +1 +tmpl4_8 +WIND +? +MAX +spec_hgt_lvl_above_grnd +0 +? +1 +10. +? +0 +? +0 +? +? +? +0 +0.0 +0 +0.0 +? +0 +0.0 +0 +0.0 +1 +-4.0 +0 +0 +0 +? +? +? diff --git a/parm/system.conf.wcoss2 b/parm/system.conf.wcoss2 index 6b90f64dd..0fa10e0d8 100644 --- a/parm/system.conf.wcoss2 +++ b/parm/system.conf.wcoss2 @@ -53,8 +53,12 @@ WHERE_AM_I=wcoss2 ;; Which cluster? (For setting up environment.) WHICH_JET=none ;; Which part of Jet are we on? None; we are not on Jet. [forecast] +glob_layoutx=8 +glob_layouty=10 +layoutx=40 +layouty=30 write_groups=1 -write_tasks_per_group=96 +write_tasks_per_group=60 [rocotostr] FORECAST_RESOURCES=FORECAST_RESOURCES_regional_{forecast/layoutx}x{forecast/layouty}io{forecast/write_groups}x{forecast/write_tasks_per_group}_omp2 diff --git a/parm/system.conf.wcoss_cray b/parm/system.conf.wcoss_cray deleted file mode 100644 index d78207686..000000000 --- a/parm/system.conf.wcoss_cray +++ /dev/null @@ -1,58 +0,0 @@ -## This is the system-specific configuration file for the WCOSS Cray -[config] -## Project disk area -disk_project=hwrf -## Project hpss tape area -tape_project=emc-hwrf -## CPU account name for submitting jobs to the batch system. -cpu_account=HUR-T2O -## Archive path -#archive=hpss:/NCEPDEV/{tape_project}/5year/{ENV[USER]}/{SUBEXPT}/{out_prefix}.tar -archive=disk:/gpfs/hps3/ptmp/{ENV[USER]}/{SUBEXPT}_archive/{out_prefix}.tar -## Specify input sources for HISTORY mode. -input_sources=wcoss_sources_{GFSVER} -## Specify the DataCatalog for FORECAST mode runs. -fcst_catalog=wcoss_fcst_{GFSVER} - -[hafsdata] -inputroot=/gpfs/hps3/emc/{disk_project}/noscrub/{ENV[USER]}/hafsdata_{GFSVER} - -[wcoss_fcst_PROD2019] -inputroot=/gpfs/dell1/nco/ops/com/gfs/prod - -[dir] -## Non-scrubbed directory for track files, etc. Make sure you edit this. -CDNOSCRUB=/gpfs/hps3/emc/{disk_project}/noscrub/{ENV[USER]}/hafstrak -DATMdir=/gpfs/hps3/emc/{disk_project}/noscrub/{ENV[USER]}/DATM -DOCNdir=/gpfs/hps3/emc/{disk_project}/noscrub/{ENV[USER]}/DOCN -## Scrubbed directory for large work files. Make sure you edit this. -CDSCRUB=/gpfs/hps3/ptmp/{ENV[USER]} -## Save directory. Make sure you edit this. -CDSAVE=/gpfs/hps3/emc/{disk_project}/noscrub/{ENV[USER]}/save -## Syndat directory for finding which cycles to run -#syndat=/gpfs/tp1/nco/ops/com/arch/prod/syndat -syndat=/gpfs/hps3/emc/hwrf/noscrub/input/SYNDAT-PLUS -## Input GFS data directory -#COMgfs=/gpfs/dell1/nco/ops/com/gfs/prod -COMgfs=/gpfs/dell3/nco/storage/hurpara/hafs-input/COMGFSv16 -COMINgfs={COMgfs} -COMINhafs={COMINgfs} -#COMINhafs=/gpfs/dell3/nco/storage/hurpara/hafs-input/COMGFSv16 -COMrtofs=/gpfs/dell3/nco/storage/hurpara/hafs-input/COMRTOFSv2 -COMINrtofs={COMrtofs} -## A-Deck directory for graphics -ADECKhafs=/gpfs/hps3/emc/hwrf/noscrub/emc.hurpara/trak/abdeck/aid -## B-Deck directory for graphics -BDECKhafs=/gpfs/hps3/emc/hwrf/noscrub/emc.hurpara/trak/abdeck/btk - -## Used when parsing hwrf_holdvars.txt to make storm*.holdvars.txt in COM -[holdvars] -WHERE_AM_I=wcoss_cray ;; Which cluster? (For setting up environment.) -WHICH_JET=none ;; Which part of Jet are we on? None; we are not on Jet. - -[forecast] -write_groups=1 -write_tasks_per_group=96 - -[rocotostr] -FORECAST_RESOURCES=FORECAST_RESOURCES_regional_{forecast/layoutx}x{forecast/layouty}io{forecast/write_groups}x{forecast/write_tasks_per_group}_omp2 diff --git a/parm/system.conf.wcoss_dell_p3 b/parm/system.conf.wcoss_dell_p3 deleted file mode 100644 index 03503291d..000000000 --- a/parm/system.conf.wcoss_dell_p3 +++ /dev/null @@ -1,57 +0,0 @@ -## This is the system-specific configuration file for the WCOSS Dell Phase 3 -[config] -## Project disk area -disk_project=modeling -## Project hpss tape area -tape_project=emc-hwrf -## CPU account name for submitting jobs to the batch system. -cpu_account=HUR-T2O -## Archive path -archive=hpss:/NCEPDEV/{tape_project}/5year/{ENV[USER]}/{SUBEXPT}/{out_prefix}.tar -## Specify input sources for HISTORY mode. -input_sources=wcoss_sources_{GFSVER} -## Specify the DataCatalog for FORECAST mode runs. -fcst_catalog=wcoss_fcst_{GFSVER} - -[hafsdata] -inputroot=/gpfs/hps3/emc/{disk_project}/noscrub/{ENV[USER]}/hafsdata_{GFSVER} - -[wcoss_fcst_PROD2019] -inputroot=/gpfs/dell1/nco/ops/com/gfs/prod - -[dir] -## Non-scrubbed directory for track files, etc. Make sure you edit this. -CDNOSCRUB=/gpfs/dell2/emc/{disk_project}/noscrub/{ENV[USER]}/hafstrak -DATMdir=/gpfs/dell2/emc/{disk_project}/noscrub/{ENV[USER]}/DATM -DOCNdir=/gpfs/dell2/emc/{disk_project}/noscrub/{ENV[USER]}/DOCN -## Scrubbed directory for large work files. Make sure you edit this. -CDSCRUB=/gpfs/dell2/ptmp/{ENV[USER]} -## Save directory. Make sure you edit this. -CDSAVE=/gpfs/dell2/emc/{disk_project}/noscrub/{ENV[USER]}/save -## Syndat directory for finding which cycles to run -#syndat=/gpfs/tp1/nco/ops/com/arch/prod/syndat -syndat=/gpfs/hps3/emc/hwrf/noscrub/input/SYNDAT-PLUS -## Input GFS data directory -#COMgfs=/gpfs/dell1/nco/ops/com/gfs/prod -COMgfs=/gpfs/dell3/nco/storage/hurpara/hafs-input/COMGFSv16 -COMINgfs={COMgfs} -COMINhafs={COMINgfs} -#COMINhafs=/gpfs/dell3/nco/storage/hurpara/hafs-input/COMGFSv16 -COMrtofs=/gpfs/dell3/nco/storage/hurpara/hafs-input/COMRTOFSv2 -COMINrtofs={COMrtofs} -## A-Deck directory for graphics -ADECKhafs=/gpfs/hps3/emc/hwrf/noscrub/emc.hurpara/trak/abdeck/aid -## B-Deck directory for graphics -BDECKhafs=/gpfs/hps3/emc/hwrf/noscrub/emc.hurpara/trak/abdeck/btk - -## Used when parsing hwrf_holdvars.txt to make storm*.holdvars.txt in COM -[holdvars] -WHERE_AM_I=wcoss_dell_p3 ;; Which cluster? (For setting up environment.) -WHICH_JET=none ;; Which part of Jet are we on? None; we are not on Jet. - -[forecast] -write_groups=1 -write_tasks_per_group=96 - -[rocotostr] -FORECAST_RESOURCES=FORECAST_RESOURCES_regional_{forecast/layoutx}x{forecast/layouty}io{forecast/write_groups}x{forecast/write_tasks_per_group}_omp2 diff --git a/parm/ww3/regional/ww3_shel.inp_tmpl b/parm/ww3/regional/ww3_shel.inp_tmpl index d7b75a612..2198ce666 100644 --- a/parm/ww3/regional/ww3_shel.inp_tmpl +++ b/parm/ww3/regional/ww3_shel.inp_tmpl @@ -1,311 +1,895 @@ $ -------------------------------------------------------------------- $ -$ WAVEWATCH III shell input file $ +$ WAVEWATCH III shel input file $ $ -------------------------------------------------------------------- $ -$ Define input to be used with flag for use and flag for definition -$ as a homogeneous field (first three only); eight input lines. +$ Define input to be used with F/T/C flag for use or nor or coupling and +$ T/F flag for definition as a homogeneous field. $ +$ Include ice and mud parameters only if IC1/2/3/4 used : F F Water levels - T F Currents - T F Winds - F Ice concentrations + @[INPUT_CURFLD] Currents + @[INPUT_WNDFLD] Winds + @[INPUT_ICEFLD] Ice concentrations + F F Atmospheric momentum + F F Air density F Assimilation data : Mean parameters F Assimilation data : 1-D spectra - F Assimilation data : 2-D spectra. + F Assimilation data : 2-D spectra $ $ Time frame of calculations ----------------------------------------- $ $ - Starting time in yyyymmdd hhmmss format. $ - Ending time in yyyymmdd hhmmss format. $ - - -$ -$ Define output data ------------------------------------------------- $ -$ -$ Define output server mode. This is used only in the parallel version -$ of the model. To keep the input file consistent, it is always needed. -$ IOSTYP = 1 is generally recommended. IOSTYP > 2 may be more efficient -$ for massively parallel computations. Only IOSTYP = 0 requires a true -$ parallel file system like GPFS. -$ -$ IOSTYP = 0 : No data server processes, direct access output from -$ each process (requirese true parallel file system). -$ 1 : No data server process. All output for each type -$ performed by process that performes computations too. -$ 2 : Last process is reserved for all output, and does no -$ computing. -$ 3 : Multiple dedicated output processes. + @[RUN_BEG] + @[RUN_END] $ +$ IOSTYP 1 $ -$ Five output types are available (see below). All output types share -$ a similar format for the first input line: -$ - first time in yyyymmdd hhmmss format, output interval (s), and -$ last time in yyyymmdd hhmmss format (all integers). -$ Output is disabled by setting the output interval to 0. -$ -$ ------------------------------------------------------------------- $ -$ -$ Type 1 : Fields of mean wave parameters -$ Standard line and line with logical flags to activate output -$ fields as defined in section 2.4 of the manual. The logical -$ flags are not supplied if no output is requested. The logical -$ flags can be placed on multiple consecutive lines. However, -$ the total number and order of the logical flags is fixed. -$ The raw data file is out_grd.ww3, -$ see w3iogo.ftn for additional doc. -$ - -$---------------------------------------------------------------- -$ Output request flags identifying fields. -$ -$ The table below provides a full definition of field output parameters -$ as well as flags indicating if they are available in different field -$ output output file types (ASCII, grib, NetCDF). -$ Further definitions are found in section 2.4 of the manual. -$ -$ Selection of field outputs may be made in two ways: -$ F/T flags: first flag is set to F, requests made per group (1st line) -$ followed by parameter flags (total of 10 groups). -$ Namelists: first line is set to N, next line contains parameter -$ symbol as per table below. -$ -$ Example of F/T flag use is given in this sample ww3_shel.inp, below. -$ For namelist usage, see the sample ww3_ounf.inp for an example. -$ -$ ---------------------------------------- -$ Output field parameter definitions table -$ ---------------------------------------- -$ -$ All parameters listed below are available in output file of the types -$ ASCII and NetCDF. If selected output file types are grads or grib, -$ some parameters may not be available. The first two columns in the -$ table below identify such cases by flags, cols 1 (GRB) and 2 (GXO) -$ refer to grib (ww3_grib) and grads (gx_outf), respectively. -$ -$ Columns 3 and 4 provide group and parameter numbers per group. -$ Columns 5, 6 and 7 provide: -$ 5 - code name (internal) -$ 6 - output tags (names used is ASCII file extensions, NetCDF -$ variable names and namelist-based selection (see ww3_ounf.inp) -$ 7 - Long parameter name/definition -$ -$ G G -$ R X Grp Param Code Output Parameter/Group -$ B O Numb Numbr Name Tag Definition -$ -------------------------------------------------- -$ 1 Forcing Fields -$ ------------------------------------------------- -$ T T 1 1 DW DPT Water depth. -$ T T 1 2 C[X,Y] CUR Current velocity. -$ T T 1 3 UA WND Wind speed. -$ T T 1 4 AS AST Air-sea temperature difference. -$ T T 1 5 WLV WLV Water levels. -$ T T 1 6 ICE ICE Ice concentration. -$ T T 1 7 IBG IBG Iceberg-induced damping -$ T T 1 8 D50 D50 Median sediment grain size -$ ------------------------------------------------- -$ 2 Standard mean wave Parameters -$ ------------------------------------------------- -$ T T 2 1 HS HS Wave height. -$ T T 2 2 WLM LM Mean wave length. -$ T T 2 3 T02 T02 Mean wave period (Tm02). -$ T T 2 4 T0M1 T0M1 Mean wave period (Tm0,-1). -$ T T 2 5 T01 T01 Mean wave period (Tm01). -$ T T 2 6 FP0 FP Peak frequency. -$ T T 2 7 THM DIR Mean wave direction. -$ T T 2 8 THS SPR Mean directional spread. -$ T T 2 9 THP0 DP Peak direction. -$ T T 2 10 HIG HIG Infragravity height -$ ------------------------------------------------- -$ 3 Spectral Parameters (first 5) -$ ------------------------------------------------- -$ F F 3 1 Ef EF Wave frequency spectrum -$ F F 3 2 th1m TH1M Mean wave direction from a1,b2 -$ F F 3 3 sth1m STH1M Directional spreading from a1,b2 -$ F F 3 4 th2m Mean wave direction from a2,b2 -$ F F 3 5 sth2m Directional spreading from a2,b2 -$ F F 3 6 WN WN Wavenumber array -$ ------------------------------------------------- -$ 4 Spectral Partition Parameters -$ ------------------------------------------------- -$ T T 4 1 PHS PHS Partitioned wave heights. -$ T T 4 2 PTP PTP Partitioned peak period. -$ T T 4 3 PLP PLP Partitioned peak wave length. -$ T T 4 4 PDIR PDIR Partitioned mean direction. -$ T T 4 5 PSI PSPR Partitioned mean directional spread. -$ T T 4 6 PWS PWS Partitionned wind sea fraction. -$ T T 4 7 PWST TWS Total wind sea fraction. -$ T T 4 8 PNR PNR Number of partitions. -$ ------------------------------------------------- -$ 5 Atmosphere-waves layer -$ ------------------------------------------------- -$ T T 5 1 UST UST Friction velocity. -$ F T 5 2 CHARN CHA Charnock parameter -$ F T 5 3 CGE CGE Energy flux -$ F T 5 4 PHIAW FAW Air-sea energy flux -$ F T 5 5 TAUWI[X,Y] TAW Net wave-supported stress -$ F T 5 6 TAUWN[X,Y] TWA Negative part of the wave-supported stress -$ F F 5 7 WHITECAP WCC Whitecap coverage -$ F F 5 8 WHITECAP WCF Whitecap thickness -$ F F 5 9 WHITECAP WCH Mean breaking height -$ F F 5 10 WHITECAP WCM Whitecap moment -$ ------------------------------------------------- -$ 6 Wave-ocean layer -$ ------------------------------------------------- -$ F F 6 1 S[XX,YY,XY] SXY Radiation stresses. -$ F F 6 2 TAUO[X,Y] TWO Wave to ocean momentum flux -$ F F 6 3 BHD BHD Bernoulli head (J term) -$ F F 6 4 PHIOC FOC Wave to ocean energy flux -$ F F 6 5 TUS[X,Y] TUS Stokes transport -$ F F 6 6 USS[X,Y] USS Surface Stokes drift -$ F F 6 7 [PR,TP]MS P2S Second-order sum pressure -$ F F 6 8 US3D USF Spectrum of surface Stokes drift -$ F F 6 9 P2SMS P2L Micro seism source term -$ ------------------------------------------------- -$ 7 Wave-bottom layer -$ ------------------------------------------------- -$ F F 7 1 ABA ABR Near bottom rms amplitides. -$ F F 7 2 UBA UBR Near bottom rms velocities. -$ F F 7 3 BEDFORMS BED Bedforms -$ F F 7 4 PHIBBL FBB Energy flux due to bottom friction -$ F F 7 5 TAUBBL TBB Momentum flux due to bottom friction -$ ------------------------------------------------- -$ 8 Spectrum parameters -$ ------------------------------------------------- -$ F F 8 1 MSS[X,Y] MSS Mean square slopes -$ F F 8 2 MSC[X,Y] MSC Spectral level at high frequency tail -$ ------------------------------------------------- -$ 9 Numerical diagnostics -$ ------------------------------------------------- -$ T T 9 1 DTDYN DTD Average time step in integration. -$ T T 9 2 FCUT FC Cut-off frequency. -$ T T 9 3 CFLXYMAX CFX Max. CFL number for spatial advection. -$ T T 9 4 CFLTHMAX CFD Max. CFL number for theta-advection. -$ F F 9 5 CFLKMAX CFK Max. CFL number for k-advection. -$ ------------------------------------------------- -$ 10 User defined -$ ------------------------------------------------- -$ F F 10 1 U1 User defined #1. (requires coding ...) -$ F F 10 2 U2 User defined #1. (requires coding ...) -$ ------------------------------------------------- -$ -$ Section 4 consist of a set of fields, index 0 = wind sea, index -$ 1:NOSWLL are first NOSWLL swell fields. -$ -$ Actual active parameter selection section -$ -$ (1) Forcing Fields - T -$ DPT CUR WND AST WLV ICE IBG D50 - F F T F F F F F -$ (2) Standard mean wave Parameters - T -$ HS LM T02 T0M1 T01 FP DIR SPR DP - T T F F T T T F T -$ (3) Frequency-dependent parameters - F -$ EF TH1M STH1M TH2M STH2M WN -$ T T T F F F -$ (4) Spectral Partition Parameters - T -$ PHS PTP PLP PDIR PSPR PWS TWS PNR - T T T T F F F F -$ (5) Atmosphere-waves layer - F -$ UST CHA CGE FAW TAW TWA WCC WCF WCH WCM -$ T T T T T T T T T T -$ (6) Wave-Ocean layer - F -$ SXY TWO BHD FOC TUS USS P2S USF P2L -$ T T T T T T T F F F -$ (7) Wave-bottom layer - F -$ ABR UBR BED FBB TBB -$ T T T T T -$ (8) Spectrum parameters - F -$ MSS MSC -$ T T -$ (9) Numerical diagnostics - F -$ DTD FC CFX CFD CFK -$ T T T T T -$ (10) User defined (NOEXTR flags needed) - F -$ T T T T T T T T T T T -$ U1 U2 -$ T T F F F F F F F F F F F F -$ -$---------------------------------------------------------------- -$ -$ Type 2 : Point output -$ Standard line and a number of lines identifying the -$ longitude, latitude and name (C*10) of output points. -$ The list is closed by defining a point with the name -$ 'STOPSTRING'. No point info read if no point output is -$ requested (i.e., no 'STOPSTRING' needed). -$ Example for spherical grid. -$ The raw data file is out_pnt.ww3, -$ see w3iogo.ftn for additional doc. -$ -$ NOTE : Spaces may be included in the name, but this is not -$ advised, because it will break the GrADS utility to -$ plots spectra and source terms, and will make it more -$ diffucult to use point names in data files. -$ - - -$ -$ -0.25 -0.25 'Land ' -$ 0.0 0.0 'Point_1 ' -$ 2.0 1.0 'Point_2 ' -$ 1.8 2.2 'Point_3 ' -$ 2.1 0.9 'Point_4 ' -$ 5.0 5.0 'Outside ' -$ -$ 0.0 0.0 'STOPSTRING' + @[FLD_BEG] @[FLD_DT] @[FLD_END] @[GOFILETYPE] + N + @[OUTPARS_WAV] +$ + @[PNT_BEG] @[PNT_DT] @[PNT_END] @[POFILETYPE] +$ +$ Global output point data file for global wave ensembles +$ +$ Retained only deep water buoys or so from general buoy file +$ taken from multi_1/2 +$ +$ Key to data in file: +$ +$ LON Longitude, east positive +$ LAT Latitude +$ NAME Output point name C*10, no blanks in name allowed +$ AH Anemometer height, dummy value for none-data points +$ TYPE Buoy type indicator, used for plotting and postprocessing +$ DAT Data point +$ XDT Former data point +$ BPT Boundary data for external models. +$ VBY 'Virtual buoy' +$ SOURCE Source of data point +$ ENCAN Environment Canada +$ GOMOOS Gulf of Maine OOS +$ IDT Irish Department of Transportation +$ METFR Meteo France +$ NCEP Boundary and other data points +$ NDBC National Data Buoy Center +$ PRIV Private and incidental data sources +$ SCRIPPS Scripps +$ UKMO UK Met Office +$ PDES Puertos del Estados +$ SHOM Service Hydrographique et Oceanographique de la Marine +$ OCNOR Fugro Oceanor +$ WHOI Woods Hole Oceanographic Institute +$ SKOREA South Korea +$ MVEW Ministerie van Verkeer en Waterstaat +$ CORMP Coastal Ocean Research and Monitoring Program +$ DIMAR Direccion General Maritima (Columbia) +$ BP British Petroleum +$ SCALE Scale indicator for plotting of locations on map +$ Point will only be plotted if SCALE =< DX in our +$ GrADS scripts, DX is width of plot in logitude +$ +$ DEptH Depth in meters +$ +$ Notes: +$ +$ - The '$' at the first position identifies comments for WAVEWATCH III +$ input. +$ - The first three data columns are used by the forecats code, the other +$ are used by postprocessing scripts. +$ +$ NE Pacific deep ocean +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -148.02 56.31 '46001 ' 5.0 DAT NDBC 360 + -130.27 42.60 '46002 ' 5.0 DAT NDBC 360 + -136.10 50.93 '46004 ' 5.0 DAT ENCAN 360 + -131.02 46.05 '46005 ' 5.0 DAT NDBC 360 + -137.48 40.80 '46006 ' 5.0 DAT NDBC 360 + -177.58 57.05 '46035 ' 10.0 DAT NDBC 360 + -133.94 48.35 '46036 ' 5.0 DAT ENCAN 360 + -130.00 37.98 '46059 ' 5.0 DAT NDBC 360 + -154.98 52.70 '46066 ' 5.0 DAT NDBC 360 + 175.28 55.00 '46070 ' 5.0 DAT NDBC 360 + -172.03 54.94 '46073 ' 10.0 DAT NDBC 360 + -138.85 53.91 '46184 ' 5.0 DAT ENCAN 360 +$ +$ NE Pacific coastal +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- +$ Alaska +$ + -146.83 60.22 '46061 ' 5.0 DAT NDBC 90 + 179.05 51.16 '46071 ' 5.0 DAT NDBC 360 + -171.73 52.25 '46072 ' 5.0 DAT NDBC 360 + -160.81 53.93 '46075 ' 5.0 DAT NDBC 360 + -148.00 59.50 '46076 ' 5.0 DAT NDBC 360 + -152.45 56.05 '46078 ' 5.0 DAT NDBC 360 + -152.09 59.76 '46106 ' 999 DAT NDBC 75 + -150.00 58.00 '46080 ' 5.0 DAT NDBC 360 + -143.42 59.69 '46082 ' 5.0 DAT NDBC 360 + -138.00 58.25 '46083 ' 5.0 DAT NDBC 360 + -136.16 56.59 '46084 ' 5.0 DAT NDBC 360 + -142.56 56.85 '46085 ' 5.0 DAT NDBC 360 +$ +$ Canada +$ + -127.93 49.74 '46132 ' 5.0 DAT ENCAN 90 + -132.45 54.38 '46145 ' 5.0 DAT ENCAN 45 + -131.22 51.83 '46147 ' 5.0 DAT ENCAN 90 + -131.10 53.62 '46183 ' 5.0 DAT ENCAN 45 + -129.81 52.42 '46185 ' 5.0 DAT ENCAN 45 + -128.75 51.37 '46204 ' 5.0 DAT ENCAN 45 + -134.28 54.16 '46205 ' 5.0 DAT ENCAN 45 + -126.00 48.84 '46206 ' 5.0 DAT ENCAN 45 + -129.92 50.87 '46207 ' 5.0 DAT ENCAN 45 + -132.68 52.52 '46208 ' 5.0 DAT ENCAN 45 +$ +$ USA +$ + -120.87 34.88 '46011 ' 5.0 DAT NDBC 15 + -122.88 37.36 '46012 ' 5.0 DAT NDBC 45 + -123.32 38.23 '46013 ' 5.0 DAT NDBC 25 + -123.97 39.22 '46014 ' 5.0 DAT NDBC 45 + -124.85 42.75 '46015 ' 5.0 DAT NDBC 45 + -124.54 40.78 '46022 ' 5.0 DAT NDBC 25 + -120.97 34.71 '46023 ' 10.0 DAT NDBC 45 + -119.08 33.75 '46025 ' 5.0 DAT NDBC 45 + -122.82 37.75 '46026 ' 5.0 DAT NDBC 25 + -124.38 41.85 '46027 ' 5.0 DAT NDBC 45 + -121.89 35.74 '46028 ' 5.0 DAT NDBC 45 + -124.51 46.12 '46029 ' 5.0 DAT NDBC 45 + -124.53 40.42 '46030 ' 5.0 DAT NDBC 15 + -124.75 47.34 '46041 ' 5.0 DAT NDBC 45 + -122.42 36.75 '46042 ' 5.0 DAT NDBC 45 + -119.53 32.43 '46047 ' 5.0 DAT NDBC 45 + -124.53 44.62 '46050 ' 5.0 DAT NDBC 45 + -119.85 34.24 '46053 ' 5.0 DAT NDBC 45 + -120.45 34.27 '46054 ' 10.0 DAT NDBC 25 + -121.01 35.10 '46062 ' 5.0 DAT NDBC 45 + -120.70 34.27 '46063 ' 5.0 DAT NDBC 45 + -120.20 33.65 '46069 ' 5.0 DAT NDBC 45 + -118.00 32.50 '46086 ' 5.0 DAT NDBC 45 + -124.73 48.49 '46087 ' 5.0 DAT NDBC 45 + -125.77 45.88 '46089 ' 5.0 DAT NDBC 45 + -152.00 59.72 '46108 ' 5.0 DAT NDBC 45 + -124.24 46.86 '46211 ' 999. DAT SCRIPPS 25 +$ -124.31 40.75 '46212 ' 999. DAT SCRIPPS 25 + -124.74 40.29 '46213 ' 999. DAT SCRIPPS 25 + -123.47 37.95 '46214 ' 999. DAT SCRIPPS 45 + -120.86 35.20 '46215 ' 999. DAT SCRIPPS 45 + -119.80 34.33 '46216 ' 999. DAT SCRIPPS 15 + -119.43 34.17 '46217 ' 999. DAT SCRIPPS 15 + -120.78 34.45 '46218 ' 999. DAT SCRIPPS 25 + -119.88 33.22 '46219 ' 999. DAT SCRIPPS 45 + -118.63 33.85 '46221 ' 999. DAT SCRIPPS 15 + -118.32 33.62 '46222 ' 999. DAT SCRIPPS 15 + -117.77 33.46 '46223 ' 999. DAT SCRIPPS 15 + -117.47 33.18 '46224 ' 999. DAT SCRIPPS 15 + -117.39 32.93 '46225 ' 999. DAT SCRIPPS 15 + -117.44 32.63 '46227 ' 999. DAT SCRIPPS 15 + -124.55 43.77 '46229 ' 999. DAT SCRIPPS 25 + -117.37 32.75 '46231 ' 999. DAT SCRIPPS 15 + -117.33 32.43 '46232 ' 999. DAT SCRIPPS 15 + -121.95 36.76 '46236 ' 999. DAT SCRIPPS 15 + -122.60 37.78 '46237 ' 999. DAT SCRIPPS 15 + -119.47 33.40 '46238 ' 999. DAT SCRIPPS 15 + -122.10 36.34 '46239 ' 999. DAT SCRIPPS 15 + -121.91 36.62 '46240 ' 999. DAT SCRIPPS 15 + -124.13 46.22 '46243 ' 999. DAT SCRIPPS 45 + -124.36 40.89 '46244 ' 999. DAT SCRIPPS 45 + -149.09 49.98 '46246 ' 999. DAT SCRIPPS 45 + -124.67 46.13 '46248 ' 999. DAT SCRIPPS 45 +$ + -117.75 32.64 'SGX01 ' 999. VBY NCEP 25 + -116.48 23.62 'EFT1 ' 999. VBY NCEP 25 +$ +$ South America +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -77.50 6.26 '32488 ' 999. DAT DIMAR 45 + -77.74 3.52 '32487 ' 999. DAT DIMAR 45 + -72.22 12.35 '41193 ' 999. DAT DIMAR 120 +$ +$ Japanese buoys +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + 134.90 28.90 '21004 ' 999. XDT JAPAN 360 + 126.30 28.10 '22001 ' 999. XDT JAPAN 360 +$ +$ South Korean buoys +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + 126.02 37.23 '22101 ' 999. DAT SKOREA 100 + 125.77 34.80 '22102 ' 999. DAT SKOREA 100 + 127.50 34.00 '22103 ' 999. DAT SKOREA 100 + 128.90 34.77 '22104 ' 999. DAT SKOREA 100 + 130.00 37.53 '22105 ' 999. DAT SKOREA 100 + 129.78 36.35 '22106 ' 999. DAT SKOREA 100 + 126.33 33.00 '22107 ' 999. DAT SKOREA 100 +$ +$ Hawaii +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -162.21 23.43 '51001 ' 5.0 DAT NDBC 360 + -157.78 17.19 '51002 ' 5.0 DAT NDBC 360 + -160.82 19.22 '51003 ' 5.0 DAT NDBC 360 + -152.48 17.52 '51004 ' 5.0 DAT NDBC 360 + -154.06 23.55 '51000 ' 5.0 DAT NDBC 11 + -153.90 23.56 '51100 ' 5.0 DAT NDBC 11 + -162.06 24.32 '51101 ' 5.0 DAT NDBC 11 + -158.12 21.67 '51201 ' 999. DAT SCRIPPS 11 + -157.68 21.42 '51202 ' 999. DAT SCRIPPS 11 + -157.00 20.79 '51203 ' 999. DAT SCRIPPS 11 + -158.12 21.28 '51204 ' 999. DAT SCRIPPS 11 + -156.42 21.02 '51205 ' 999. DAT SCRIPPS 11 + -154.97 19.78 '51206 ' 999. DAT SCRIPPS 11 + -157.75 21.48 '51207 ' 999. DAT SCRIPPS 11 + -159.574 22.285 '51208 ' 999. DAT SCRIPPS 11 +$ + -158.00 24.00 'HNL01 ' 999. VBY NCEP 360 + -153.00 22.50 'HNL02 ' 999. VBY NCEP 360 + -157.75 22.00 'HNL10 ' 999. VBY NCEP 45 + -158.25 21.00 'HNL11 ' 999. VBY NCEP 45 + -156.50 19.75 'HNL12 ' 999. VBY NCEP 45 +$ +$ Other deep Pacific +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -153.87 0.02 '51028 ' 5.0 DAT NDBC 360 + 144.79 13.35 '52200 ' 999. DAT SCRIPPS 360 + 171.40 7.09 '52201 ' 999. DAT SCRIPPS 360 + 144.80 13.68 '52202 ' 999. DAT SCRIPPS 360 + 145.66 15.27 '52211 ' 999. DAT SCRIPPS 360 +$ +$ NWS forecast points +$ + 143.75 12.00 'GUAM ' 999. VBY NCEP 360 + 147.50 16.00 'SAIPAN ' 999. VBY NCEP 360 + 145.00 14.70 'SAIPAN_W ' 999. VBY NCEP 360 + 145.60 14.30 'SAIPAN_E ' 999. VBY NCEP 360 + 166.50 19.50 'WAKE ' 999. VBY NCEP 360 + 136.25 9.00 'PALAU ' 999. VBY NCEP 360 + 133.90 7.50 'PALAU_W ' 999. VBY NCEP 360 + 134.90 7.70 'PALAU_E ' 999. VBY NCEP 360 + 138.00 9.60 'YAP ' 999. VBY NCEP 360 + 138.40 9.60 'YAP_E ' 999. VBY NCEP 360 + 152.50 8.00 'CHUUK ' 999. VBY NCEP 360 + 151.20 7.40 'CHUUK_W ' 999. VBY NCEP 360 + 152.10 7.60 'CHUUK_E ' 999. VBY NCEP 360 + 157.50 7.00 'POHNPEI ' 999. VBY NCEP 360 + 158.40 7.10 'POHNPEI_E ' 999. VBY NCEP 360 + 163.00 5.10 'KOSRAE ' 999. VBY NCEP 360 + 162.80 5.90 'KOSRAE_W ' 999. VBY NCEP 360 + 167.80 9.50 'KWAJALEIN ' 999. VBY NCEP 360 + 167.50 8.67 'KWAJ_W1 ' 999. VBY NCEP 360 + 167.00 8.67 'KWAJ_W2 ' 999. VBY NCEP 360 + 168.17 8.67 'KWAJ_E ' 999. VBY NCEP 360 + 166.33 9.17 'WOTHO ' 999. VBY NCEP 360 + 168.00 9.17 'ROI_NAMUR ' 999. VBY NCEP 360 + 171.50 9.17 'WOTJE_E ' 999. VBY NCEP 360 + 146.25 -12.00 'NEWGUINE_S' 999. VBY NCEP 360 + 171.25 8.00 'MAJURO ' 999. VBY NCEP 360 + 171.40 7.60 'MAJURO_02 ' 999. VBY NCEP 360 + 171.50 6.60 'MAJURO_03 ' 999. VBY NCEP 360 + 163.75 13.00 'ENEWETAK ' 999. VBY NCEP 360 + -168.75 -15.00 'PAGO_PAGO ' 999. VBY NCEP 360 +$ +$ Pacific training points +$ + -177.40 28.20 'MIDWAY ' 999. VBY NCEP 360 + -169.50 16.70 'JOHNSTON ' 999. VBY NCEP 360 + 176.25 -18.00 'NADI ' 999. VBY NCEP 360 + 179.20 -8.50 'FUNAFUTI ' 999. VBY NCEP 360 + -175.00 -22.00 'TONGATAPU ' 999. VBY NCEP 360 + -159.80 -21.20 'RAROTONGA ' 999. VBY NCEP 360 + 167.50 -24.00 'NOUMEA ' 999. VBY NCEP 360 + 167.50 -18.00 'PORT_VILA ' 999. VBY NCEP 360 + -149.60 -19.00 'PAPEETE ' 999. VBY NCEP 360 + 174.00 1.00 'TARAWA ' 999. VBY NCEP 360 + -169.90 -19.10 'NIUE ' 999. VBY NCEP 360 + -166.30 23.90 'FF_SHOALS ' 999. VBY NCEP 360 + 167.00 -0.50 'NAURU ' 999. VBY NCEP 360 + -171.90 -9.20 'NUKUNONO ' 999. VBY NCEP 360 + 160.00 -12.00 'SOLOMON_SW' 999. VBY NCEP 360 + 165.00 -12.00 'SOLOMON_SE' 999. VBY NCEP 360 + 160.00 -5.00 'SOLOMON_N ' 999. VBY NCEP 360 +$ +$ Virtual points for Indonesia +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- +$ + 102.00 -5.00 'P_ENGGANO ' 999. VBY NCEP 360 + 107.00 0.00 'P_PENJAN ' 999. VBY NCEP 360 + 110.00 -5.00 'SEMARANG ' 999. VBY NCEP 360 + 122.00 -11.00 'P_SAWA ' 999. VBY NCEP 360 + 132.00 1.00 'P_IGI ' 999. VBY NCEP 360 + 133.00 -8.00 'P_JAMDENA ' 999. VBY NCEP 360 + 93.00 6.00 'G_NICOBAR ' 999. VBY NCEP 360 + 100.00 4.00 'P_PANGKOR ' 999. VBY NCEP 100 + 118.00 -1.00 'SULAWESI ' 999. VBY NCEP 360 + 120.00 -7.50 'P_BONARAT ' 999. VBY NCEP 100 + 125.00 -5.00 'P_RUNDUMA ' 999. VBY NCEP 100 + 123.00 3.00 'BORNEO ' 999. VBY NCEP 360 + 126.00 1.00 'P_GUREDA ' 999. VBY NCEP 100 +$ +$ Virtual points for Malaysia +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- +$ + 104.00 6.00 'MALAY01 ' 999. VBY NCEP 100 + 105.00 3.00 'MALAY02 ' 999. VBY NCEP 100 + 110.00 3.00 'MALAY03 ' 999. VBY NCEP 100 + 113.00 5.00 'MALAY04 ' 999. VBY NCEP 100 + 116.00 7.50 'MALAY05 ' 999. VBY NCEP 100 + 117.00 7.50 'MALAY06 ' 999. VBY NCEP 100 +$ +$ Gulf of Mexico and Carabean +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -89.67 25.90 '42001 ' 10.0 DAT NDBC 360 + -94.42 25.17 '42002 ' 10.0 DAT NDBC 360 + -85.94 26.07 '42003 ' 10.0 DAT NDBC 360 + -88.77 30.09 '42007 ' 5.0 DAT NDBC 90 + -95.36 27.91 '42019 ' 5.0 DAT NDBC 90 + -96.70 26.94 '42020 ' 5.0 DAT NDBC 90 + -94.40 29.22 '42035 ' 5.0 DAT NDBC 90 + -84.52 28.50 '42036 ' 5.0 DAT NDBC 90 + -92.55 27.42 '42038 ' 5.0 DAT NDBC 90 + -86.02 28.79 '42039 ' 5.0 DAT NDBC 90 + -87.55 30.06 '42012 ' 5.0 DAT NDBC 90 + -88.21 29.18 '42040 ' 5.0 DAT NDBC 90 + -90.46 27.50 '42041 ' 5.0 DAT NDBC 90 + -88.49 28.19 '42887 ' 48.2 DAT BP 90 +$ + -87.73 26.00 '42054 ' 10.0 XDT NDBC 360 + -94.05 22.01 '42055 ' 10.0 DAT NDBC 360 + -85.06 19.87 '42056 ' 10.0 DAT NDBC 360 + -81.50 16.83 '42057 ' 10.0 DAT NDBC 360 + -75.06 15.09 '42058 ' 10.0 DAT NDBC 360 + -81.95 24.39 '42080 ' 999. DAT NDBC 45 + -84.24 27.34 '42099 ' 999. DAT SCRIPPS 100 +$ + -67.50 15.01 '42059 ' 5.0 DAT NDBC 360 + -63.50 16.50 '42060 ' 5.0 DAT NDBC 360 +$ + -53.08 14.55 '41040 ' 5.0 DAT NDBC 360 + -46.00 14.53 '41041 ' 5.0 DAT NDBC 360 + -57.90 15.90 '41100 ' 5.0 DAT METFR 360 + -56.20 14.60 '41101 ' 5.0 DAT METFR 360 +$ + -81.75 24.00 'EYW01 ' 999. VBY NCEP 90 + -82.25 25.00 'EYW02 ' 999. VBY NCEP 90 +$ + -66.50 19.00 'PUERTO_R_N' 999. VBY NCEP 90 + -66.50 17.50 'PUERTO_R_S' 999. VBY NCEP 90 + -67.50 19.00 'CARCOOS01 ' 999. VBY NCEP 90 + -65.50 19.00 'CARCOOS02 ' 999. VBY NCEP 90 + -64.00 19.00 'CARCOOS03 ' 999. VBY NCEP 90 + -64.40 17.30 'CARCOOS04 ' 999. VBY NCEP 90 + -67.50 17.50 'CARCOOS05 ' 999. VBY NCEP 90 +$ +$ NW Atlantic deep ocean +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -72.66 34.68 '41001 ' 5.0 DAT NDBC 360 + -75.36 32.32 '41002 ' 5.0 DAT NDBC 360 + -79.09 32.50 '41004 ' 5.0 DAT NDBC 360 + -80.87 31.40 '41008 ' 5.0 DAT NDBC 360 + -66.58 41.11 '44011 ' 5.0 DAT NDBC 360 + -62.00 42.26 '44137 ' 5.0 DAT ENCAN 360 + -53.62 44.26 '44138 ' 5.0 DAT ENCAN 360 + -57.08 44.26 '44139 ' 5.0 DAT ENCAN 360 + -51.74 43.75 '44140 ' 5.0 DAT ENCAN 360 + -58.00 43.00 '44141 ' 5.0 DAT ENCAN 360 + -64.02 42.50 '44142 ' 5.0 DAT ENCAN 360 + -64.01 42.50 '44150 ' 5.0 DAT ENCAN 360 + -48.01 46.77 'WRB07 ' 10.0 DAT PRIV 360 +$ +$ NW Atlantic coastal +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -80.17 28.50 '41009 ' 5.0 DAT NDBC 80 + -78.47 28.95 '41010 ' 5.0 DAT NDBC 80 + -80.60 30.00 '41012 ' 5.0 DAT NDBC 80 + -77.74 33.44 '41013 ' 5.0 DAT NDBC 80 + -75.40 35.01 '41025 ' 5.0 DAT NDBC 80 + -77.28 34.48 '41035 ' 5.0 DAT NDBC 80 + -76.95 34.21 '41036 ' 5.0 DAT NDBC 80 + -77.36 33.99 '41037 ' 3.0 DAT CORMP 80 + -77.72 34.14 '41038 ' 3.0 DAT CORMP 80 + -65.01 20.99 '41043 ' 5.0 DAT NDBC 90 + -70.99 24.00 '41046 ' 5.0 DAT NDBC 90 + -71.49 27.47 '41047 ' 10.0 DAT NDBC 90 + -69.65 31.98 '41048 ' 10.0 DAT NDBC 90 + -63.00 27.50 '41049 ' 5.0 DAT NDBC 90 + -58.69 21.65 '41044 ' 5.0 DAT NDBC 90 + -77.30 34.48 '41109 ' 3.0 DAT CORMP 80 + -77.71 34.14 '41110 ' 3.0 DAT CORMP 80 + -67.28 18.38 '41111 ' 3.0 DAT CORMP 80 + -81.29 30.72 '41112 ' 999. DAT SCRIPPS 30 + -80.53 28.40 '41113 ' 999. DAT SCRIPPS 30 + -80.22 27.55 '41114 ' 999. DAT SCRIPPS 30 +$ +$ -75.72 36.20 '44056 ' 999. DAT USACE 90 + -75.78 36.91 '44099 ' 999. DAT SCRIPPS 90 + -75.59 36.26 '44100 ' 999. DAT SCRIPPS 90 + -70.43 38.48 '44004 ' 5.0 DAT NDBC 90 + -69.16 43.19 '44005 ' 5.0 DAT NDBC 90 + -69.43 40.50 '44008 ' 5.0 DAT NDBC 90 + -74.70 38.46 '44009 ' 5.0 DAT NDBC 90 + -74.84 36.61 '44014 ' 5.0 DAT NDBC 90 + -72.10 40.70 '44017 ' 5.0 DAT NDBC 80 + -71.01 41.38 '44070 ' 999. DAT NDBC 60 + -69.29 41.26 '44018 ' 5.0 DAT NDBC 80 + -72.60 39.58 '44066 ' 5.0 DAT NDBC 80 + -65.93 42.31 '44024 ' 4.0 DAT GOMOOS 80 + -73.17 40.25 '44025 ' 5.0 DAT NDBC 80 + -75.492 36.872 '44093 ' 999. DAT SCRIPPS 80 + -75.33 35.75 '44095 ' 999. DAT SCRIPPS 80 + -75.81 36.02 '44096 ' 999. DAT SCRIPPS 80 + -71.12 40.98 '44097 ' 999. DAT SCRIPPS 80 + -70.17 42.80 '44098 ' 999. DAT SCRIPPS 80 + -67.31 44.27 '44027 ' 5.0 DAT NDBC 80 + -67.88 43.49 '44037 ' 4.0 DAT GOMOOS 80 + -66.55 43.62 '44038 ' 4.0 DAT GOMOOS 80 +$ + -53.39 46.44 '44251 ' 5.0 DAT ENCAN 80 + -57.35 47.28 '44255 ' 5.0 DAT ENCAN 80 +$ + -70.25 42.50 'BOX01 ' 999. VBY NCEP 45 + -67.50 44.00 'CAR01 ' 999. VBY NCEP 45 + -77.00 30.75 'CHS01 ' 999. VBY NCEP 80 + -69.75 43.25 'GYX01 ' 999. VBY NCEP 45 + -77.00 34.00 'ILM01 ' 999. VBY NCEP 45 + -78.50 33.25 'ILM02 ' 999. VBY NCEP 45 + -80.25 29.50 'JAX02 ' 999. VBY NCEP 90 + -79.50 27.25 'MLB01 ' 999. VBY NCEP 90 + -79.50 26.25 'MIA01 ' 999. VBY NCEP 80 + -79.75 25.00 'MIA02 ' 999. VBY NCEP 90 +$ +$ NE Atlantic +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- +$ + -5.00 45.20 '62001 ' 3.0 DAT UKMO 360 + -20.00 41.60 '62002 ' 999. DAT UNKNOWN 360 + -12.40 48.70 '62029 ' 3.0 DAT UKMO 360 + -7.90 51.40 '62023 ' 999. DAT UNKNOWN 360 + -5.60 48.50 '62052 ' 999. DAT METFR 100 +$ -1.45 44.65 '62064 ' 999. DAT SHOM 100 + -13.30 51.00 '62081 ' 3.0 DAT UKMO 360 + -11.20 53.13 '62090 ' 4.5 DAT IDT 100 + -5.42 53.47 '62091 ' 4.5 DAT IDT 60 + -10.55 51.22 '62092 ' 4.5 DAT IDT 100 + -9.07 54.67 '62093 ' 4.5 DAT IDT 60 + -6.70 51.69 '62094 ' 4.5 DAT IDT 60 + -15.92 53.06 '62095 ' 4.5 DAT IDT 100 + -2.90 49.90 '62103 ' 14.0 DAT UKMO 360 + -12.36 54.54 '62105 ' 3.0 DAT UKMO 360 + -9.90 57.00 '62106 ' 4.5 DAT UKMO 360 + -6.10 50.10 '62107 ' 14.0 DAT UKMO 360 + -19.50 53.50 '62108 ' 3.0 DAT UKMO 360 + -8.50 47.50 '62163 ' 3.0 DAT UKMO 360 + -4.70 52.30 '62301 ' 3.0 DAT UKMO 25 + -5.10 51.60 '62303 ' 3.0 DAT UKMO 25 + 0.00 50.40 '62305 ' 14.0 DAT UKMO 25 + 2.00 51.40 '62170 ' 999.0 DAT UKMO 25 + -11.40 59.10 '64045 ' 3.0 DAT UKMO 360 + -4.50 60.70 '64046 ' 3.0 DAT UKMO 360 +$ +$ Iceland +$ + -9.26 68.48 '64071 ' 999. DAT UNKNOWN 60 + -23.10 64.05 'TFGSK ' 999. DAT UNKNOWN 60 + -25.00 65.69 'TFBLK ' 999. DAT UNKNOWN 60 +$ -23.36 66.44 'TFSTD ' 999. DAT UNKNOWN 60 +$ -21.12 65.76 'TFDRN ' 999. DAT UNKNOWN 60 + -18.20 66.50 'TFGRS ' 999. DAT UNKNOWN 60 + -13.50 65.65 'TFKGR ' 999. DAT UNKNOWN 60 + -15.20 64.00 'TFHFN ' 999. DAT UNKNOWN 60 + -20.35 63.00 'TFSRT ' 999. DAT UNKNOWN 60 +$ -22.46 63.82 'TFGRV ' 999. DAT UNKNOWN 60 +$ +$ Norwegian Sea +$ + 7.80 64.30 'LF3F ' 999. DAT UNKNOWN 360 + 7.30 65.30 'LF3N ' 999. DAT UNKNOWN 60 + 8.10 66.00 'LF5T ' 999. DAT UNKNOWN 360 + 2.00 66.00 'LDWR ' 999. DAT UNKNOWN 360 +$ +$ North Sea +$ + 1.10 55.30 '62026 ' 999. DAT UNKNOWN 360 + 0.00 57.00 '62109 ' 999. DAT UNKNOWN 25 + 0.40 58.10 '62111 ' 999. DAT UNKNOWN 25 + 1.30 58.70 '62112 ' 999. DAT UNKNOWN 25 + 1.40 57.70 '62116 ' 999. DAT UNKNOWN 360 + 0.00 57.90 '62117 ' 999. DAT UNKNOWN 15 + 0.90 57.70 '62118 ' 999. DAT UNKNOWN 15 + 2.00 57.00 '62119 ' 999. DAT UNKNOWN 25 +$ -3.50 53.80 '62125 ' 999. DAT PRIV 25 +$ -3.60 53.90 '62126 ' 999. DAT UNKNOWN 25 +$ -3.80 54.00 '62135 ' 999. DAT UNKNOWN 25 + 1.40 58.70 '62128 ' 999. DAT UNKNOWN 25 + 2.00 56.40 '62132 ' 999. DAT UNKNOWN 25 + 1.00 57.10 '62133 ' 999. DAT UNKNOWN 15 + 2.10 53.00 '62142 ' 999. DAT PRIV 30 + 1.80 57.70 '62143 ' 999. DAT UNKNOWN 25 + 1.70 53.40 '62144 ' 999. DAT PRIV 45 + 2.80 53.10 '62145 ' 999. DAT PRIV 360 + 2.10 57.10 '62146 ' 999. DAT UNKNOWN 25 + 1.80 57.00 '62152 ' 999. DAT UNKNOWN 25 + 0.50 57.40 '62162 ' 999. DAT UNKNOWN 25 + 0.50 57.20 '62164 ' 999. DAT PRIV 15 + 1.90 51.10 '62304 ' 14.0 DAT UKMO 25 + 1.70 60.60 '63055 ' 999. DAT UNKNOWN 25 + 1.60 59.50 '63056 ' 999. DAT UNKNOWN 25 + 1.50 59.20 '63057 ' 999. DAT UNKNOWN 360 + 1.10 61.20 '63103 ' 999. DAT UNKNOWN 15 + 1.70 60.80 '63108 ' 999. DAT UNKNOWN 15 + 1.50 59.50 '63110 ' 999. DAT PRIV 15 + 1.50 59.50 '63111 ' 10.0 XDT PRIV 0 + 1.00 61.10 '63112 ' 999. DAT PRIV 360 + 1.70 61.00 '63113 ' 999. DAT PRIV 100 + 1.30 61.60 '63115 ' 999. DAT PRIV 25 +$ + 2.30 61.20 'LF3J ' 999. DAT UNKNOWN 25 + 3.70 60.60 'LF4B ' 999. DAT UNKNOWN 360 + 2.20 59.60 'LF4H ' 999. DAT UNKNOWN 25 + 1.90 58.40 'LF4C ' 999. DAT UNKNOWN 25 + 3.20 56.50 'LF5U ' 999. DAT UNKNOWN 60 +$ + 6.33 55.00 'BSH01 ' 999. DAT UNKNOWN 60 + 7.89 54.16 'BSH02 ' 999. DAT UNKNOWN 60 + 8.12 54.00 'BSH03 ' 999. DAT UNKNOWN 60 + 6.58 54.00 'BSH04 ' 999. DAT UNKNOWN 60 + 8.22 54.92 'BSH05 ' 999. DAT UNKNOWN 60 +$ 13.87 54.88 'BSH54 ' 999. DAT UNKNOWN 60 +$ 12.70 54.70 'BSH71 ' 999. DAT UNKNOWN 60 +$ +$ Dutch Stations +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + 3.28 51.99 'EURO ' 999. DAT MVEW 60 + 3.22 53.22 'K13 ' 999. DAT MVEW 25 +$ +$ Barents Sea +$ + 21.10 71.60 '3FYT ' 999. DAT UNKNOWN 360 + 15.50 73.50 'LFB1 ' 999. DAT OCNOR 360 + 30.00 74.00 'LFB2 ' 999. DAT OCNOR 360 +$ +$ Brazil +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -34.567 -8.15 '31052 ' 999. DAT PNBOIA 180 + -43.088 -23.031 '31260 ' 999. DAT PNBOIA 180 + -47.367 -28.5 '31374 ' 999. DAT PNBOIA 180 + -44.933 -25.283 '31051 ' 999. DAT PNBOIA 180 + -51.353 -32.595 '31053 ' 999. DAT PNBOIA 180 + -48.13 -27.70 '31201 ' 999. DAT SCRIPPS 180 + -48.75 -32.00 'RIO_GRANDE' 999. VBY NCEP 360 + -46.25 -28.00 'FLORIPA ' 999. VBY NCEP 360 + -43.75 -25.00 'SANTOS ' 999. VBY NCEP 360 + -38.75 -21.00 'CAMPOS ' 999. VBY NCEP 360 + -42.187 -22.994 'SIODOC ' 999. VBY NCEP 360 + -44.270 -23.42 'ILHAGRANDE' 999. VBY NCEP 360 + -43.46 -23.16 'RECREIO ' 999. VBY NCEP 360 + -43.12 -23.11 'CAGARRAS ' 999. VBY NCEP 360 + -36.25 -13.00 'SALVADOR ' 999. VBY NCEP 360 + -32.50 -8.00 'RECIFE ' 999. VBY NCEP 360 + -36.25 -3.00 'FORTALEZA ' 999. VBY NCEP 360 + -47.50 3.00 'AMAZON ' 999. VBY NCEP 360 + -30.00 1.00 'PETER_PAUL' 999. VBY NCEP 360 +$ +$ Peru/Chile Basin +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -85.38 -19.62 '32012' 999. DAT WHOI 360 +$ +$ South Africa +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + 22.17 -34.97 'AGULHAS_FA' 10.0 DAT PRIV 360 +$ +$ Australia +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- +$ 141.75 -12.68 '52121 ' 999. DAT UNKNOWN 50 +$ 150.34 -35.71 '55014 ' 999. DAT UNKNOWN 50 +$ 153.73 -28.69 '55017 ' 999. DAT UNKNOWN 10 +$ 153.27 -30.35 '55018 ' 999. DAT UNKNOWN 10 +$ 152.86 -31.83 '55019 ' 999. DAT UNKNOWN 50 + 150.18 -37.29 '55020 ' 999. DAT UNKNOWN 50 +$ 151.03 -34.48 '55022 ' 999. DAT UNKNOWN 50 +$ 151.42 -33.77 '55024 ' 999. DAT UNKNOWN 50 +$ 151.32 -33.90 '55025 ' 999. DAT UNKNOWN 10 +$ 145.01 -42.08 '55026 ' 999. DAT UNKNOWN 50 +$ 145.71 -16.73 '55028 ' 999. DAT UNKNOWN 50 +$ 147.06 -19.16 '55029 ' 999. DAT UNKNOWN 50 +$ 149.55 -21.04 '55031 ' 999. DAT UNKNOWN 50 +$ 149.31 -21.27 '55032 ' 999. DAT UNKNOWN 15 + 151.07 -23.31 '55033 ' 999. DAT UNKNOWN 50 +$ 153.20 -27.25 '55034 ' 999. DAT UNKNOWN 10 + 153.63 -27.49 '55035 ' 999. DAT UNKNOWN 50 +$$ 153.44 -27.96 '55036 ' 999. DAT UNKNOWN 10 +$ 153.58 -28.18 '55037 ' 999. DAT UNKNOWN 10 + 148.19 -38.60 '55039 ' 999. DAT UNKNOWN 50 +$ 136.62 -36.07 '55040 ' 999. DAT UNKNOWN 50 + 116.14 -19.59 '56002 ' 999. DAT UNKNOWN 120 +$ 114.91 -30.29 '56004 ' 999. DAT UNKNOWN 50 + 115.40 -32.11 '56005 ' 999. DAT UNKNOWN 50 + 114.78 -33.36 '56006 ' 999. DAT UNKNOWN 120 + 114.94 -21.41 '56007 ' 999. DAT UNKNOWN 50 + 121.90 -34.00 '56010 ' 999. DAT UNKNOWN 50 +$ 117.72 -35.20 '56011 ' 999. DAT UNKNOWN 50 + 114.10 -21.70 '56012 ' 999. DAT UNKNOWN 50 +$ 115.69 -31.98 '56008 ' 999. DAT UNKNOWN 25 + 136.20 -36.10 'CADUCOU ' 999. VBY UNKNOWN 120 + 139.00 -38.00 'SWROBE ' 999. VBY UNKNOWN 120 + 142.45 -39.20 'WBAST1 ' 999. VBY UNKNOWN 120 + 141.50 -40.00 'WBAST2 ' 999. VBY UNKNOWN 120 + 151.00 -40.00 'EBAST ' 999. VBY UNKNOWN 120 + 146.50 -40.50 'CBAST ' 999. VBY UNKNOWN 120 + 144.60 -42.30 'CSORRELL ' 999. VBY UNKNOWN 120 + 144.50 -40.10 'SEKING ' 999. VBY UNKNOWN 120 + 143.80 -39.20 'NKING ' 999. VBY UNKNOWN 120 + 144.85 -38.60 'PNEPEAN ' 999. VBY UNKNOWN 120 + 147.40 -39.20 'EHOGAN ' 999. VBY UNKNOWN 120 + 147.00 -44.00 'STHSEC ' 999. VBY UNKNOWN 120 + 149.50 -41.50 'EBICHENO ' 999. VBY UNKNOWN 120 + 133.50 -33.50 'WCAPYORK ' 999. VBY UNKNOWN 120 + 114.617 -19.785 'JANSZ ' 999. VBY UNKNOWN 120 +$ +$ India +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + 72.49 17.02 '23092 ' 999. DAT UNKNOWN 20 + 73.75 15.40 '23093 ' 999. DAT UNKNOWN 120 + 74.50 12.94 '23094 ' 999. DAT UNKNOWN 120 + 80.39 13.19 '23096 ' 999. DAT UNKNOWN 120 + 69.24 15.47 '23097 ' 999. DAT UNKNOWN 360 + 72.51 10.65 '23098 ' 999. DAT UNKNOWN 360 + 90.74 12.14 '23099 ' 999. DAT UNKNOWN 360 + 87.56 18.35 '23100 ' 999. DAT UNKNOWN 120 + 83.27 13.97 '23101 ' 999. DAT UNKNOWN 360 + 85.00 12.60 '23167 ' 999. DAT UNKNOWN 360 + 87.50 15.00 '23168 ' 999. DAT UNKNOWN 360 + 90.14 18.13 '23169 ' 999. DAT UNKNOWN 360 + 72.66 8.33 '23170 ' 999. DAT UNKNOWN 360 + 70.00 11.02 '23171 ' 999. DAT UNKNOWN 360 + 72.00 12.50 '23172 ' 999. DAT UNKNOWN 360 + 78.57 8.21 '23173 ' 999. DAT UNKNOWN 120 + 81.53 11.57 '23174 ' 999. DAT UNKNOWN 360 + 91.66 10.52 '23451 ' 999. DAT UNKNOWN 120 + 89.04 10.97 '23455 ' 999. DAT UNKNOWN 120 + 86.98 9.99 '23456 ' 999. DAT UNKNOWN 120 + 70.10 5.16 '23491 ' 999. DAT UNKNOWN 120 + 68.08 13.89 '23492 ' 999. DAT UNKNOWN 120 + 66.98 11.12 '23493 ' 999. DAT UNKNOWN 120 + 75.00 6.46 '23494 ' 999. DAT UNKNOWN 120 + 68.97 7.13 '23495 ' 999. DAT UNKNOWN 120 +$ +$ Red Sea +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- +$ 38.50 23.16 '23020 ' 999. DAT UNKNOWN 120 +$ +$ Spain +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -3.03 43.63 '62024 ' 999. DAT PDES 25 +$ -6.17 43.73 '62025 ' 999. DAT PDES 25 + -7.62 44.07 '62082 ' 999. DAT PDES 25 +$ -9.22 43.48 '62083 ' 999. DAT PDES 25 + -9.40 42.12 '62084 ' 999. DAT PDES 25 + -6.97 36.48 '62085 ' 999. DAT PDES 25 +$ +$ Mediteranean Sea +$ +$ 3.65 41.92 '61196 ' 999. DAT PDES 25 +$ 4.42 39.72 '61197 ' 999. DAT PDES 25 +$ -2.33 36.57 '61198 ' 999. DAT PDES 25 +$ -5.03 36.23 '61199 ' 999. DAT PDES 25 +$ 1.47 40.77 '61280 ' 999. DAT PDES 25 +$ 0.21 39.52 '61281 ' 999. DAT PDES 25 +$ -0.32 37.65 '61417 ' 999. DAT PDES 25 +$ 2.10 39.55 '61430 ' 999. DAT PDES 25 +$ 7.80 43.40 '61001 ' 999. DAT METFR 25 +$ 4.70 42.10 '61002 ' 999. DAT METFR 25 +$ +$ Canary Islands +$ + -15.82 28.18 '13130 ' 999. DAT PDES 25 + -16.58 28.00 '13131 ' 999. DAT PDES 25 +$ +$ Africa +$ +$ 57.70 -20.45 'MAUR01 ' 999. DAT WMO 360 +$ 57.75 -20.10 'MAUR02 ' 999. DAT WMO 360 +$ 55.00 -25.00 'V14003 ' 999. VBY WMO 360 +$ 60.00 -25.00 'V14004 ' 999. VBY WMO 360 +$ 57.00 -20.00 'V14005 ' 999. VBY WMO 360 +$ 60.00 -20.00 'V14006 ' 999. VBY WMO 360 +$ 63.00 -20.00 'V14007 ' 999. VBY WMO 360 +$ 64.00 -19.00 'V14008 ' 999. VBY WMO 360 +$ 58.00 -18.00 'V14009 ' 999. VBY WMO 360 +$ 60.00 -16.00 'V14010 ' 999. VBY WMO 360 +$ 56.00 -10.00 'V14011 ' 999. VBY WMO 360 +$ 57.00 -11.00 'V14012 ' 999. VBY WMO 360 +$ 70.00 -25.00 'V14013 ' 999. VBY WMO 360 +$ 80.00 -25.00 'V14014 ' 999. VBY WMO 360 +$ 90.00 -25.00 'V53015 ' 999. VBY WMO 360 +$ 70.00 -15.00 'V14016 ' 999. VBY WMO 360 +$ 80.00 -15.00 'V14017 ' 999. VBY WMO 360 +$ 90.00 -15.00 'V53018 ' 999. VBY WMO 360 +$ 65.00 -5.00 'V23019 ' 999. VBY WMO 360 +$ 75.00 -5.00 'V23020 ' 999. VBY WMO 360 +$ 85.00 -5.00 'V23021 ' 999. VBY WMO 360 +$ 95.00 -5.00 'V23022 ' 999. VBY WMO 360 +$ 55.00 -5.00 'V14023 ' 999. VBY WMO 360 +$ 10.929 -17.328 'V14039 ' 999. VBY WMO 360 +$ 10.953 -18.097 'V14040 ' 999. VBY WMO 360 +$ 11.681 -19.001 'V14041 ' 999. VBY WMO 360 +$ 12.250 -20.069 'V14042 ' 999. VBY WMO 360 +$ 12.653 -20.967 'V14043 ' 999. VBY WMO 360 +$ 13.223 -21.930 'V14044 ' 999. VBY WMO 360 +$ 13.418 -22.624 'V14045 ' 999. VBY WMO 360 +$ 13.584 -23.613 'V14046 ' 999. VBY WMO 360 +$ 13.659 -24.375 'V14047 ' 999. VBY WMO 360 +$ 13.951 -25.245 'V14048 ' 999. VBY WMO 360 +$ 14.032 -26.084 'V14049 ' 999. VBY WMO 360 +$ 14.191 -26.728 'V14050 ' 999. VBY WMO 360 +$ 14.536 -27.593 'V14051 ' 999. VBY WMO 360 +$ 14.968 -28.341 'V14052 ' 999. VBY WMO 360 +$ 15.676 -29.085 'V14053 ' 999. VBY WMO 360 +$ 39.750 -5.000 'V14054 ' 999. VBY WMO 360 +$ 39.750 -5.583 'V14055 ' 999. VBY WMO 360 +$ 39.750 -6.217 'V14056 ' 999. VBY WMO 360 +$ 39.800 -6.750 'V14057 ' 999. VBY WMO 360 +$ 39.917 -7.083 'V14058 ' 999. VBY WMO 360 +$ 39.750 -7.300 'V14059 ' 999. VBY WMO 360 +$ 39.750 -8.167 'V14060 ' 999. VBY WMO 360 +$ 40.250 -8.833 'V14061 ' 999. VBY WMO 360 +$ 40.250 -9.167 'V14062 ' 999. VBY WMO 360 +$ 40.250 -9.917 'V14063 ' 999. VBY WMO 360 +$ 40.583 -10.333 'V14064 ' 999. VBY WMO 360 +$ 42.000 -11.000 'V14065 ' 999. VBY WMO 360 +$ 42.000 -12.000 'V14066 ' 999. VBY WMO 360 +$ 42.000 -13.000 'V14067 ' 999. VBY WMO 360 +$ 42.000 -14.000 'V14068 ' 999. VBY WMO 360 +$ 42.000 -15.000 'V14069 ' 999. VBY WMO 360 +$ 40.250 -17.000 'V14070 ' 999. VBY WMO 360 +$ 39.000 -17.833 'V14071 ' 999. VBY WMO 360 +$ 38.250 -18.000 'V14072 ' 999. VBY WMO 360 +$ 37.250 -19.000 'V14073 ' 999. VBY WMO 360 +$ 35.500 -20.000 'V14074 ' 999. VBY WMO 360 +$ 36.000 -21.000 'V14075 ' 999. VBY WMO 360 +$ 35.567 -21.917 'V14076 ' 999. VBY WMO 360 +$ 35.583 -22.000 'V14077 ' 999. VBY WMO 360 +$ 42.833 -22.000 'V14078 ' 999. VBY WMO 360 +$ 36.000 -23.000 'V14079 ' 999. VBY WMO 360 +$ 36.833 -24.000 'V14080 ' 999. VBY WMO 360 +$ 36.000 -25.000 'V14081 ' 999. VBY WMO 360 +$ 35.000 -25.500 'V14082 ' 999. VBY WMO 360 +$ 34.000 -26.000 'V14083 ' 999. VBY WMO 360 +$ 34.000 -27.000 'V14084 ' 999. VBY WMO 360 +$ +$ TPC and OPC +$ +$ LON LAT NAME AH TYPE SOURCE SCALE +$ --------------------------------------------------------- + -85.00 -15.00 'TPC01 ' 999. VBY NCEP 360 + -110.00 -15.00 'TPC02 ' 999. VBY NCEP 360 + -135.00 -15.00 'TPC03 ' 999. VBY NCEP 360 + -93.75 0.00 'TPC04 ' 999. VBY NCEP 360 +$ + -55.00 15.00 'TPC20 ' 999. VBY NCEP 360 + -63.00 15.00 'TPC21 ' 999. VBY NCEP 360 + -77.00 12.00 'TPC22 ' 999. VBY NCEP 360 + -80.00 15.00 'TPC23 ' 999. VBY NCEP 360 + -76.00 22.00 'TPC24 ' 999. VBY NCEP 360 + -80.00 24.00 'TPC25 ' 999. VBY NCEP 360 + -86.00 23.00 'TPC26 ' 999. VBY NCEP 360 +$ + -118.00 30.00 'TPC50 ' 999. VBY NCEP 360 + -135.00 20.00 'TPC51 ' 999. VBY NCEP 360 + -117.00 20.00 'TPC52 ' 999. VBY NCEP 360 + -120.00 6.00 'TPC53 ' 999. VBY NCEP 360 + -95.00 15.00 'TPC54 ' 999. VBY NCEP 360 + -88.00 9.00 'TPC55 ' 999. VBY NCEP 360 + -80.00 6.00 'TPC56 ' 999. VBY NCEP 360 +$ + -130.50 48.10 'OPCP01 ' 999. VBY NCEP 45 + -126.60 48.10 'OPCP02 ' 999. VBY NCEP 45 + -129.70 45.30 'OPCP03 ' 999. VBY NCEP 45 + -125.60 45.30 'OPCP04 ' 999. VBY NCEP 45 + -129.90 41.75 'OPCP05 ' 999. VBY NCEP 45 + -125.80 41.90 'OPCP06 ' 999. VBY NCEP 45 + -129.00 38.50 'OPCP07 ' 999. VBY NCEP 45 + -125.50 39.20 'OPCP08 ' 999. VBY NCEP 45 + -125.40 36.40 'OPCP09 ' 999. VBY NCEP 45 + -125.00 33.30 'OPCP10 ' 999. VBY NCEP 45 + -122.30 34.60 'OPCP11 ' 999. VBY NCEP 45 + -121.50 30.90 'OPCP12 ' 999. VBY NCEP 45 + -117.00 29.60 'OPCP13 ' 999. VBY NCEP 45 +$ + -67.70 42.35 'OPCA01 ' 999. VBY NCEP 45 + -72.00 39.30 'OPCA02 ' 999. VBY NCEP 45 + -65.70 39.30 'OPCA03 ' 999. VBY NCEP 45 + -70.10 37.30 'OPCA04 ' 999. VBY NCEP 45 + -74.60 36.30 'OPCA05 ' 999. VBY NCEP 45 + -73.80 35.60 'OPCA06 ' 999. VBY NCEP 45 + -70.80 34.90 'OPCA07 ' 999. VBY NCEP 45 + -76.00 33.80 'OPCA08 ' 999. VBY NCEP 45 + -72.30 32.80 'OPCA09 ' 999. VBY NCEP 45 +$ +$ WAM AFOS locations +$ +$ -72.5 35.0 'ZNT41 ' 999. VBY NCEP 0 +$ -70.0 37.5 'ZNT42 ' 999. VBY NCEP 0 +$ -67.5 40.0 'ZNT43 ' 999. VBY NCEP 0 +$ -85.0 25.0 'ZNT45 ' 999. VBY NCEP 0 +$ -125.0 47.5 'ZPZ41 ' 999. VBY NCEP 0 +$ -125.0 45.0 'ZPZ42 ' 999. VBY NCEP 0 +$ -130.0 42.5 'ZPZ43 ' 999. VBY NCEP 0 +$ -122.5 35.0 'ZPZ44 ' 999. VBY NCEP 0 +$ -120.0 32.5 'ZPZ45 ' 999. VBY NCEP 0 +$ -122.5 27.5 'ZPZ46 ' 999. VBY NCEP 0 +$ +$ --------------------------------------------------------------- +$ End of list +$ +$ --------------------------------------------------------------- +$ + 0.00 0.00 'STOPSTRING' 999. XXX NCEP 0 $ $ Type 3 : Output along track. $ Flag for formatted input file. $ The data files are track_i.ww3 and $ track_o.ww3, see w3iotr.ftn for ad. doc. $ - 0 -$ T + @[RUN_BEG] 0 @[RUN_END] $ $ Type 4 : Restart files (no additional data required). $ The data file is restartN.ww3, see $ w3iors.ftn for additional doc. +$ Flag for second restart (data server mode) +$ Flag for extra fields in the restart file (coupling restart) $ - -$ -$ Type 5 : Boundary data (no additional data required). -$ The data file is nestN.ww3, see -$ w3iobcmd.ftn for additional doc. +$ Keep next two lines formatting as is to allow proper parsing + @[RUN_BEG] 0 @[RUN_END] T + @[RST_BEG] @[RST_DT] @[RST_END] $ - 0 + @[RUN_BEG] 0 @[RUN_END] $ -$ Type 6 : Separated wave field data (dummy for now). -$ First, last step IX and IY, flag for formatted file + @[RUN_BEG] 0 @[RUN_END] $ - 0 - 0 999 1 0 999 1 T + 'the_end' 0 $ -$ Homogeneous field data --------------------------------------------- $ -$ Homogeneous fields can be defined by a list of lines containing an ID -$ string 'LEV' 'CUR' 'WND', date and time information (yyyymmdd -$ hhmmss), value (S.I. units), direction (current and wind, oceanogr. -$ convention degrees)) and air-sea temparature difference (degrees C). -$ 'STP' is mandatory stop string. -$ Also defined here are the speed with which the grid is moved -$ continuously, ID string 'MOV', parameters as for 'CUR'. + 'STP' $ -$ 'LEV' 19680606 010000 1.00 -$ 'CUR' 19680606 073125 2.0 25. -$ 'WND' 19680606 000000 20. 145. 2.0 -$ 'MOV' 19680606 013000 4.0 25. - 'STP' -$ -$ -------------------------------------------------------------------- $ -$ End of input file $ -$ -------------------------------------------------------------------- $ +$ End of input file diff --git a/rocoto/cronjob_h3bs_vida.sh b/rocoto/cronjob_h3bs_vida.sh index 627873b08..e2914a2e4 100755 --- a/rocoto/cronjob_h3bs_vida.sh +++ b/rocoto/cronjob_h3bs_vida.sh @@ -2,34 +2,13 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" +scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # h3db_vidacycst: atm_init+atm_vi+fgat+3denvar+anal_merge and cycling storm @@ -198,13 +177,13 @@ EXPT=$(basename ${HOMEhafs}) confopts="${conf_h3bs_vida}" # Technical testing - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ + ./run_hafs.py ${opts} 2020082506-2020082512 13L HISTORY ${confopts} \ config.NHRS=12 config.scrub_work=no config.scrub_com=no # Storms to run: Laura13L2020, Ida09L2021, Sam18L2021 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} +#./run_hafs.py ${opts} 2020081918-2020082718 13L HISTORY ${confopts} +#./run_hafs.py ${opts} 2021082612-2021083012 09L HISTORY ${confopts} +#./run_hafs.py ${opts} 2021092300-2021100500 18L HISTORY ${confopts} #=============================================================================== diff --git a/rocoto/cronjob_hafs.sh b/rocoto/cronjob_hafs.sh index c94c25663..41f0eff7d 100755 --- a/rocoto/cronjob_hafs.sh +++ b/rocoto/cronjob_hafs.sh @@ -2,47 +2,25 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" #=============================================================================== # Here are some simple examples, more examples can be seen in cronjob_hafs_rt.sh # Run all cycles of a storm -#${PYTHON3} ./run_hafs.py ${dev} 2020 13L HISTORY config.EXPT=${EXPT} # Laura +#./run_hafs.py ${opts} 2020 13L HISTORY config.EXPT=${EXPT} # Laura # Run specified cycles of a storm -#${PYTHON3} ./run_hafs.py ${dev} 2020082506-2020082512 13L HISTORY \ +#./run_hafs.py ${opts} 2020082506-2020082512 13L HISTORY \ # config.EXPT=${EXPT} config.SUBEXPT=${EXPT} # Laura # Run one cycle of a storm - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY config.EXPT=${EXPT} + ./run_hafs.py ${opts} 2020082512 13L HISTORY config.EXPT=${EXPT} #=============================================================================== diff --git a/rocoto/cronjob_hafs_cdeps.sh b/rocoto/cronjob_hafs_cdeps.sh index 980d372df..170a2761b 100755 --- a/rocoto/cronjob_hafs_cdeps.sh +++ b/rocoto/cronjob_hafs_cdeps.sh @@ -2,54 +2,33 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -#NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" +scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # Here are some simple examples, more examples can be seen in cronjob_hafs_rt.sh # Run data atmosphere with ERA5 -${PYTHON3} ./run_hafs.py -t ${dev} 2019082900 00L HISTORY config.EXPT=${EXPT} \ + ./run_hafs.py ${opts} 2019082900 00L HISTORY config.EXPT=${EXPT} \ config.SUBEXPT=${EXPT}_era5 \ forecast.output_history=.true. \ ../parm/hafs_regional_static.conf ../parm/hafs_hycom.conf \ ../parm/hafs_datm.conf ../parm/hafs_datm_era5.conf # Run data ocean with OISST -${PYTHON3} ./run_hafs.py -t ${dev} 2019082900 00L HISTORY config.EXPT=${EXPT} \ + ./run_hafs.py ${opts} 2019082900 00L HISTORY config.EXPT=${EXPT} \ config.SUBEXPT=${EXPT}_oisst \ forecast.output_history=.true. \ ../parm/hafs_regional_static.conf \ ../parm/hafs_docn.conf ../parm/hafs_docn_oisst.conf # Run data ocean with GHRSST -${PYTHON3} ./run_hafs.py -t ${dev} 2019082900 00L HISTORY config.EXPT=${EXPT} \ + ./run_hafs.py ${opts} 2019082900 00L HISTORY config.EXPT=${EXPT} \ config.SUBEXPT=${EXPT}_ghrsst \ forecast.output_history=.true. \ ../parm/hafs_regional_static.conf \ diff --git a/rocoto/cronjob_hafs_cpl.sh b/rocoto/cronjob_hafs_cpl.sh index b380884bc..f261b54ec 100755 --- a/rocoto/cronjob_hafs_cpl.sh +++ b/rocoto/cronjob_hafs_cpl.sh @@ -2,34 +2,14 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" +scrubopt="config.scrub_work=no config.scrub_com=no" + confopts="forecast.write_dopost=.true. \ forecast.output_history=.true. \ config.run_emcgraphics=no \ @@ -96,12 +76,12 @@ confopts="forecast.write_dopost=.true. \ forecast.cpl_atm_wav=nuopc_sidebyside \ ${confopts}" - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2o2a_a2w2a} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2o2a_a2w} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2o_a2w2a} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2o_a2w} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_abo_abw} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_nuopc_abo_abw} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2o2a_a2w2a} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2o2a_a2w} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2o_a2w2a} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2o_a2w} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_abo_abw} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_nuopc_abo_abw} #=============================================================================== # atm-ocn coupling @@ -154,12 +134,12 @@ confopts="forecast.write_dopost=.true. \ forecast.cpl_atm_ocn=nuopc_bilinear \ ${confopts}" - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2o2a} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2o} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_o2a} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_abo} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_nuopc_abo} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_nuopc_a2o2a} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2o2a} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2o} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_o2a} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_abo} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_nuopc_abo} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_nuopc_a2o2a} #=============================================================================== # atm-wav coupling @@ -192,10 +172,10 @@ confopts="forecast.write_dopost=.true. \ forecast.cpl_atm_wav=cmeps_sidebyside \ ${confopts}" - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2w2a} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_a2w} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_w2a} - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506 00L HISTORY ${conf_abw} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2w2a} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_a2w} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_w2a} + ./run_hafs.py ${opts} 2020082506 00L HISTORY ${conf_abw} #=============================================================================== diff --git a/rocoto/cronjob_hafs_ensda_eps.sh b/rocoto/cronjob_hafs_ensda_eps.sh index 0c3a11e37..c9e2213d4 100755 --- a/rocoto/cronjob_hafs_ensda_eps.sh +++ b/rocoto/cronjob_hafs_ensda_eps.sh @@ -2,48 +2,24 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -# HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/hafsv0p3e_20220429 - #dev="-s sites/xjet.ent -f" -# dev="-s sites/xjet_ensda_eps.ent -f" -# PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion -HOMEhafs=/work2/noaa/hurricane/save/${USER}/H222_ensemble - #dev="-s sites/orion.ent -f" -dev="-s sites/orion_ensda_eps.ent -f" -PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" +scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # ensda_eps: fgat+3denvar+enkf confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_ensda_eps \ ../parm/hafs_2022_regional_ensda_eps_AL.conf" - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082518 00L HISTORY ${confopts} \ + ./run_hafs.py ${opts} 2020082506-2020082518 00L HISTORY ${confopts} \ config.NHRS=120 config.ENS_SIZE=20 config.scrub_work=no config.scrub_com=no \ forecast.write_group=1 \ forecast.write_tasks_per_group=20 \ - #=============================================================================== date diff --git a/rocoto/cronjob_hafs_mvnest.sh b/rocoto/cronjob_hafs_mvnest.sh index 127bf1df8..2e14f4b02 100755 --- a/rocoto/cronjob_hafs_mvnest.sh +++ b/rocoto/cronjob_hafs_mvnest.sh @@ -2,61 +2,39 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -# HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -# dev="-s sites/hera.ent -f" -# PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # Example hafs moving nest experiments - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96_regional_1mvnest_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C96_regional_1mvnest_storm.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C512_regional_1mvnest_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C512_regional_1mvnest_storm.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C512_regional_1mvnest_atm_ocn \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C512_regional_1mvnest_storm.conf \ ../parm/hafsv0p3_hycom.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C192_global_1mvnest_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C192_global_1mvnest_storm.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C768_global_1mvnest_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C768_global_1mvnest_storm.conf diff --git a/rocoto/cronjob_hafs_mvnest_vida.sh b/rocoto/cronjob_hafs_mvnest_vida.sh deleted file mode 100755 index dbfefa02e..000000000 --- a/rocoto/cronjob_hafs_mvnest_vida.sh +++ /dev/null @@ -1,236 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - # mvnest_vidacycst: atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm - conf_mvnest_vidacycst="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest_vidacycst \ - config.run_atm_init=yes config.run_atm_init_fgat=yes config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=yes config.run_atm_vi_fgat=yes config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ - config.gsi_d01=no config.gsi_d02=yes \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=yes config.run_analysis_merge_ens=no \ - vi.vi_storm_env=pert \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # mvnest_vida: atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm perturbation - conf_mvnest_vida="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest_vida \ - config.run_atm_init=yes config.run_atm_init_fgat=yes config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=yes config.run_atm_vi_fgat=yes config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ - config.gsi_d01=no config.gsi_d02=yes \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=yes config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # mvnest_dacycst: atm_init+atm_merge+fgat+d02_3denvar+anal_merge and cycling storm - conf_mvnest_dacycst="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest_dacycst \ - config.run_atm_init=yes config.run_atm_init_fgat=yes config.run_atm_init_ens=no \ - config.run_atm_merge=yes config.run_atm_merge_fgat=yes config.run_atm_merge_ens=no \ - config.run_atm_vi=no config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ - config.gsi_d01=no config.gsi_d02=yes \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=yes config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # mvnest_dacycdm: atm_init+atm_merge+fgat+d02_3denvar+anal_merge and cycling domain - conf_mvnest_dacycdm="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest_dacycdm \ - config.run_atm_init=yes config.run_atm_init_fgat=yes config.run_atm_init_ens=no \ - config.run_atm_merge=yes config.run_atm_merge_fgat=yes config.run_atm_merge_ens=no \ - config.run_atm_vi=no config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ - config.gsi_d01=yes config.gsi_d02=yes \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=yes config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=domainmerge analysis_merge.analysis_merge_method=domainmerge \ - config.NHRS=126 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # mvnest_vicycst: atm_init+atm_vi+anal_merge and cycling storm - conf_mvnest_vicycst="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest_vicycst \ - config.run_atm_init=yes config.run_atm_init_fgat=no config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=yes config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=no config.run_fgat=no config.run_envar=no \ - config.gsi_d01=no config.gsi_d02=no \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=yes config.run_analysis_merge_ens=no \ - vi.vi_storm_env=pert \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # mvnest_vi: atm_init+atm_vi+anal_merge and cycling storm perturbation - conf_mvnest_vi="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest_vi \ - config.run_atm_init=yes config.run_atm_init_fgat=no config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=yes config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=no config.run_fgat=no config.run_envar=no \ - config.gsi_d01=no config.gsi_d02=no \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=yes config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # mvnest_init: warmstart from the coldstart atm_init (initialized from gfs analysis) - conf_mvnest_init="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest_init \ - config.run_atm_init=yes config.run_atm_init_fgat=no config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=no config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=no config.run_fgat=no config.run_envar=no \ - config.gsi_d01=no config.gsi_d02=no \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=no config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - forecast.restart_interval=240 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # mvnest: coldstart from gfs analysis - conf_mvnest="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_mvnest \ - config.run_atm_init=no config.run_atm_init_fgat=no config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=no config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=no config.run_fgat=no config.run_envar=no \ - config.gsi_d01=no config.gsi_d02=no \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=no config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - forecast.restart_interval=240 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - - # Choose the configuration to run -#confopts="${conf_mvnest_vidacycst}" -#confopts="${conf_mvnest_vida}" -#confopts="${conf_mvnest_dacycst}" -#confopts="${conf_mvnest_dacycdm}" -#confopts="${conf_mvnest_vicycst}" -#confopts="${conf_mvnest_vi}" -#confopts="${conf_mvnest_init}" -#confopts="${conf_mvnest}" - - confopts="${conf_mvnest_vida}" - # Technical testing - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ - config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092818 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafs_regional_AL_da6km.sh b/rocoto/cronjob_hafs_regional_AL_da6km.sh index 9ceec1ee8..bf4ee3822 100755 --- a/rocoto/cronjob_hafs_regional_AL_da6km.sh +++ b/rocoto/cronjob_hafs_regional_AL_da6km.sh @@ -2,34 +2,13 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" +scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== @@ -55,31 +34,31 @@ EXPT=$(basename ${HOMEhafs}) confopts="${confh2db}" # Technical test for 2020082506-2020082512 13L2020 - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082518 00L HISTORY ${confopts} \ + ./run_hafs.py ${opts} 2020082506-2020082518 00L HISTORY ${confopts} \ config.NHRS=12 config.scrub_work=no config.scrub_com=no ## 2021 NATL storm slots -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080100-2021100600 00L HISTORY ${confopts} # +#./run_hafs.py ${opts} 2021080100-2021100600 00L HISTORY ${confopts} # ## 2020 NATL storm slots -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 00L HISTORY ${confopts} # Slot 1.0: 03L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 00L HISTORY ${confopts} # Slot 1.1: 04L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 00L HISTORY ${confopts} # Slot 1.2: 05L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 00L HISTORY ${confopts} # Slot 1.3: 06L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072618 00L HISTORY ${confopts} # Slot 1.4: 07L, 08L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 00L HISTORY ${confopts} # Slot 2: 09L, 10L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 00L HISTORY ${confopts} # Slot 3: 11L, 12L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 00L HISTORY ${confopts} # Slot 4: 13L, 14L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 00L HISTORY ${confopts} # Slot 5: 15L, 16L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091118 00L HISTORY ${confopts} # Slot 6: 17Lp1, 18Lp1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091200-2020092300 00L HISTORY ${confopts} # Slot 7: 17Lp2, 18Lp2, 19-24L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100212-2020101018 00L HISTORY ${confopts} # Slot 8: 25L, 26L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102912 00L HISTORY ${confopts} # Slot 9: 27L, 28L -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102912 00L HISTORY ${confopts} # Slot 10: 29-31L # No GFSv16 version input data +#./run_hafs.py ${opts} 2020060112-2020060812 00L HISTORY ${confopts} # Slot 1.0: 03L +#./run_hafs.py ${opts} 2020062112-2020062406 00L HISTORY ${confopts} # Slot 1.1: 04L +#./run_hafs.py ${opts} 2020070400-2020070612 00L HISTORY ${confopts} # Slot 1.2: 05L +#./run_hafs.py ${opts} 2020070912-2020071100 00L HISTORY ${confopts} # Slot 1.3: 06L +#./run_hafs.py ${opts} 2020072112-2020072618 00L HISTORY ${confopts} # Slot 1.4: 07L, 08L +#./run_hafs.py ${opts} 2020072806-2020080500 00L HISTORY ${confopts} # Slot 2: 09L, 10L +#./run_hafs.py ${opts} 2020081100-2020081612 00L HISTORY ${confopts} # Slot 3: 11L, 12L +#./run_hafs.py ${opts} 2020081918-2020082718 00L HISTORY ${confopts} # Slot 4: 13L, 14L +#./run_hafs.py ${opts} 2020083112-2020090512 00L HISTORY ${confopts} # Slot 5: 15L, 16L +#./run_hafs.py ${opts} 2020090612-2020091118 00L HISTORY ${confopts} # Slot 6: 17Lp1, 18Lp1 +#./run_hafs.py ${opts} 2020091200-2020092300 00L HISTORY ${confopts} # Slot 7: 17Lp2, 18Lp2, 19-24L +#./run_hafs.py ${opts} 2020100212-2020101018 00L HISTORY ${confopts} # Slot 8: 25L, 26L +#./run_hafs.py ${opts} 2020101618-2020102912 00L HISTORY ${confopts} # Slot 9: 27L, 28L +#./run_hafs.py ${opts} 2020101618-2020102912 00L HISTORY ${confopts} # Slot 10: 29-31L # No GFSv16 version input data ## 2019 NATL storm slots -#${PYTHON3} ./run_hafs.py -t ${dev} 2019082406-2019091006 00L HISTORY ${confopts} # Slot 5: 05-08L -#${PYTHON3} ./run_hafs.py -t ${dev} 2019091212-2019092712 00L HISTORY ${confopts} # Slot 6: 09-12L +#./run_hafs.py ${opts} 2019082406-2019091006 00L HISTORY ${confopts} # Slot 5: 05-08L +#./run_hafs.py ${opts} 2019091212-2019092712 00L HISTORY ${confopts} # Slot 6: 09-12L #=============================================================================== diff --git a/rocoto/cronjob_hafs_regional_da.sh b/rocoto/cronjob_hafs_regional_da.sh index ec647f370..a84d42ba9 100755 --- a/rocoto/cronjob_hafs_regional_da.sh +++ b/rocoto/cronjob_hafs_regional_da.sh @@ -2,68 +2,45 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs1/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#dev="-s sites/xjet_hafsv0p1a.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # Cold-start from GFS analysis without DA - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_noda \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_regional_da_C96s1n4_320x312.conf # Warm-start from prior HAFS forecast without DA - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_noda_cycling \ config.warm_start_opt=2 \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_regional_da_C96s1n4_320x312.conf # Simple 3DVar DA - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_3dvar \ config.run_gsi=yes config.run_envar=no \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_regional_da_C96s1n4_320x312.conf # 3DEnVar with GDAS ensembles - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_3denvar \ config.run_gsi=yes config.run_envar=yes \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_regional_da_C96s1n4_320x312.conf # GSI-based Vortex Relocation (GSIVR) + 3DEnVar with GDAS ensembles - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_gsivr_3denvar \ config.run_gsi_vr=yes config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=no config.run_envar=yes \ @@ -72,7 +49,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # 3DEnVar with GDAS ensembles + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_3denvar_fgat \ config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -81,7 +58,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # 3DEnVar with HAFS ensembles (cold-start from GDAS ensembles) - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_3densda \ config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=no config.run_envar=yes \ @@ -90,7 +67,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # 3DEnVar with HAFS ensembles + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_3densda_fgat \ config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -99,7 +76,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # GSIVR + 3DEnVar with HAFS ensembles + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_gsivr_3densda_fgat \ config.run_gsi_vr=yes config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -108,7 +85,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # GSIVR + GSIVR_FGAT + 3DEnVar with HAFS ensembles + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_gsivrfgat_3densda_fgat \ config.run_gsi_vr=yes config.run_gsi_vr_fgat=yes config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -117,7 +94,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # GSIVR + GSIVR_FGAT + GSIVR_ENS + 3DEnVar with HAFS ensembles (self-cycled through GSIVR_ENS) + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_gsivrfgatens_3densda_fgat \ config.run_gsi_vr=yes config.run_gsi_vr_fgat=yes config.run_gsi_vr_ens=yes \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -126,7 +103,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # 3DEnVar with self-cycled HAFS enkf ensembles + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_3densda_enkf_fgat \ config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -135,7 +112,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # GSIVR + GSIVR_FGAT + 3DEnVar with self-cycled HAFS enkf ensembles + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_gsivrfgat_3densda_enkf_fgat \ config.run_gsi_vr=yes config.run_gsi_vr_fgat=yes config.run_gsi_vr_ens=no \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -144,7 +121,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ../parm/hafs_regional_da_C96s1n4_320x312.conf # GSIVR + GSIVR_FGAT + GSIVR_ENS + 3DEnVar with self-cycled HAFS enkf ensembles + 3hourly FGAT - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_C96s1n4_gsivrfgatens_3densda_enkf_fgat \ config.run_gsi_vr=yes config.run_gsi_vr_fgat=yes config.run_gsi_vr_ens=yes \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -157,7 +134,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" # Dual-resolution ENSDA system, 3-km deterministic, 6-km ensembles, same domain coverage # Notes: # * need to increase the number of cores (from 200 to 800) to run the analysis jobs - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_hafsv0p1aL64_full_3densda_dualres \ config.run_gsi_vr=yes config.run_gsi_vr_fgat=yes config.run_gsi_vr_ens=yes \ config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ @@ -172,7 +149,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" ## Dual-resolution ENSDA system, 3-km deterministic, 6-km ensembles, same domain coverage ## Notes: ## * need to increase the number of cores (from 200 to 800) to run the analysis jobs -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ +# ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ # config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_hafsv0p1acplL64_full_3densda_dualres \ # config.run_gsi_vr=yes config.run_gsi_vr_fgat=yes config.run_gsi_vr_ens=yes \ # config.run_gsi=yes config.run_fgat=yes config.run_envar=yes \ diff --git a/rocoto/cronjob_hafs_rt.sh b/rocoto/cronjob_hafs_rt.sh index 2496576ad..a77880c46 100755 --- a/rocoto/cronjob_hafs_rt.sh +++ b/rocoto/cronjob_hafs_rt.sh @@ -2,47 +2,25 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # Regional static NATL basin-focused configuration with atm-ocn coupling - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_static_atm_ocn \ config.NHRS=6 ${scrubopt} \ ../parm/hafs_regional_static.conf \ ../parm/hafs_hycom.conf # Regional static NATL basin-focused configuration with atm-wav coupling - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_static_atm_wav \ config.NHRS=6 ${scrubopt} \ ../parm/hafs_regional_static.conf \ @@ -50,7 +28,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" forecast.cpl_atm_wav=cmeps_2way ## Regional static NATL basin-focused configuration with atm-ocn-wav coupling -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ +#./run_hafs.py ${opts} 2020082512 00L HISTORY \ # config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_static_atm_ocn_wav \ # config.NHRS=6 ${scrubopt} \ # ../parm/hafs_regional_static.conf \ @@ -59,7 +37,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" # forecast.cpl_atm_wav=cmeps_2way # Regional low-resolution static NATL basin-focused configuration with atm-ocn-wav coupling - ${PYTHON3} ./run_hafs.py -t ${dev} 2019082900 00L HISTORY \ + ./run_hafs.py ${opts} 2019082900 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_static_C192s1n4_atm_ocn_wav \ config.NHRS=24 ${scrubopt} \ ../parm/hafs_regional_static_C192s1n4.conf \ @@ -68,7 +46,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" forecast.cpl_atm_wav=cmeps_2way # Regional storm-focused configuration with atm-ocn-wav coupling - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_atm_ocn_wav \ config.NHRS=6 ${scrubopt} \ ../parm/hafs_hycom_ww3.conf \ @@ -76,13 +54,13 @@ scrubopt="config.scrub_work=no config.scrub_com=no" forecast.cpl_atm_wav=cmeps_2way # Regional storm-focused configuration (atm-only) with GFS grib2ab format IC/BC - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_atm_only \ config.ictype=gfsgrib2ab_0p25 forecast.nstf_n2=1 \ config.NHRS=6 ${scrubopt} # Regional low-resolution static NATL basin-focused configuration with 3DEnVar with GDAS ensembles - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_da_C192s1n4_3denvar \ config.run_gsi=yes config.run_envar=yes \ gsi.use_bufr_nr=yes \ @@ -91,7 +69,7 @@ scrubopt="config.scrub_work=no config.scrub_com=no" # Regional storm-focused moving-nesting configuration with vortex initialization and domain 02 data assimilation # atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm perturbation - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082506-2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_regional_mvnest_vida \ config.run_atm_init=yes config.run_atm_init_fgat=yes config.run_atm_init_ens=no \ config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ @@ -113,13 +91,13 @@ scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # Global-nesting static NATL basin-focused configuration (atm-only) - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_globnest_static \ config.NHRS=6 ${scrubopt} \ ../parm/hafs_globnest_static.conf # Global-nesting storm-focused configuration (atm-only) with GFS grib2ab format IC/BC - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 13L HISTORY \ + ./run_hafs.py ${opts} 2020082512 13L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_globnest_grib2ab \ config.ictype=gfsgrib2ab_0p25 forecast.nstf_n2=1 \ config.NHRS=6 ${scrubopt} \ diff --git a/rocoto/cronjob_hafs_rt_nest.sh b/rocoto/cronjob_hafs_rt_nest.sh index a3c75d246..44641b3d5 100755 --- a/rocoto/cronjob_hafs_rt_nest.sh +++ b/rocoto/cronjob_hafs_rt_nest.sh @@ -2,59 +2,37 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_C96_regional_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C96_regional_storm.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_C96_regional_1nest_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C96_regional_1nest_storm.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_C96_regional_telescopic_2nests_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C96_regional_telescopic_2nests_storm.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_C96_global_1nest_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C96_global_1nest_storm.conf - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082512 00L HISTORY \ + ./run_hafs.py ${opts} 2020082512 00L HISTORY \ config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_rt_C96_global_multiple_4nests_storm \ config.NHRS=12 ${scrubopt} \ ../parm/hafs_C96_global_multiple_4nests_storm.conf diff --git a/rocoto/cronjob_hafs_vida.sh b/rocoto/cronjob_hafs_vida.sh index 5c8adfd2c..dddb60027 100755 --- a/rocoto/cronjob_hafs_vida.sh +++ b/rocoto/cronjob_hafs_vida.sh @@ -2,34 +2,12 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" #=============================================================================== # h3db_vidacycst: atm_init+atm_vi+fgat+3denvar+anal_merge and cycling storm @@ -182,13 +160,13 @@ EXPT=$(basename ${HOMEhafs}) #confopts="${confh3da}" confopts="${confh3db_vida}" - ${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ + ./run_hafs.py ${opts} 2020082506-2020082512 13L HISTORY ${confopts} \ config.NHRS=12 config.scrub_work=no config.scrub_com=no # Storms to run: Laura13L2020, Ida09L2021, Sam18L2021 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} +#./run_hafs.py ${opts} 2020081918-2020082718 13L HISTORY ${confopts} +#./run_hafs.py ${opts} 2021082612-2021083012 09L HISTORY ${confopts} +#./run_hafs.py ${opts} 2021092300-2021100500 18L HISTORY ${confopts} #=============================================================================== diff --git a/rocoto/cronjob_hafsv0p3_conus_3km.sh b/rocoto/cronjob_hafsv0p3_conus_3km.sh deleted file mode 100755 index c6663823d..000000000 --- a/rocoto/cronjob_hafsv0p3_conus_3km.sh +++ /dev/null @@ -1,54 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion -#HOMEhafs=/work/noaa/hwrf/save/${USER}/hafsv0p3_20220305 -#dev="-s sites/orion.ent -f" -#PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera - HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/hafsv0p3_20220322 - dev="-s sites/hera.ent -f" - PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - - confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_conus_3km \ - config.NHRS=60 config.scrub_work=no config.scrub_com=no \ - ../parm/hafsv0p3_regional_conus_3km.conf" - -# Iowa Derecho case: 2020/08/10/00 or 2020/08/10/06. The 06Z cycle performed slightly better. -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081000 00L HISTORY ${confopts} -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081006 00L HISTORY ${confopts} - -# KY/TN tornado outbreak: 2021/12/10/12 - ${PYTHON3} ./run_hafs.py -t ${dev} 2021121012 00L HISTORY ${confopts} - -# MCS and diurnal isolated deep convection: 2020/07/07/00 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070700 00L HISTORY ${confopts} - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3_h3bp.sh b/rocoto/cronjob_hafsv0p3_h3bp.sh deleted file mode 100755 index c8e944371..000000000 --- a/rocoto/cronjob_hafsv0p3_h3bp.sh +++ /dev/null @@ -1,103 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/hafsv0p3_20220412 - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - - confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_h3bp \ - forecast.restart_interval=240 \ - ../parm/hafsv0p3_regional_mvnest.conf \ - ../parm/hafsv0p3_hycom.conf" - -# Techincal testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ -# config.NHRS=12 config.scrub_work=no config.scrub_com=no - -# 2021 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052000-2021052400 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061400-2021061600 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061712-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062712-2021062906 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021063006-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080912-2021082000 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081206-2021082118 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081518-2021082406 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082512-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082800-2021090118 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082812-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083100-2021091112 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090812-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091200-2021091718 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091506-2021092406 15L HISTORY ${confopts} # Odette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091800-2021092918 16L HISTORY ${confopts} # Peter -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091818-2021092406 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092206-2021100506 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092406-2021092518 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092818-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103012-2021110712 21L HISTORY ${confopts} # Wanda - -# 2020 NATL storms -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091806-2020092318 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3_h3bs.sh b/rocoto/cronjob_hafsv0p3_h3bs.sh deleted file mode 100755 index 0c5ce4028..000000000 --- a/rocoto/cronjob_hafsv0p3_h3bs.sh +++ /dev/null @@ -1,103 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/hafsv0p3_20220305 - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - - confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_h3bs \ - forecast.restart_interval=240 \ - ../parm/hafsv0p3_regional_storm.conf \ - ../parm/hafsv0p3_hycom.conf" - -# Techincal testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ -# config.NHRS=12 config.scrub_work=no config.scrub_com=no - -# 2021 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052000-2021052400 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061400-2021061600 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061712-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062712-2021062906 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021063006-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080912-2021082000 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081206-2021082118 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081518-2021082406 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082512-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082800-2021090118 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082812-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083100-2021091112 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090812-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091200-2021091718 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091506-2021092406 15L HISTORY ${confopts} # Odette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091800-2021092918 16L HISTORY ${confopts} # Peter -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091818-2021092406 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092206-2021100506 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092406-2021092518 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092818-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103012-2021110712 21L HISTORY ${confopts} # Wanda - -# 2020 NATL storms -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confhdob} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091806-2020092318 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hwrf.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3a_2022rt.sh b/rocoto/cronjob_hafsv0p3a_2022rt.sh deleted file mode 100755 index 85fbb61f2..000000000 --- a/rocoto/cronjob_hafsv0p3a_2022rt.sh +++ /dev/null @@ -1,54 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -# HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/hafsv0p3a_2022rt -# dev="-s sites/wcoss_dell_p3.ent -f" -# PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/hafsv0p3a_2022rt -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA WCOSS2 -HOMEhafs=/lfs/h2/emc/hur/noscrub/${USER}/save/hafs.v0.3.0 -dev="-s sites/wcoss2.ent -f" -PYTHON3=/usr/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion -#HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS -#dev="-s sites/orion.ent -f" -#PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) -SUBEXPT="hafsv0p3a_2022rt" -#=============================================================================== - # atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm perturbation - confopts="config.EXPT=${EXPT} config.SUBEXPT=${SUBEXPT} \ - ../parm/hafsv0p3a_final.conf" - - # 2022 NATL storms -#done ${PYTHON3} ./run_hafs.py -t ${dev} 2022060218-2022060618 01L HISTORY ${confopts} # Alex -#done ${PYTHON3} ./run_hafs.py -t ${dev} 2022060218-2022060406 01L HISTORY ${confopts} # Alex -#done ${PYTHON3} ./run_hafs.py -t ${dev} 2022060412-2022060618 01L HISTORY ${confopts} # Alex - - # 2022 EPAC storms -${PYTHON3} ./run_hafs.py -t ${dev} 2022080718-2022081000 09E HISTORY ${confopts} - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3a_final.sh b/rocoto/cronjob_hafsv0p3a_final.sh index 031471254..272a3a0ad 100755 --- a/rocoto/cronjob_hafsv0p3a_final.sh +++ b/rocoto/cronjob_hafsv0p3a_final.sh @@ -2,34 +2,12 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" #=============================================================================== # atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm perturbation @@ -37,67 +15,8 @@ EXPT=$(basename ${HOMEhafs}) ../parm/hafsv0p3a_final.conf" # Technical testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ +#./run_hafs.py ${opts} 2020082506-2020082512 13L HISTORY ${confopts} \ # config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hafs.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hafs.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091806-2020091818 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091906-2020092300 17L HISTORY ${confopts} # Paulette part3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hafs.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - #=============================================================================== date diff --git a/rocoto/cronjob_hafsv0p3a_hfdv.sh b/rocoto/cronjob_hafsv0p3a_hfdv.sh deleted file mode 100755 index 1c575ff00..000000000 --- a/rocoto/cronjob_hafsv0p3a_hfdv.sh +++ /dev/null @@ -1,105 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - # atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm perturbation - confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_v0p3a_hfdv \ - ../parm/hafsv0p3a_final.conf vi.vi_storm_modification=auto" - - # Technical testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ -# config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hafs.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hafs.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091806-2020091818 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091906-2020092300 17L HISTORY ${confopts} # Paulette part3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hafs.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3a_hfrd.sh b/rocoto/cronjob_hafsv0p3a_hfrd.sh deleted file mode 100755 index f9d57bca6..000000000 --- a/rocoto/cronjob_hafsv0p3a_hfrd.sh +++ /dev/null @@ -1,105 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - # atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm perturbation - confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_v0p3a_hfrd \ - ../parm/hafsv0p3a_final.conf vi.vi_storm_modification=no" - - # Technical testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ -# config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hafs.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hafs.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091806-2020091818 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091906-2020092300 17L HISTORY ${confopts} # Paulette part3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hafs.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3a.sh b/rocoto/cronjob_hafsv0p3a_vida.sh similarity index 60% rename from rocoto/cronjob_hafsv0p3a.sh rename to rocoto/cronjob_hafsv0p3a_vida.sh index b60f40160..852d2de21 100755 --- a/rocoto/cronjob_hafsv0p3a.sh +++ b/rocoto/cronjob_hafsv0p3a_vida.sh @@ -2,34 +2,13 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" +scrubopt="config.scrub_work=no config.scrub_com=no" #=============================================================================== # v0p3a_vidacycst: atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm @@ -189,66 +168,8 @@ EXPT=$(basename ${HOMEhafs}) #confopts="${conf_v0p3a}" # Technical testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ +#./run_hafs.py ${opts} 2020082506-2020082512 13L HISTORY ${confopts} \ # config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hafs.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hafs.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091806-2020092318 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hafs.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - #=============================================================================== date diff --git a/rocoto/cronjob_hafsv0p3b.sh b/rocoto/cronjob_hafsv0p3b.sh deleted file mode 100755 index 9900504ea..000000000 --- a/rocoto/cronjob_hafsv0p3b.sh +++ /dev/null @@ -1,122 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - # v0p3b: coldstart from gfs analysis - conf_v0p3b="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_v0p3b \ - config.run_atm_init=no config.run_atm_init_fgat=no config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=no config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=no config.run_fgat=no config.run_envar=no \ - config.gsi_d01=no config.gsi_d02=no \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=no config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - forecast.restart_interval=240 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3b.conf" - - # Choose the configuration to run - confopts="${conf_v0p3b}" - - # Technical testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ -# config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hafs.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hafs.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091806-2020092318 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hafs.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3c.sh b/rocoto/cronjob_hafsv0p3c.sh deleted file mode 100755 index 049303a79..000000000 --- a/rocoto/cronjob_hafsv0p3c.sh +++ /dev/null @@ -1,122 +0,0 @@ -#!/bin/sh -set -x -date - -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -cd ${HOMEhafs}/rocoto - -EXPT=$(basename ${HOMEhafs}) - -#=============================================================================== - # v0p3c: coldstart from gfs analysis - conf_v0p3c="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_v0p3c \ - config.run_atm_init=no config.run_atm_init_fgat=no config.run_atm_init_ens=no \ - config.run_atm_merge=no config.run_atm_merge_fgat=no config.run_atm_merge_ens=no \ - config.run_atm_vi=no config.run_atm_vi_fgat=no config.run_atm_vi_ens=no \ - config.run_gsi_vr=no config.run_gsi_vr_fgat=no config.run_gsi_vr_ens=no \ - config.run_gsi=no config.run_fgat=no config.run_envar=no \ - config.gsi_d01=no config.gsi_d02=no \ - config.run_ensda=no config.ENS_SIZE=40 config.run_enkf=no \ - config.run_analysis_merge=no config.run_analysis_merge_ens=no \ - vi.vi_storm_env=init \ - atm_merge.atm_merge_method=vortexreplace analysis_merge.analysis_merge_method=vortexreplace \ - config.NHRS=126 \ - forecast.restart_interval=240 \ - config.GRID_RATIO_ENS=2 \ - gsi.use_bufr_nr=yes \ - gsi.grid_ratio_fv3_regional=1 \ - ../parm/hafsv0p3c.conf" - - # Choose the configuration to run - confopts="${conf_v0p3c}" - - # Technical testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ -# config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hafs.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hafs.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091806-2020092318 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hafs.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - -#=============================================================================== - -date - -echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv0p3s_final.sh b/rocoto/cronjob_hafsv0p3s_final.sh index 92e848996..8b9e97077 100755 --- a/rocoto/cronjob_hafsv0p3s_final.sh +++ b/rocoto/cronjob_hafsv0p3s_final.sh @@ -2,34 +2,12 @@ set -x date -# NOAA WCOSS Dell Phase3 -#HOMEhafs=/gpfs/dell2/emc/modeling/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_dell_p3.ent -f" -#PYTHON3=/usrx/local/prod/packages/python/3.6.3/bin/python3 - -# NOAA WCOSS Cray -#HOMEhafs=/gpfs/hps3/emc/hwrf/noscrub/${USER}/save/HAFS -#dev="-s sites/wcoss_cray.ent -f" -#PYTHON3=/opt/intel/intelpython3/bin/python3 - -# NOAA RDHPCS Jet -#HOMEhafs=/mnt/lfs4/HFIP/hwrfv3/${USER}/HAFS -#dev="-s sites/xjet.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 - -# MSU Orion - HOMEhafs=/work/noaa/hwrf/save/${USER}/HAFS - dev="-s sites/orion.ent -f" - PYTHON3=/apps/intel-2020/intel-2020/intelpython3/bin/python3 - -# NOAA RDHPCS Hera -#HOMEhafs=/scratch1/NCEPDEV/hwrf/save/${USER}/HAFS -#dev="-s sites/hera.ent -f" -#PYTHON3=/apps/intel/intelpython3/bin/python3 +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc cd ${HOMEhafs}/rocoto - EXPT=$(basename ${HOMEhafs}) +opts="-t -f" #=============================================================================== # atm_init+atm_vi+fgat+d02_3denvar+anal_merge and cycling storm perturbation @@ -37,67 +15,8 @@ EXPT=$(basename ${HOMEhafs}) ../parm/hafsv0p3s_final.conf" # Technical testing -#${PYTHON3} ./run_hafs.py -t ${dev} 2020082506-2020082512 13L HISTORY ${confopts} \ +#./run_hafs.py ${opts} 2020082506-2020082512 13L HISTORY ${confopts} \ # config.NHRS=12 config.scrub_work=no config.scrub_com=no - - # 2021 NATL Storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2021052206-2021052318 01L HISTORY ${confopts} # Ana -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061506-2021061518 02L HISTORY ${confopts} # Bill -#${PYTHON3} ./run_hafs.py -t ${dev} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette -#${PYTHON3} ./run_hafs.py -t ${dev} 2021062818-2021062900 04L HISTORY ${confopts} # Danny -#${PYTHON3} ./run_hafs.py -t ${dev} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021080918-2021081700 06L HISTORY ${confopts} # Fred -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081312-2021082112 07L HISTORY ${confopts} # Grace -#${PYTHON3} ./run_hafs.py -t ${dev} 2021081600-2021082300 08L HISTORY ${confopts} # Henri -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082612-2021083012 09L HISTORY ${confopts} # Ida -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083012-2021090112 10L HISTORY ${confopts} # Kate -#${PYTHON3} ./run_hafs.py -t ${dev} 2021082912-2021083000 11L HISTORY ${confopts} # Julian -#${PYTHON3} ./run_hafs.py -t ${dev} 2021083118-2021091106 12L HISTORY ${confopts} # Larry -#${PYTHON3} ./run_hafs.py -t ${dev} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2021091918-2021092300 17L HISTORY ${confopts} # Rose -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092300-2021100500 18L HISTORY ${confopts} # Sam -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa -#${PYTHON3} ./run_hafs.py -t ${dev} 2021092918-2021100412 20L HISTORY ${confopts} # Victor -#${PYTHON3} ./run_hafs.py -t ${dev} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda - - # 2020 NATL storms -#${PYTHON3} ./run_hafs.py -t ${dev} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur -#${PYTHON3} ./run_hafs.py -t ${dev} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha -#${PYTHON3} ./run_hafs.py -t ${dev} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS -#${PYTHON3} ./run_hafs.py -t ${dev} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard -#${PYTHON3} ./run_hafs.py -t ${dev} 2020070912-2020071100 06L HISTORY ${confopts} # Fay -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna -#${PYTHON3} ./run_hafs.py -t ${dev} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias -#${PYTHON3} ./run_hafs.py -t ${dev} 2020073018-2020080118 10L HISTORY ${confopts} # Ten -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081918-2020082718 13L HISTORY ${confopts} # Laura -#${PYTHON3} ./run_hafs.py -t ${dev} 2020081818-2020082500 14L HISTORY ${confopts} # Marco -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090512 15L HISTORY ${confopts} # Omar -#${PYTHON3} ./run_hafs.py -t ${dev} 2020083112-2020090318 16L HISTORY ${confopts} # Nana -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091806-2020091818 17L HISTORY ${confopts} # Paulette part2 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091906-2020092300 17L HISTORY ${confopts} # Paulette part3 -#${PYTHON3} ./run_hafs.py -t ${dev} 2020090700-2020091412 18L HISTORY ${confopts} # Rene -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091112-2020091618 19L HISTORY ${confopts} # Sally -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091700-2020092218 22L HISTORY ${confopts} # Beta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred -#${PYTHON3} ./run_hafs.py -t ${dev} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma -#${PYTHON3} ./run_hafs.py -t ${dev} 2020100312-2020101012 26L HISTORY ${confopts} # Delta -#${PYTHON3} ./run_hafs.py -t ${dev} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon -#${PYTHON3} ./run_hafs.py -t ${dev} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta - #=============================================================================== date diff --git a/rocoto/cronjob_hafsv1a_baseline.sh b/rocoto/cronjob_hafsv1a_baseline.sh new file mode 100755 index 000000000..024a09cf3 --- /dev/null +++ b/rocoto/cronjob_hafsv1a_baseline.sh @@ -0,0 +1,102 @@ +#!/bin/sh +set -x +date + +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc + +cd ${HOMEhafs}/rocoto +EXPT=$(basename ${HOMEhafs}) +#opts="-t -s sites/${WHERE_AM_I:-wcoss2}.ent -f" +opts="-t -f" +#=============================================================================== + + #hafsv1a baseline + confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_v1a_baseline \ + config.run_emcgraphics=yes \ + ../parm/hafsv1a_baseline.conf" + + # Technical testing for Hurricane Laura +#./run_hafs.py ${opts} 2020082512 13L HISTORY ${confopts} \ +# config.NHRS=12 config.scrub_work=no config.scrub_com=no config.run_emcgraphics=yes + + # 2022 NATL Storms +#./run_hafs.py ${opts} 2022060506-2022060618 01L HISTORY ${confopts} # Alex +#./run_hafs.py ${opts} 2022062718-2022070206 02L HISTORY ${confopts} # Bonnie +#./run_hafs.py ${opts} 2022070206-2022070300 03L HISTORY ${confopts} # Colin +#./run_hafs.py ${opts} 2022082000-2022082006 04L HISTORY ${confopts} # Four +#./run_hafs.py ${opts} 2022090112-2022090812 05L HISTORY ${confopts} # Danielle +#./run_hafs.py ${opts} 2022090300-2022091018 06L HISTORY ${confopts} # Earl +#./run_hafs.py ${opts} 2022091412-2022092418 07L HISTORY ${confopts} # Fiona +#./run_hafs.py ${opts} 2022092012-2022092518 08L HISTORY ${confopts} # Gaston +#./run_hafs.py ${opts} 2022092306-2022100106 09L HISTORY ${confopts} # Ian +#./run_hafs.py ${opts} 2022092312-2022092500 10L HISTORY ${confopts} # Hermine +#./run_hafs.py ${opts} 2022092812-2022092912 11L HISTORY ${confopts} # Eleven +#./run_hafs.py ${opts} 2022100418-2022100618 12L HISTORY ${confopts} # Twelve +#./run_hafs.py ${opts} 2022100612-2022100912 13L HISTORY ${confopts} # Julia +#./run_hafs.py ${opts} 2022101118-2022101506 14L HISTORY ${confopts} # Karl +#./run_hafs.py ${opts} 2022103018-2022110506 15L HISTORY ${confopts} # Lisa +#./run_hafs.py ${opts} 2022110106-2022110312 16L HISTORY ${confopts} # Martin +#./run_hafs.py ${opts} 2022110706-2022111100 17L HISTORY ${confopts} # Nicole + + # 2021 NATL Storms +#./run_hafs.py ${opts} 2021052206-2021052318 01L HISTORY ${confopts} # Ana +#./run_hafs.py ${opts} 2021061506-2021061518 02L HISTORY ${confopts} # Bill +#./run_hafs.py ${opts} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette +#./run_hafs.py ${opts} 2021062818-2021062900 04L HISTORY ${confopts} # Danny +#./run_hafs.py ${opts} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa +#./run_hafs.py ${opts} 2021080918-2021081700 06L HISTORY ${confopts} # Fred +#./run_hafs.py ${opts} 2021081312-2021082112 07L HISTORY ${confopts} # Grace +#./run_hafs.py ${opts} 2021081600-2021082300 08L HISTORY ${confopts} # Henri +#./run_hafs.py ${opts} 2021082612-2021083012 09L HISTORY ${confopts} # Ida +#./run_hafs.py ${opts} 2021083012-2021090112 10L HISTORY ${confopts} # Kate +#./run_hafs.py ${opts} 2021082912-2021083000 11L HISTORY ${confopts} # Julian +#./run_hafs.py ${opts} 2021083118-2021091106 12L HISTORY ${confopts} # Larry +#./run_hafs.py ${opts} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy +#./run_hafs.py ${opts} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas +#./run_hafs.py ${opts} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 +#./run_hafs.py ${opts} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 +#./run_hafs.py ${opts} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 +#./run_hafs.py ${opts} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 +#./run_hafs.py ${opts} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 +#./run_hafs.py ${opts} 2021091918-2021092300 17L HISTORY ${confopts} # Rose +#./run_hafs.py ${opts} 2021092300-2021100500 18L HISTORY ${confopts} # Sam +#./run_hafs.py ${opts} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa +#./run_hafs.py ${opts} 2021092918-2021100412 20L HISTORY ${confopts} # Victor +#./run_hafs.py ${opts} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda + + # 2020 NATL storms +#./run_hafs.py ${opts} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur +#./run_hafs.py ${opts} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha +#./run_hafs.py ${opts} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS +#./run_hafs.py ${opts} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly +#./run_hafs.py ${opts} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard +#./run_hafs.py ${opts} 2020070912-2020071100 06L HISTORY ${confopts} # Fay +#./run_hafs.py ${opts} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo +#./run_hafs.py ${opts} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna +#./run_hafs.py ${opts} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias +#./run_hafs.py ${opts} 2020073018-2020080118 10L HISTORY ${confopts} # Ten +#./run_hafs.py ${opts} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine +#./run_hafs.py ${opts} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle +#./run_hafs.py ${opts} 2020081918-2020082718 13L HISTORY ${confopts} # Laura +#./run_hafs.py ${opts} 2020081818-2020082500 14L HISTORY ${confopts} # Marco +#./run_hafs.py ${opts} 2020083112-2020090512 15L HISTORY ${confopts} # Omar +#./run_hafs.py ${opts} 2020083112-2020090318 16L HISTORY ${confopts} # Nana +#./run_hafs.py ${opts} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 +#./run_hafs.py ${opts} 2020091806-2020091818 17L HISTORY ${confopts} # Paulette part2 +#./run_hafs.py ${opts} 2020091906-2020092300 17L HISTORY ${confopts} # Paulette part3 +#./run_hafs.py ${opts} 2020090700-2020091412 18L HISTORY ${confopts} # Rene +#./run_hafs.py ${opts} 2020091112-2020091618 19L HISTORY ${confopts} # Sally +#./run_hafs.py ${opts} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy +#./run_hafs.py ${opts} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky +#./run_hafs.py ${opts} 2020091700-2020092218 22L HISTORY ${confopts} # Beta +#./run_hafs.py ${opts} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred +#./run_hafs.py ${opts} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run +#./run_hafs.py ${opts} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma +#./run_hafs.py ${opts} 2020100312-2020101012 26L HISTORY ${confopts} # Delta +#./run_hafs.py ${opts} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon +#./run_hafs.py ${opts} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta + +date + +echo 'cronjob done' diff --git a/rocoto/cronjob_hafsv1b_baseline.sh b/rocoto/cronjob_hafsv1b_baseline.sh new file mode 100755 index 000000000..5f405cbc7 --- /dev/null +++ b/rocoto/cronjob_hafsv1b_baseline.sh @@ -0,0 +1,102 @@ +#!/bin/sh +set -x +date + +HOMEhafs=${HOMEhafs:-/lfs/h2/emc/hur/noscrub/${USER}/save/HAFS} +source ${HOMEhafs}/ush/hafs_pre_job.sh.inc + +cd ${HOMEhafs}/rocoto +EXPT=$(basename ${HOMEhafs}) +#opts="-t -s sites/${WHERE_AM_I:-wcoss2}.ent -f" +opts="-t -f" +#=============================================================================== + + #hafsv1b baseline + confopts="config.EXPT=${EXPT} config.SUBEXPT=${EXPT}_v1b_baseline \ + config.run_emcgraphics=yes \ + ../parm/hafsv1b_baseline.conf" + + # Technical testing for Hurricane Laura +#./run_hafs.py ${opts} 2020082512 13L HISTORY ${confopts} \ +# config.NHRS=12 config.scrub_work=no config.scrub_com=no config.run_emcgraphics=yes + + # 2022 NATL Storms +#./run_hafs.py ${opts} 2022060506-2022060618 01L HISTORY ${confopts} # Alex +#./run_hafs.py ${opts} 2022062718-2022070206 02L HISTORY ${confopts} # Bonnie +#./run_hafs.py ${opts} 2022070206-2022070300 03L HISTORY ${confopts} # Colin +#./run_hafs.py ${opts} 2022082000-2022082006 04L HISTORY ${confopts} # Four +#./run_hafs.py ${opts} 2022090112-2022090812 05L HISTORY ${confopts} # Danielle +#./run_hafs.py ${opts} 2022090300-2022091018 06L HISTORY ${confopts} # Earl +#./run_hafs.py ${opts} 2022091412-2022092418 07L HISTORY ${confopts} # Fiona +#./run_hafs.py ${opts} 2022092012-2022092518 08L HISTORY ${confopts} # Gaston +#./run_hafs.py ${opts} 2022092306-2022100106 09L HISTORY ${confopts} # Ian +#./run_hafs.py ${opts} 2022092312-2022092500 10L HISTORY ${confopts} # Hermine +#./run_hafs.py ${opts} 2022092812-2022092912 11L HISTORY ${confopts} # Eleven +#./run_hafs.py ${opts} 2022100418-2022100618 12L HISTORY ${confopts} # Twelve +#./run_hafs.py ${opts} 2022100612-2022100912 13L HISTORY ${confopts} # Julia +#./run_hafs.py ${opts} 2022101118-2022101506 14L HISTORY ${confopts} # Karl +#./run_hafs.py ${opts} 2022103018-2022110506 15L HISTORY ${confopts} # Lisa +#./run_hafs.py ${opts} 2022110106-2022110312 16L HISTORY ${confopts} # Martin +#./run_hafs.py ${opts} 2022110706-2022111100 17L HISTORY ${confopts} # Nicole + + # 2021 NATL Storms +#./run_hafs.py ${opts} 2021052206-2021052318 01L HISTORY ${confopts} # Ana +#./run_hafs.py ${opts} 2021061506-2021061518 02L HISTORY ${confopts} # Bill +#./run_hafs.py ${opts} 2021061906-2021062200 03L HISTORY ${confopts} # Claudette +#./run_hafs.py ${opts} 2021062818-2021062900 04L HISTORY ${confopts} # Danny +#./run_hafs.py ${opts} 2021070100-2021070918 05L HISTORY ${confopts} # Elsa +#./run_hafs.py ${opts} 2021080918-2021081700 06L HISTORY ${confopts} # Fred +#./run_hafs.py ${opts} 2021081312-2021082112 07L HISTORY ${confopts} # Grace +#./run_hafs.py ${opts} 2021081600-2021082300 08L HISTORY ${confopts} # Henri +#./run_hafs.py ${opts} 2021082612-2021083012 09L HISTORY ${confopts} # Ida +#./run_hafs.py ${opts} 2021083012-2021090112 10L HISTORY ${confopts} # Kate +#./run_hafs.py ${opts} 2021082912-2021083000 11L HISTORY ${confopts} # Julian +#./run_hafs.py ${opts} 2021083118-2021091106 12L HISTORY ${confopts} # Larry +#./run_hafs.py ${opts} 2021090900-2021091000 13L HISTORY ${confopts} # Mindy +#./run_hafs.py ${opts} 2021091218-2021091500 14L HISTORY ${confopts} # Nicholas +#./run_hafs.py ${opts} 2021091718-2021091818 15L HISTORY ${confopts} # Odette part 1 +#./run_hafs.py ${opts} 2021092112-2021092406 15L HISTORY ${confopts} # Odette part 2 +#./run_hafs.py ${opts} 2021091906-2021092100 16L HISTORY ${confopts} # Peter part 1 +#./run_hafs.py ${opts} 2021092112-2021092300 16L HISTORY ${confopts} # Peter part 2 +#./run_hafs.py ${opts} 2021092618-2021092818 16L HISTORY ${confopts} # Peter part 3 +#./run_hafs.py ${opts} 2021091918-2021092300 17L HISTORY ${confopts} # Rose +#./run_hafs.py ${opts} 2021092300-2021100500 18L HISTORY ${confopts} # Sam +#./run_hafs.py ${opts} 2021092418-2021092512 19L HISTORY ${confopts} # Teresa +#./run_hafs.py ${opts} 2021092918-2021100412 20L HISTORY ${confopts} # Victor +#./run_hafs.py ${opts} 2021103100-2021110706 21L HISTORY ${confopts} # Wanda + + # 2020 NATL storms +#./run_hafs.py ${opts} 2020051606-2020051918 01L HISTORY ${confopts} # Arthur +#./run_hafs.py ${opts} 2020052700-2020052718 02L HISTORY ${confopts} # Bertha +#./run_hafs.py ${opts} 2020060112-2020060812 03L HISTORY ${confopts} # Cristobal hwrfdata_PROD2020HDOBS +#./run_hafs.py ${opts} 2020062112-2020062406 04L HISTORY ${confopts} # Dolly +#./run_hafs.py ${opts} 2020070400-2020070612 05L HISTORY ${confopts} # Edouard +#./run_hafs.py ${opts} 2020070912-2020071100 06L HISTORY ${confopts} # Fay +#./run_hafs.py ${opts} 2020072112-2020072518 07L HISTORY ${confopts} # Gonzalo +#./run_hafs.py ${opts} 2020072212-2020072618 08L HISTORY ${confopts} # Hanna +#./run_hafs.py ${opts} 2020072806-2020080500 09L HISTORY ${confopts} # Isaias +#./run_hafs.py ${opts} 2020073018-2020080118 10L HISTORY ${confopts} # Ten +#./run_hafs.py ${opts} 2020081100-2020081612 11L HISTORY ${confopts} # Josephine +#./run_hafs.py ${opts} 2020081412-2020081600 12L HISTORY ${confopts} # Kyle +#./run_hafs.py ${opts} 2020081918-2020082718 13L HISTORY ${confopts} # Laura +#./run_hafs.py ${opts} 2020081818-2020082500 14L HISTORY ${confopts} # Marco +#./run_hafs.py ${opts} 2020083112-2020090512 15L HISTORY ${confopts} # Omar +#./run_hafs.py ${opts} 2020083112-2020090318 16L HISTORY ${confopts} # Nana +#./run_hafs.py ${opts} 2020090612-2020091612 17L HISTORY ${confopts} # Paulette part1 +#./run_hafs.py ${opts} 2020091806-2020091818 17L HISTORY ${confopts} # Paulette part2 +#./run_hafs.py ${opts} 2020091906-2020092300 17L HISTORY ${confopts} # Paulette part3 +#./run_hafs.py ${opts} 2020090700-2020091412 18L HISTORY ${confopts} # Rene +#./run_hafs.py ${opts} 2020091112-2020091618 19L HISTORY ${confopts} # Sally +#./run_hafs.py ${opts} 2020091212-2020092306 20L HISTORY ${confopts} # Teddy +#./run_hafs.py ${opts} 2020091318-2020091712 21L HISTORY ${confopts} # Vicky +#./run_hafs.py ${opts} 2020091700-2020092218 22L HISTORY ${confopts} # Beta +#./run_hafs.py ${opts} 2020091718-2020092100 23L HISTORY ${confopts} # Wilfred +#./run_hafs.py ${opts} 2020091818-2020091900 24L HISTORY ${confopts} # Alpha # Do not need to run +#./run_hafs.py ${opts} 2020100118-2020100600 25L HISTORY ${confopts} # Gamma +#./run_hafs.py ${opts} 2020100312-2020101012 26L HISTORY ${confopts} # Delta +#./run_hafs.py ${opts} 2020101618-2020102600 27L HISTORY ${confopts} # Epsilon +#./run_hafs.py ${opts} 2020102412-2020102912 28L HISTORY ${confopts} # Zeta + +date + +echo 'cronjob done' diff --git a/rocoto/hafs_workflow.xml.in b/rocoto/hafs_workflow.xml.in index da9ef350e..5f3b031f1 100644 --- a/rocoto/hafs_workflow.xml.in +++ b/rocoto/hafs_workflow.xml.in @@ -111,6 +111,7 @@ + %SITES; %SITE_DEFAULTS; @@ -159,13 +160,10 @@ &WORKhafs;/hafs_launch.log &ACCOUNT; &RESERVATION; - &QUEUE_SERIAL; - &SERIAL_EXTRA; - 1 + &QUEUE_PE; + &PE_EXTRA; &CORES_EXTRA; - TOTAL_TASKS1 - 00:15:00 - &MEMORY; + &LAUNCH_RESOURCES; &ENV_VARS; @@ -1537,7 +1535,7 @@ &PE_EXTRA; &EMCGRAPHICS_RESOURCES; &ENV_VARS; - COMgraph@[CDSAVE]/comgraph_&SUBEXPT; + COMgraph@[CDSCRUB]/comgraph_&SUBEXPT; + 4G"> + 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:15:0024G"> 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> 1:ppn=18:tpp=4TOTAL_TASKS18NCTSK18OMP_THREADS401:30:00"> 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> - 3:ppn=60:tpp=1TOTAL_TASKS180NCTSK60OMP_THREADS100:30:00"> - 2:ppn=96:tpp=1TOTAL_TASKS192NCTSK96OMP_THREADS103:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS100:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS103:30:00"> + 3:ppn=60:tpp=1TOTAL_TASKS180NCTSK60OMP_THREADS1-l place=vscatter:excl00:30:00"> + 2:ppn=60:tpp=1TOTAL_TASKS120NCTSK60OMP_THREADS1-l place=vscatter:excl03:30:00"> + 3:ppn=60:tpp=1TOTAL_TASKS180NCTSK60OMP_THREADS1-l place=vscatter:excl00:30:00"> + 2:ppn=60:tpp=1TOTAL_TASKS120NCTSK60OMP_THREADS1-l place=vscatter:excl03:30:00"> 1:ppn=10:tpp=1TOTAL_TASKS10NCTSK10OMP_THREADS100:30:00"> - 1:ppn=4:tpp=20TOTAL_TASKS4NCTSK4OMP_THREADS2001:00:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> + 1:ppn=4:tpp=20TOTAL_TASKS4NCTSK4OMP_THREADS20-l place=vscatter:excl01:00:00"> + 1:ppn=40:tpp=1TOTAL_TASKS40NCTSK40OMP_THREADS1-l place=vscatter:excl00:30:00"> 10:ppn=16:tpp=8TOTAL_TASKS160NCTSK16OMP_THREADS8OMP_PLACEScoresOMP_STACKSIZE1GFI_OFI_RXM_SAR_LIMIT314572802:00:00-l place=vscatter:excl"> - 60:ppn=1:tpp=24TOTAL_TASKS60NCTSK1OMP_THREADS2402:00:00"> - 1:ppn=64:tpp=1TOTAL_TASKS64NCTSK64OMP_THREADS102:00:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS102:00:00"> - 10:ppn=60:tpp=2TOTAL_TASKS600NCTSK60OMP_THREADS202:00:00"> + 60:ppn=1:tpp=60TOTAL_TASKS60NCTSK1OMP_THREADS6002:00:00"> + 1:ppn=60:tpp=1TOTAL_TASKS60NCTSK60OMP_THREADS102:00:00"> + 1:ppn=4:tpp=1TOTAL_TASKS4NCTSK4OMP_THREADS102:00:00100G"> + 10:ppn=60:tpp=2TOTAL_TASKS600NCTSK60OMP_THREADS2-l place=vscatter:excl02:00:00"> 07:59:00"> OMP_THREADS2"> - + -l place=vscatter:excl&FORECAST_OMP;&FORECAST_WALLTIME;"> - 20:ppn=12:tpp=2TOTAL_TASKS240NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 168:ppn=12:tpp=2TOTAL_TASKS2016NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> + 20:ppn=12:tpp=2TOTAL_TASKS240NCTSK12&FORECAST_EXTRA;"> + 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> + 168:ppn=12:tpp=2TOTAL_TASKS2016NCTSK12&FORECAST_EXTRA;"> - 20:ppn=12:tpp=2TOTAL_TASKS240NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 168:ppn=12:tpp=2TOTAL_TASKS2016NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> + 20:ppn=12:tpp=2TOTAL_TASKS240NCTSK12&FORECAST_EXTRA;"> + 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> + 168:ppn=12:tpp=2TOTAL_TASKS2016NCTSK12&FORECAST_EXTRA;"> - 21:ppn=12:tpp=2TOTAL_TASKS252NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 169:ppn=12:tpp=2TOTAL_TASKS2028NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> + 21:ppn=12:tpp=2TOTAL_TASKS252NCTSK12&FORECAST_EXTRA;"> + 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> + 169:ppn=12:tpp=2TOTAL_TASKS2028NCTSK12&FORECAST_EXTRA;"> - 22:ppn=12:tpp=2TOTAL_TASKS264NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 110:ppn=12:tpp=2TOTAL_TASKS1320NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 170:ppn=12:tpp=2TOTAL_TASKS2040NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> + 22:ppn=12:tpp=2TOTAL_TASKS264NCTSK12&FORECAST_EXTRA;"> + 110:ppn=12:tpp=2TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> + 170:ppn=12:tpp=2TOTAL_TASKS2040NCTSK12&FORECAST_EXTRA;"> - 64:ppn=20:tpp=2TOTAL_TASKS1280NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 100:ppn=20:tpp=2TOTAL_TASKS2000NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> + 21:ppn=60:tpp=2TOTAL_TASKS1260NCTSK60&FORECAST_EXTRA;"> + 33:ppn=60:tpp=2TOTAL_TASKS1980NCTSK60&FORECAST_EXTRA;"> - 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 103:ppn=20:tpp=2TOTAL_TASKS2060NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> + 64:ppn=20:tpp=2TOTAL_TASKS1280NCTSK20&FORECAST_EXTRA;"> + 100:ppn=20:tpp=2TOTAL_TASKS2000NCTSK20&FORECAST_EXTRA;"> - 6:ppn=12:tpp=2TOTAL_TASKS72NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 4:ppn=20:tpp=2TOTAL_TASKS80NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> + 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> + 103:ppn=20:tpp=2TOTAL_TASKS2060NCTSK20&FORECAST_EXTRA;"> + + 6:ppn=12:tpp=2TOTAL_TASKS72NCTSK12&FORECAST_EXTRA;"> + 4:ppn=20:tpp=2TOTAL_TASKS80NCTSK20&FORECAST_EXTRA;"> - 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 23:ppn=60:tpp=2TOTAL_TASKS1380NCTSK120-l place=vscatter:excl&FORECAST_EXTRA;"> - 133:ppn=12:tpp=2TOTAL_TASKS1596NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 173:ppn=12:tpp=2TOTAL_TASKS2076NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - - 39:ppn=12:tpp=2TOTAL_TASKS468NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 129:ppn=12:tpp=2TOTAL_TASKS1548NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 169:ppn=12:tpp=2TOTAL_TASKS2028NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - - 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 133:ppn=12:tpp=2TOTAL_TASKS1596NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 173:ppn=12:tpp=2TOTAL_TASKS2076NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 118:ppn=12:tpp=2TOTAL_TASKS1416NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 118:ppn=12:tpp=2TOTAL_TASKS1416NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - - 44:ppn=12:tpp=2TOTAL_TASKS528NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 114:ppn=12:tpp=2TOTAL_TASKS1368NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 134:ppn=12:tpp=2TOTAL_TASKS1608NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 174:ppn=12:tpp=2TOTAL_TASKS2088NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - - 45:ppn=12:tpp=2TOTAL_TASKS540NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 23:ppn=60:tpp=2TOTAL_TASKS1380NCTSK120-l place=vscatter:excl&FORECAST_EXTRA;"> - 120:ppn=12:tpp=2TOTAL_TASKS1440NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 120:ppn=12:tpp=2TOTAL_TASKS1440NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 135:ppn=12:tpp=2TOTAL_TASKS1620NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - 175:ppn=12:tpp=2TOTAL_TASKS2100NCTSK12-l place=vscatter:excl&FORECAST_EXTRA;"> - - 22:ppn=20:tpp=2TOTAL_TASKS440NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 68:ppn=20:tpp=2TOTAL_TASKS1360NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 79:ppn=20:tpp=2TOTAL_TASKS1580NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 103:ppn=20:tpp=2TOTAL_TASKS2060NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - - 25:ppn=20:tpp=2TOTAL_TASKS500NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 73:ppn=20:tpp=2TOTAL_TASKS1460NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 73:ppn=20:tpp=2TOTAL_TASKS1460NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 82:ppn=20:tpp=2TOTAL_TASKS1640NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> - 106:ppn=20:tpp=2TOTAL_TASKS2120NCTSK20-l place=vscatter:excl&FORECAST_EXTRA;"> + 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> + 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> + 115:ppn=12:tpp=2TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> + 133:ppn=12:tpp=2TOTAL_TASKS1596NCTSK12&FORECAST_EXTRA;"> + 173:ppn=12:tpp=2TOTAL_TASKS2076NCTSK12&FORECAST_EXTRA;"> + + 39:ppn=12:tpp=2TOTAL_TASKS468NCTSK12&FORECAST_EXTRA;"> + 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> + 129:ppn=12:tpp=2TOTAL_TASKS1548NCTSK12&FORECAST_EXTRA;"> + 169:ppn=12:tpp=2TOTAL_TASKS2028NCTSK12&FORECAST_EXTRA;"> + + 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> + 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> + 133:ppn=12:tpp=2TOTAL_TASKS1596NCTSK12&FORECAST_EXTRA;"> + 173:ppn=12:tpp=2TOTAL_TASKS2076NCTSK12&FORECAST_EXTRA;"> + 118:ppn=12:tpp=2TOTAL_TASKS1416NCTSK12&FORECAST_EXTRA;"> + 118:ppn=12:tpp=2TOTAL_TASKS1416NCTSK12&FORECAST_EXTRA;"> + + 44:ppn=12:tpp=2TOTAL_TASKS528NCTSK12&FORECAST_EXTRA;"> + 114:ppn=12:tpp=2TOTAL_TASKS1368NCTSK12&FORECAST_EXTRA;"> + 134:ppn=12:tpp=2TOTAL_TASKS1608NCTSK12&FORECAST_EXTRA;"> + 174:ppn=12:tpp=2TOTAL_TASKS2088NCTSK12&FORECAST_EXTRA;"> + + 45:ppn=12:tpp=2TOTAL_TASKS540NCTSK12&FORECAST_EXTRA;"> + 115:ppn=12:tpp=2TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> + 120:ppn=12:tpp=2TOTAL_TASKS1440NCTSK12&FORECAST_EXTRA;"> + 120:ppn=12:tpp=2TOTAL_TASKS1440NCTSK12&FORECAST_EXTRA;"> + 135:ppn=12:tpp=2TOTAL_TASKS1620NCTSK12&FORECAST_EXTRA;"> + 175:ppn=12:tpp=2TOTAL_TASKS2100NCTSK12&FORECAST_EXTRA;"> + + 7:ppn=60:tpp=2TOTAL_TASKS420NCTSK60&FORECAST_EXTRA;"> + 22:ppn=60:tpp=2TOTAL_TASKS1320NCTSK60&FORECAST_EXTRA;"> + 23:ppn=60:tpp=2TOTAL_TASKS1380NCTSK60&FORECAST_EXTRA;"> + 23:ppn=60:tpp=2TOTAL_TASKS1380NCTSK60&FORECAST_EXTRA;"> + 26:ppn=60:tpp=2TOTAL_TASKS1560NCTSK60&FORECAST_EXTRA;"> + 34:ppn=60:tpp=2TOTAL_TASKS2040NCTSK60&FORECAST_EXTRA;"> + + 22:ppn=20:tpp=2TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> + 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> + 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> + 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> + 68:ppn=20:tpp=2TOTAL_TASKS1360NCTSK20&FORECAST_EXTRA;"> + 79:ppn=20:tpp=2TOTAL_TASKS1580NCTSK20&FORECAST_EXTRA;"> + 103:ppn=20:tpp=2TOTAL_TASKS2060NCTSK20&FORECAST_EXTRA;"> + + 25:ppn=20:tpp=2TOTAL_TASKS500NCTSK20&FORECAST_EXTRA;"> + 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> + 73:ppn=20:tpp=2TOTAL_TASKS1460NCTSK20&FORECAST_EXTRA;"> + 73:ppn=20:tpp=2TOTAL_TASKS1460NCTSK20&FORECAST_EXTRA;"> + 82:ppn=20:tpp=2TOTAL_TASKS1640NCTSK20&FORECAST_EXTRA;"> + 106:ppn=20:tpp=2TOTAL_TASKS2120NCTSK20&FORECAST_EXTRA;"> - 10:ppn=24:tpp=1TOTAL_TASKS240NCTSK24OMP_THREADS103:00:00-l place=vscatter:excl"> + 4:ppn=60:tpp=1TOTAL_TASKS240NCTSK60OMP_THREADS103:00:00-l place=vscatter:excl"> 9:ppn=20:tpp=2TOTAL_TASKS180NCTSK20&FORECAST_EXTRA;"> @@ -138,27 +148,29 @@ 150:ppn=12:tpp=2TOTAL_TASKS1800NCTSK12&FORECAST_EXTRA;"> 142:ppn=12:tpp=2TOTAL_TASKS1704NCTSK12&FORECAST_EXTRA;"> 150:ppn=12:tpp=2TOTAL_TASKS1800NCTSK12&FORECAST_EXTRA;"> + 29:ppn=60:tpp=2TOTAL_TASKS1740NCTSK60&FORECAST_EXTRA;"> + 29:ppn=60:tpp=2TOTAL_TASKS1740NCTSK60&FORECAST_EXTRA;"> 88:ppn=20:tpp=2TOTAL_TASKS1760NCTSK20&FORECAST_EXTRA;"> 88:ppn=20:tpp=2TOTAL_TASKS1760NCTSK20&FORECAST_EXTRA;"> 91:ppn=20:tpp=2TOTAL_TASKS1820NCTSK20&FORECAST_EXTRA;"> 91:ppn=20:tpp=2TOTAL_TASKS1820NCTSK20&FORECAST_EXTRA;"> - 6:ppn=20:tpp=2TOTAL_TASKS120NCTSK20&FORECAST_EXTRA;"> - 9:ppn=20:tpp=2TOTAL_TASKS180NCTSK20&FORECAST_EXTRA;"> - 12:ppn=20:tpp=2TOTAL_TASKS240NCTSK20&FORECAST_EXTRA;"> + 2:ppn=60:tpp=2TOTAL_TASKS120NCTSK60&FORECAST_EXTRA;"> + 3:ppn=60:tpp=2TOTAL_TASKS180NCTSK60&FORECAST_EXTRA;"> + 4:ppn=60:tpp=2TOTAL_TASKS240NCTSK60&FORECAST_EXTRA;"> - 8:ppn=20:tpp=2TOTAL_TASKS160NCTSK20&FORECAST_EXTRA;"> + 4:ppn=40:tpp=2TOTAL_TASKS160NCTSK40&FORECAST_EXTRA;"> 11:ppn=20:tpp=2TOTAL_TASKS220NCTSK20&FORECAST_EXTRA;"> - 96:ppn=20:tpp=2TOTAL_TASKS1920NCTSK20&FORECAST_EXTRA;"> - 99:ppn=20:tpp=2TOTAL_TASKS1980NCTSK20&FORECAST_EXTRA;"> + 32:ppn=60:tpp=2TOTAL_TASKS1920NCTSK60&FORECAST_EXTRA;"> + 33:ppn=60:tpp=2TOTAL_TASKS1980NCTSK60&FORECAST_EXTRA;"> 49:ppn=20:tpp=2TOTAL_TASKS980NCTSK20&FORECAST_EXTRA;"> - 15:ppn=12:tpp=2TOTAL_TASKS180NCTSK12&FORECAST_EXTRA;"> - 50:ppn=12:tpp=2TOTAL_TASKS600NCTSK12&FORECAST_EXTRA;"> - 68:ppn=10:tpp=2TOTAL_TASKS680NCTSK10&FORECAST_EXTRA;"> - 105:ppn=12:tpp=2TOTAL_TASKS1260NCTSK12&FORECAST_EXTRA;"> - 110:ppn=12:tpp=2TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> - 23:ppn=60:tpp=2TOTAL_TASKS1380NCTSK120&FORECAST_EXTRA;"> + 3:ppn=60:tpp=2TOTAL_TASKS180NCTSK60&FORECAST_EXTRA;"> + 10:ppn=60:tpp=2TOTAL_TASKS600NCTSK60&FORECAST_EXTRA;"> + 17:ppn=40:tpp=2TOTAL_TASKS680NCTSK40&FORECAST_EXTRA;"> + 21:ppn=60:tpp=2TOTAL_TASKS1260NCTSK60&FORECAST_EXTRA;"> + 22:ppn=60:tpp=2TOTAL_TASKS1320NCTSK60&FORECAST_EXTRA;"> + 23:ppn=60:tpp=2TOTAL_TASKS1380NCTSK60&FORECAST_EXTRA;"> diff --git a/rocoto/sites/wcoss_cray.ent b/rocoto/sites/wcoss_cray.ent deleted file mode 100644 index 5b9e7eb7a..000000000 --- a/rocoto/sites/wcoss_cray.ent +++ /dev/null @@ -1,250 +0,0 @@ - - - - - - - - - - "> - - "> - 24"> - 24"> - - 1G"> - 1G"> - - 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> - 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> - 3:ppn=6:tpp=4TOTAL_TASKS18NCTSK6OMP_THREADS401:30:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> - 15:ppn=12:tpp=1TOTAL_TASKS180NCTSK12OMP_THREADS100:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS103:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS100:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS103:30:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS101:30:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> - 50:ppn=6:tpp=2TOTAL_TASKS300NCTSK6OMP_THREADS202:00:00"> - 60:ppn=1:tpp=24TOTAL_TASKS60NCTSK1OMP_THREADS2402:00:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS102:00:00"> - 4:ppn=1:tpp=1TOTAL_TASKS4NCTSK1OMP_THREADS102:00:00"> - 50:ppn=12:tpp=2TOTAL_TASKS600NCTSK12OMP_THREADS202:00:00"> - - 07:59:00"> - OMP_THREADS2"> - - - - 20:ppn=12:tpp=2TOTAL_TASKS240NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 168:ppn=12:tpp=2TOTAL_TASKS2016NCTSK12&FORECAST_EXTRA;"> - - 20:ppn=12:tpp=2TOTAL_TASKS240NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 168:ppn=12:tpp=2TOTAL_TASKS2016NCTSK12&FORECAST_EXTRA;"> - - 21:ppn=12:tpp=2TOTAL_TASKS252NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - 169:ppn=12:tpp=2TOTAL_TASKS2028NCTSK12&FORECAST_EXTRA;"> - - 22:ppn=12:tpp=2TOTAL_TASKS264NCTSK12&FORECAST_EXTRA;"> - 110:ppn=12:tpp=2TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> - 170:ppn=12:tpp=2TOTAL_TASKS2040NCTSK12&FORECAST_EXTRA;"> - - 64:ppn=20:tpp=2TOTAL_TASKS1280NCTSK20&FORECAST_EXTRA;"> - 100:ppn=20:tpp=2TOTAL_TASKS2000NCTSK20&FORECAST_EXTRA;"> - - 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - 103:ppn=20:tpp=2TOTAL_TASKS2060NCTSK20&FORECAST_EXTRA;"> - - 6:ppn=12:tpp=2TOTAL_TASKS72NCTSK12&FORECAST_EXTRA;"> - 4:ppn=20:tpp=2TOTAL_TASKS80NCTSK20&FORECAST_EXTRA;"> - - - 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=2TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - 133:ppn=12:tpp=2TOTAL_TASKS1596NCTSK12&FORECAST_EXTRA;"> - 173:ppn=12:tpp=2TOTAL_TASKS2076NCTSK12&FORECAST_EXTRA;"> - - 39:ppn=12:tpp=2TOTAL_TASKS468NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - 129:ppn=12:tpp=2TOTAL_TASKS1548NCTSK12&FORECAST_EXTRA;"> - 169:ppn=12:tpp=2TOTAL_TASKS2028NCTSK12&FORECAST_EXTRA;"> - - 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - 133:ppn=12:tpp=2TOTAL_TASKS1596NCTSK12&FORECAST_EXTRA;"> - 173:ppn=12:tpp=2TOTAL_TASKS2076NCTSK12&FORECAST_EXTRA;"> - 118:ppn=12:tpp=2TOTAL_TASKS1416NCTSK12&FORECAST_EXTRA;"> - 118:ppn=12:tpp=2TOTAL_TASKS1416NCTSK12&FORECAST_EXTRA;"> - - 44:ppn=12:tpp=2TOTAL_TASKS528NCTSK12&FORECAST_EXTRA;"> - 114:ppn=12:tpp=2TOTAL_TASKS1368NCTSK12&FORECAST_EXTRA;"> - 134:ppn=12:tpp=2TOTAL_TASKS1608NCTSK12&FORECAST_EXTRA;"> - 174:ppn=12:tpp=2TOTAL_TASKS2088NCTSK12&FORECAST_EXTRA;"> - - 45:ppn=12:tpp=2TOTAL_TASKS540NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=2TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - 120:ppn=12:tpp=2TOTAL_TASKS1440NCTSK12&FORECAST_EXTRA;"> - 120:ppn=12:tpp=2TOTAL_TASKS1440NCTSK12&FORECAST_EXTRA;"> - 135:ppn=12:tpp=2TOTAL_TASKS1620NCTSK12&FORECAST_EXTRA;"> - 175:ppn=12:tpp=2TOTAL_TASKS2100NCTSK12&FORECAST_EXTRA;"> - - 22:ppn=20:tpp=2TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - 68:ppn=20:tpp=2TOTAL_TASKS1360NCTSK20&FORECAST_EXTRA;"> - 79:ppn=20:tpp=2TOTAL_TASKS1580NCTSK20&FORECAST_EXTRA;"> - 103:ppn=20:tpp=2TOTAL_TASKS2060NCTSK20&FORECAST_EXTRA;"> - - 25:ppn=20:tpp=2TOTAL_TASKS500NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - 73:ppn=20:tpp=2TOTAL_TASKS1460NCTSK20&FORECAST_EXTRA;"> - 73:ppn=20:tpp=2TOTAL_TASKS1460NCTSK20&FORECAST_EXTRA;"> - 82:ppn=20:tpp=2TOTAL_TASKS1640NCTSK20&FORECAST_EXTRA;"> - 106:ppn=20:tpp=2TOTAL_TASKS2120NCTSK20&FORECAST_EXTRA;"> - - - 10:ppn=24:tpp=1TOTAL_TASKS240NCTSK24OMP_THREADS103:00:00"> - - - 9:ppn=20:tpp=2TOTAL_TASKS180NCTSK20&FORECAST_EXTRA;"> - 6:ppn=20:tpp=2TOTAL_TASKS120NCTSK20&FORECAST_EXTRA;"> - 104:ppn=20:tpp=2TOTAL_TASKS2080NCTSK20&FORECAST_EXTRA;"> - 30:ppn=20:tpp=2TOTAL_TASKS600NCTSK20&FORECAST_EXTRA;"> - - 52:ppn=12:tpp=2TOTAL_TASKS624NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=2TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=2TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=2TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=2TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 52:ppn=12:tpp=2TOTAL_TASKS624NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=2TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=2TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=2TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=2TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 53:ppn=12:tpp=2TOTAL_TASKS636NCTSK12&FORECAST_EXTRA;"> - 141:ppn=12:tpp=2TOTAL_TASKS1692NCTSK12&FORECAST_EXTRA;"> - 149:ppn=12:tpp=2TOTAL_TASKS1788NCTSK12&FORECAST_EXTRA;"> - 141:ppn=12:tpp=2TOTAL_TASKS1692NCTSK12&FORECAST_EXTRA;"> - 149:ppn=12:tpp=2TOTAL_TASKS1788NCTSK12&FORECAST_EXTRA;"> - 54:ppn=12:tpp=2TOTAL_TASKS648NCTSK12&FORECAST_EXTRA;"> - 142:ppn=12:tpp=2TOTAL_TASKS1704NCTSK12&FORECAST_EXTRA;"> - 150:ppn=12:tpp=2TOTAL_TASKS1800NCTSK12&FORECAST_EXTRA;"> - 142:ppn=12:tpp=2TOTAL_TASKS1704NCTSK12&FORECAST_EXTRA;"> - 150:ppn=12:tpp=2TOTAL_TASKS1800NCTSK12&FORECAST_EXTRA;"> - 88:ppn=20:tpp=2TOTAL_TASKS1760NCTSK20&FORECAST_EXTRA;"> - 88:ppn=20:tpp=2TOTAL_TASKS1760NCTSK20&FORECAST_EXTRA;"> - 91:ppn=20:tpp=2TOTAL_TASKS1820NCTSK20&FORECAST_EXTRA;"> - 91:ppn=20:tpp=2TOTAL_TASKS1820NCTSK20&FORECAST_EXTRA;"> - - 6:ppn=20:tpp=2TOTAL_TASKS120NCTSK20&FORECAST_EXTRA;"> - 9:ppn=20:tpp=2TOTAL_TASKS180NCTSK20&FORECAST_EXTRA;"> - 12:ppn=20:tpp=2TOTAL_TASKS240NCTSK20&FORECAST_EXTRA;"> - - 8:ppn=20:tpp=2TOTAL_TASKS160NCTSK20&FORECAST_EXTRA;"> - 11:ppn=20:tpp=2TOTAL_TASKS220NCTSK20&FORECAST_EXTRA;"> - 96:ppn=20:tpp=2TOTAL_TASKS1920NCTSK20&FORECAST_EXTRA;"> - 99:ppn=20:tpp=2TOTAL_TASKS1980NCTSK20&FORECAST_EXTRA;"> - 49:ppn=20:tpp=2TOTAL_TASKS980NCTSK20&FORECAST_EXTRA;"> - - 15:ppn=12:tpp=2TOTAL_TASKS180NCTSK12&FORECAST_EXTRA;"> - 50:ppn=12:tpp=2TOTAL_TASKS600NCTSK12&FORECAST_EXTRA;"> - 68:ppn=10:tpp=2TOTAL_TASKS680NCTSK10&FORECAST_EXTRA;"> - 105:ppn=12:tpp=2TOTAL_TASKS1260NCTSK12&FORECAST_EXTRA;"> - 110:ppn=12:tpp=2TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=2TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - - - 12:ppn=20:tpp=2TOTAL_TASKS240NCTSK20&FORECAST_EXTRA;"> - 38:ppn=20:tpp=2TOTAL_TASKS760NCTSK20&FORECAST_EXTRA;"> - 43:ppn=20:tpp=2TOTAL_TASKS860NCTSK20&FORECAST_EXTRA;"> - - 21:ppn=20:tpp=2TOTAL_TASKS420NCTSK20&FORECAST_EXTRA;"> - 58:ppn=20:tpp=2TOTAL_TASKS1160NCTSK20&FORECAST_EXTRA;"> - - - - 6:ppn=12:tpp=2TOTAL_TASKS72NCTSK12&FORECAST_EXTRA;"> - 11:ppn=12:tpp=2TOTAL_TASKS132NCTSK12&FORECAST_EXTRA;"> - 38:ppn=12:tpp=2TOTAL_TASKS456NCTSK12&FORECAST_EXTRA;"> - 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 48:ppn=12:tpp=2TOTAL_TASKS576NCTSK12&FORECAST_EXTRA;"> - 53:ppn=12:tpp=2TOTAL_TASKS636NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - - 34:ppn=12:tpp=2TOTAL_TASKS408NCTSK12&FORECAST_EXTRA;"> - 39:ppn=12:tpp=2TOTAL_TASKS468NCTSK12&FORECAST_EXTRA;"> - 44:ppn=12:tpp=2TOTAL_TASKS528NCTSK12&FORECAST_EXTRA;"> - 49:ppn=12:tpp=2TOTAL_TASKS588NCTSK12&FORECAST_EXTRA;"> - 104:ppn=12:tpp=2TOTAL_TASKS1248NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - - 28:ppn=12:tpp=2TOTAL_TASKS336NCTSK12&FORECAST_EXTRA;"> - 33:ppn=12:tpp=2TOTAL_TASKS396NCTSK12&FORECAST_EXTRA;"> - 38:ppn=12:tpp=2TOTAL_TASKS456NCTSK12&FORECAST_EXTRA;"> - 43:ppn=12:tpp=2TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 48:ppn=12:tpp=2TOTAL_TASKS576NCTSK12&FORECAST_EXTRA;"> - 53:ppn=12:tpp=2TOTAL_TASKS636NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=2TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=2TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - - 29:ppn=12:tpp=2TOTAL_TASKS348NCTSK12&FORECAST_EXTRA;"> - 34:ppn=12:tpp=2TOTAL_TASKS408NCTSK12&FORECAST_EXTRA;"> - 39:ppn=12:tpp=2TOTAL_TASKS468NCTSK12&FORECAST_EXTRA;"> - 44:ppn=12:tpp=2TOTAL_TASKS528NCTSK12&FORECAST_EXTRA;"> - 49:ppn=12:tpp=2TOTAL_TASKS588NCTSK12&FORECAST_EXTRA;"> - 54:ppn=12:tpp=2TOTAL_TASKS648NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=2TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - 114:ppn=12:tpp=2TOTAL_TASKS1368NCTSK12&FORECAST_EXTRA;"> - - 30:ppn=12:tpp=2TOTAL_TASKS360NCTSK12&FORECAST_EXTRA;"> - 35:ppn=12:tpp=2TOTAL_TASKS420NCTSK12&FORECAST_EXTRA;"> - 40:ppn=12:tpp=2TOTAL_TASKS480NCTSK12&FORECAST_EXTRA;"> - 45:ppn=12:tpp=2TOTAL_TASKS540NCTSK12&FORECAST_EXTRA;"> - 50:ppn=12:tpp=2TOTAL_TASKS600NCTSK12&FORECAST_EXTRA;"> - 55:ppn=12:tpp=2TOTAL_TASKS660NCTSK12&FORECAST_EXTRA;"> - 110:ppn=12:tpp=2TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=2TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - - 4:ppn=20:tpp=2TOTAL_TASKS80NCTSK20&FORECAST_EXTRA;"> - 7:ppn=20:tpp=2TOTAL_TASKS140NCTSK20&FORECAST_EXTRA;"> - - 16:ppn=20:tpp=2TOTAL_TASKS320NCTSK20&FORECAST_EXTRA;"> - 19:ppn=20:tpp=2TOTAL_TASKS380NCTSK20&FORECAST_EXTRA;"> - 19:ppn=20:tpp=2TOTAL_TASKS380NCTSK20&FORECAST_EXTRA;"> - 22:ppn=20:tpp=2TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 28:ppn=20:tpp=2TOTAL_TASKS560NCTSK20&FORECAST_EXTRA;"> - 31:ppn=20:tpp=2TOTAL_TASKS620NCTSK20&FORECAST_EXTRA;"> - 64:ppn=20:tpp=2TOTAL_TASKS1280NCTSK20&FORECAST_EXTRA;"> - 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - - 19:ppn=20:tpp=2TOTAL_TASKS380NCTSK20&FORECAST_EXTRA;"> - 22:ppn=20:tpp=2TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 22:ppn=20:tpp=2TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 25:ppn=20:tpp=2TOTAL_TASKS500NCTSK20&FORECAST_EXTRA;"> - 31:ppn=20:tpp=2TOTAL_TASKS620NCTSK20&FORECAST_EXTRA;"> - 34:ppn=20:tpp=2TOTAL_TASKS680NCTSK20&FORECAST_EXTRA;"> - 67:ppn=20:tpp=2TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=2TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - - 4:ppn=24:tpp=1TOTAL_TASKS96NCTSK24OMP_THREADS107:59:00"> - 1:ppn=1:tpp=1TOTAL_TASKS1NCTSK1OMP_THREADS107:59:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS107:59:00"> - 2:ppn=1:tpp=1TOTAL_TASKS2NCTSK1OMP_THREADS107:59:00"> - - 2:ppn=12:tpp=1TOTAL_TASKS24NCTSK12OMP_THREADS107:59:00"> - 2:ppn=12:tpp=1TOTAL_TASKS24NCTSK12OMP_THREADS107:59:00"> - diff --git a/rocoto/sites/wcoss_dell_p3.ent b/rocoto/sites/wcoss_dell_p3.ent deleted file mode 100644 index c455db4df..000000000 --- a/rocoto/sites/wcoss_dell_p3.ent +++ /dev/null @@ -1,251 +0,0 @@ - - - - - - - - - - - - -R affinity[core\(1\)]"> - 24"> - 24"> - - 1G"> - 5G"> - - - 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> - 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> - 3:ppn=6:tpp=1TOTAL_TASKS18NCTSK6OMP_THREADS4-R affinity[core\(4\):distribute=balance]01:30:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS101:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS103:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS101:30:00"> - 8:ppn=24:tpp=1TOTAL_TASKS192NCTSK24OMP_THREADS103:30:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS101:00:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS100:30:00"> - 50:ppn=12:tpp=1TOTAL_TASKS600NCTSK12OMP_THREADS2-R affinity[core\(2\):distribute=balance]02:00:00"> - 60:ppn=1:tpp=1TOTAL_TASKS60NCTSK1OMP_THREADS24-R affinity[core\(24\):distribute=balance]02:00:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS102:00:00"> - 2:ppn=2:tpp=1TOTAL_TASKS4NCTSK2OMP_THREADS102:00:00"> - 50:ppn=12:tpp=1TOTAL_TASKS600NCTSK12OMP_THREADS2-R affinity[core\(2\):distribute=balance]02:00:00"> - - 07:59:00"> - OMP_THREADS2-R affinity[core\(2\):distribute=balance]"> - - - - 20:ppn=12:tpp=1TOTAL_TASKS240NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=1TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 168:ppn=12:tpp=1TOTAL_TASKS2016NCTSK12&FORECAST_EXTRA;"> - - 20:ppn=12:tpp=1TOTAL_TASKS240NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=1TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 168:ppn=12:tpp=1TOTAL_TASKS2016NCTSK12&FORECAST_EXTRA;"> - - 21:ppn=12:tpp=1TOTAL_TASKS252NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=1TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - 169:ppn=12:tpp=1TOTAL_TASKS2028NCTSK12&FORECAST_EXTRA;"> - - 22:ppn=12:tpp=1TOTAL_TASKS264NCTSK12&FORECAST_EXTRA;"> - 110:ppn=12:tpp=1TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> - 170:ppn=12:tpp=1TOTAL_TASKS2040NCTSK12&FORECAST_EXTRA;"> - - 64:ppn=20:tpp=1TOTAL_TASKS1280NCTSK20&FORECAST_EXTRA;"> - 100:ppn=20:tpp=1TOTAL_TASKS2000NCTSK20&FORECAST_EXTRA;"> - - 67:ppn=20:tpp=1TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - 103:ppn=20:tpp=1TOTAL_TASKS2060NCTSK20&FORECAST_EXTRA;"> - - 6:ppn=12:tpp=1TOTAL_TASKS72NCTSK12&FORECAST_EXTRA;"> - 4:ppn=20:tpp=1TOTAL_TASKS80NCTSK20&FORECAST_EXTRA;"> - - - 43:ppn=12:tpp=1TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=1TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=1TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - 133:ppn=12:tpp=1TOTAL_TASKS1596NCTSK12&FORECAST_EXTRA;"> - 173:ppn=12:tpp=1TOTAL_TASKS2076NCTSK12&FORECAST_EXTRA;"> - - 39:ppn=12:tpp=1TOTAL_TASKS468NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=1TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - 129:ppn=12:tpp=1TOTAL_TASKS1548NCTSK12&FORECAST_EXTRA;"> - 169:ppn=12:tpp=1TOTAL_TASKS2028NCTSK12&FORECAST_EXTRA;"> - - 43:ppn=12:tpp=1TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=1TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - 133:ppn=12:tpp=1TOTAL_TASKS1596NCTSK12&FORECAST_EXTRA;"> - 173:ppn=12:tpp=1TOTAL_TASKS2076NCTSK12&FORECAST_EXTRA;"> - 118:ppn=12:tpp=1TOTAL_TASKS1416NCTSK12&FORECAST_EXTRA;"> - 118:ppn=12:tpp=1TOTAL_TASKS1416NCTSK12&FORECAST_EXTRA;"> - - 44:ppn=12:tpp=1TOTAL_TASKS528NCTSK12&FORECAST_EXTRA;"> - 114:ppn=12:tpp=1TOTAL_TASKS1368NCTSK12&FORECAST_EXTRA;"> - 134:ppn=12:tpp=1TOTAL_TASKS1608NCTSK12&FORECAST_EXTRA;"> - 174:ppn=12:tpp=1TOTAL_TASKS2088NCTSK12&FORECAST_EXTRA;"> - - 45:ppn=12:tpp=1TOTAL_TASKS540NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=1TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - 120:ppn=12:tpp=1TOTAL_TASKS1440NCTSK12&FORECAST_EXTRA;"> - 120:ppn=12:tpp=1TOTAL_TASKS1440NCTSK12&FORECAST_EXTRA;"> - 135:ppn=12:tpp=1TOTAL_TASKS1620NCTSK12&FORECAST_EXTRA;"> - 175:ppn=12:tpp=1TOTAL_TASKS2100NCTSK12&FORECAST_EXTRA;"> - - 22:ppn=20:tpp=1TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 67:ppn=20:tpp=1TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=1TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=1TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - 68:ppn=20:tpp=1TOTAL_TASKS1360NCTSK20&FORECAST_EXTRA;"> - 79:ppn=20:tpp=1TOTAL_TASKS1580NCTSK20&FORECAST_EXTRA;"> - 103:ppn=20:tpp=1TOTAL_TASKS2060NCTSK20&FORECAST_EXTRA;"> - - 25:ppn=20:tpp=1TOTAL_TASKS500NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=1TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - 73:ppn=20:tpp=1TOTAL_TASKS1460NCTSK20&FORECAST_EXTRA;"> - 73:ppn=20:tpp=1TOTAL_TASKS1460NCTSK20&FORECAST_EXTRA;"> - 82:ppn=20:tpp=1TOTAL_TASKS1640NCTSK20&FORECAST_EXTRA;"> - 106:ppn=20:tpp=1TOTAL_TASKS2120NCTSK20&FORECAST_EXTRA;"> - - - 10:ppn=24:tpp=1TOTAL_TASKS240NCTSK24OMP_THREADS103:00:00"> - - - 9:ppn=20:tpp=1TOTAL_TASKS180NCTSK20&FORECAST_EXTRA;"> - 6:ppn=20:tpp=1TOTAL_TASKS120NCTSK20&FORECAST_EXTRA;"> - 104:ppn=20:tpp=1TOTAL_TASKS2080NCTSK20&FORECAST_EXTRA;"> - 30:ppn=20:tpp=1TOTAL_TASKS600NCTSK20&FORECAST_EXTRA;"> - - 52:ppn=12:tpp=1TOTAL_TASKS624NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=1TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=1TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=1TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=1TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 52:ppn=12:tpp=1TOTAL_TASKS624NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=1TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=1TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 140:ppn=12:tpp=1TOTAL_TASKS1680NCTSK12&FORECAST_EXTRA;"> - 148:ppn=12:tpp=1TOTAL_TASKS1776NCTSK12&FORECAST_EXTRA;"> - 53:ppn=12:tpp=1TOTAL_TASKS636NCTSK12&FORECAST_EXTRA;"> - 141:ppn=12:tpp=1TOTAL_TASKS1692NCTSK12&FORECAST_EXTRA;"> - 149:ppn=12:tpp=1TOTAL_TASKS1788NCTSK12&FORECAST_EXTRA;"> - 141:ppn=12:tpp=1TOTAL_TASKS1692NCTSK12&FORECAST_EXTRA;"> - 149:ppn=12:tpp=1TOTAL_TASKS1788NCTSK12&FORECAST_EXTRA;"> - 54:ppn=12:tpp=1TOTAL_TASKS648NCTSK12&FORECAST_EXTRA;"> - 142:ppn=12:tpp=1TOTAL_TASKS1704NCTSK12&FORECAST_EXTRA;"> - 150:ppn=12:tpp=1TOTAL_TASKS1800NCTSK12&FORECAST_EXTRA;"> - 142:ppn=12:tpp=1TOTAL_TASKS1704NCTSK12&FORECAST_EXTRA;"> - 150:ppn=12:tpp=1TOTAL_TASKS1800NCTSK12&FORECAST_EXTRA;"> - 88:ppn=20:tpp=1TOTAL_TASKS1760NCTSK20&FORECAST_EXTRA;"> - 88:ppn=20:tpp=1TOTAL_TASKS1760NCTSK20&FORECAST_EXTRA;"> - 91:ppn=20:tpp=1TOTAL_TASKS1820NCTSK20&FORECAST_EXTRA;"> - 91:ppn=20:tpp=1TOTAL_TASKS1820NCTSK20&FORECAST_EXTRA;"> - - 6:ppn=20:tpp=1TOTAL_TASKS120NCTSK20&FORECAST_EXTRA;"> - 9:ppn=20:tpp=1TOTAL_TASKS180NCTSK20&FORECAST_EXTRA;"> - 12:ppn=20:tpp=1TOTAL_TASKS240NCTSK20&FORECAST_EXTRA;"> - - 8:ppn=20:tpp=1TOTAL_TASKS160NCTSK20&FORECAST_EXTRA;"> - 11:ppn=20:tpp=1TOTAL_TASKS220NCTSK20&FORECAST_EXTRA;"> - 96:ppn=20:tpp=1TOTAL_TASKS1920NCTSK20&FORECAST_EXTRA;"> - 99:ppn=20:tpp=1TOTAL_TASKS1980NCTSK20&FORECAST_EXTRA;"> - 49:ppn=20:tpp=1TOTAL_TASKS980NCTSK20&FORECAST_EXTRA;"> - - 15:ppn=12:tpp=1TOTAL_TASKS180NCTSK12&FORECAST_EXTRA;"> - 50:ppn=12:tpp=1TOTAL_TASKS600NCTSK12&FORECAST_EXTRA;"> - 68:ppn=10:tpp=1TOTAL_TASKS680NCTSK10&FORECAST_EXTRA;"> - 105:ppn=12:tpp=1TOTAL_TASKS1260NCTSK12&FORECAST_EXTRA;"> - 110:ppn=12:tpp=1TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=1TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - - - 12:ppn=20:tpp=1TOTAL_TASKS240NCTSK20&FORECAST_EXTRA;"> - 38:ppn=20:tpp=1TOTAL_TASKS760NCTSK20&FORECAST_EXTRA;"> - 43:ppn=20:tpp=1TOTAL_TASKS860NCTSK20&FORECAST_EXTRA;"> - - 21:ppn=20:tpp=1TOTAL_TASKS420NCTSK20&FORECAST_EXTRA;"> - 58:ppn=20:tpp=1TOTAL_TASKS1160NCTSK20&FORECAST_EXTRA;"> - - - - 6:ppn=12:tpp=1TOTAL_TASKS72NCTSK12&FORECAST_EXTRA;"> - 11:ppn=12:tpp=1TOTAL_TASKS132NCTSK12&FORECAST_EXTRA;"> - 38:ppn=12:tpp=1TOTAL_TASKS456NCTSK12&FORECAST_EXTRA;"> - 43:ppn=12:tpp=1TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 48:ppn=12:tpp=1TOTAL_TASKS576NCTSK12&FORECAST_EXTRA;"> - 53:ppn=12:tpp=1TOTAL_TASKS636NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=1TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=1TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - - 34:ppn=12:tpp=1TOTAL_TASKS408NCTSK12&FORECAST_EXTRA;"> - 39:ppn=12:tpp=1TOTAL_TASKS468NCTSK12&FORECAST_EXTRA;"> - 44:ppn=12:tpp=1TOTAL_TASKS528NCTSK12&FORECAST_EXTRA;"> - 49:ppn=12:tpp=1TOTAL_TASKS588NCTSK12&FORECAST_EXTRA;"> - 104:ppn=12:tpp=1TOTAL_TASKS1248NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=1TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - - 28:ppn=12:tpp=1TOTAL_TASKS336NCTSK12&FORECAST_EXTRA;"> - 33:ppn=12:tpp=1TOTAL_TASKS396NCTSK12&FORECAST_EXTRA;"> - 38:ppn=12:tpp=1TOTAL_TASKS456NCTSK12&FORECAST_EXTRA;"> - 43:ppn=12:tpp=1TOTAL_TASKS516NCTSK12&FORECAST_EXTRA;"> - 48:ppn=12:tpp=1TOTAL_TASKS576NCTSK12&FORECAST_EXTRA;"> - 53:ppn=12:tpp=1TOTAL_TASKS636NCTSK12&FORECAST_EXTRA;"> - 108:ppn=12:tpp=1TOTAL_TASKS1296NCTSK12&FORECAST_EXTRA;"> - 113:ppn=12:tpp=1TOTAL_TASKS1356NCTSK12&FORECAST_EXTRA;"> - - 29:ppn=12:tpp=1TOTAL_TASKS348NCTSK12&FORECAST_EXTRA;"> - 34:ppn=12:tpp=1TOTAL_TASKS408NCTSK12&FORECAST_EXTRA;"> - 39:ppn=12:tpp=1TOTAL_TASKS468NCTSK12&FORECAST_EXTRA;"> - 44:ppn=12:tpp=1TOTAL_TASKS528NCTSK12&FORECAST_EXTRA;"> - 49:ppn=12:tpp=1TOTAL_TASKS588NCTSK12&FORECAST_EXTRA;"> - 54:ppn=12:tpp=1TOTAL_TASKS648NCTSK12&FORECAST_EXTRA;"> - 109:ppn=12:tpp=1TOTAL_TASKS1308NCTSK12&FORECAST_EXTRA;"> - 114:ppn=12:tpp=1TOTAL_TASKS1368NCTSK12&FORECAST_EXTRA;"> - - 30:ppn=12:tpp=1TOTAL_TASKS360NCTSK12&FORECAST_EXTRA;"> - 35:ppn=12:tpp=1TOTAL_TASKS420NCTSK12&FORECAST_EXTRA;"> - 40:ppn=12:tpp=1TOTAL_TASKS480NCTSK12&FORECAST_EXTRA;"> - 45:ppn=12:tpp=1TOTAL_TASKS540NCTSK12&FORECAST_EXTRA;"> - 50:ppn=12:tpp=1TOTAL_TASKS600NCTSK12&FORECAST_EXTRA;"> - 55:ppn=12:tpp=1TOTAL_TASKS660NCTSK12&FORECAST_EXTRA;"> - 110:ppn=12:tpp=1TOTAL_TASKS1320NCTSK12&FORECAST_EXTRA;"> - 115:ppn=12:tpp=1TOTAL_TASKS1380NCTSK12&FORECAST_EXTRA;"> - - 4:ppn=20:tpp=1TOTAL_TASKS80NCTSK20&FORECAST_EXTRA;"> - 7:ppn=20:tpp=1TOTAL_TASKS140NCTSK20&FORECAST_EXTRA;"> - - 16:ppn=20:tpp=1TOTAL_TASKS320NCTSK20&FORECAST_EXTRA;"> - 19:ppn=20:tpp=1TOTAL_TASKS380NCTSK20&FORECAST_EXTRA;"> - 19:ppn=20:tpp=1TOTAL_TASKS380NCTSK20&FORECAST_EXTRA;"> - 22:ppn=20:tpp=1TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 28:ppn=20:tpp=1TOTAL_TASKS560NCTSK20&FORECAST_EXTRA;"> - 31:ppn=20:tpp=1TOTAL_TASKS620NCTSK20&FORECAST_EXTRA;"> - 64:ppn=20:tpp=1TOTAL_TASKS1280NCTSK20&FORECAST_EXTRA;"> - 67:ppn=20:tpp=1TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - - 19:ppn=20:tpp=1TOTAL_TASKS380NCTSK20&FORECAST_EXTRA;"> - 22:ppn=20:tpp=1TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 22:ppn=20:tpp=1TOTAL_TASKS440NCTSK20&FORECAST_EXTRA;"> - 25:ppn=20:tpp=1TOTAL_TASKS500NCTSK20&FORECAST_EXTRA;"> - 31:ppn=20:tpp=1TOTAL_TASKS620NCTSK20&FORECAST_EXTRA;"> - 34:ppn=20:tpp=1TOTAL_TASKS680NCTSK20&FORECAST_EXTRA;"> - 67:ppn=20:tpp=1TOTAL_TASKS1340NCTSK20&FORECAST_EXTRA;"> - 70:ppn=20:tpp=1TOTAL_TASKS1400NCTSK20&FORECAST_EXTRA;"> - - 3:ppn=24:tpp=1TOTAL_TASKS72NCTSK24OMP_THREADS107:59:00"> - 1:ppn=1:tpp=1TOTAL_TASKS1NCTSK1OMP_THREADS107:59:00"> - 1:ppn=24:tpp=1TOTAL_TASKS24NCTSK24OMP_THREADS107:59:00"> - 1:ppn=2:tpp=1TOTAL_TASKS2NCTSK2OMP_THREADS107:59:0024G"> - - 2:ppn=12:tpp=1TOTAL_TASKS24NCTSK12OMP_THREADS107:59:00"> - 2:ppn=12:tpp=1TOTAL_TASKS24NCTSK12OMP_THREADS107:59:00"> - diff --git a/rocoto/sites/xjet.ent b/rocoto/sites/xjet.ent index 6ac030201..4d8ffe0cf 100644 --- a/rocoto/sites/xjet.ent +++ b/rocoto/sites/xjet.ent @@ -13,9 +13,9 @@ 24"> 24"> - 1G"> - 5G"> + 4G"> + 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:15:0024G"> 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> 3:ppn=4:tpp=6TOTAL_TASKS12NCTSK4OMP_THREADS601:30:00"> diff --git a/rocoto/sites/xjet_ensda_eps.ent b/rocoto/sites/xjet_ensda_eps.ent index ecbf0c305..e214bc928 100644 --- a/rocoto/sites/xjet_ensda_eps.ent +++ b/rocoto/sites/xjet_ensda_eps.ent @@ -13,9 +13,9 @@ 24"> 24"> - 1G"> - 5G"> + 4G"> + 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:15:0024G"> 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> 1:ppn=1TOTAL_TASKS1NCTSK1OMP_THREADS100:25:0024G"> 1:ppn=4:tpp=6TOTAL_TASKS4NCTSK4OMP_THREADS601:30:00"> diff --git a/scripts/exhafs_analysis.sh b/scripts/exhafs_analysis.sh index 6669c33f6..c29387fd2 100755 --- a/scripts/exhafs_analysis.sh +++ b/scripts/exhafs_analysis.sh @@ -49,7 +49,7 @@ export NMV=${NMV:-"/bin/mv"} export NLN=${NLN:-"/bin/ln -sf"} export CHGRP_CMD=${CHGRP_CMD:-"chgrp ${group_name:-rstprod}"} export ANALYSISEXEC=${ANALYSISEXEC:-${EXEChafs}/hafs_gsi.x} -export CATEXEC=${CATEXEC:-${EXEChafs}/hafs_ncdiag_cat.x} +export CATEXEC=${CATEXEC:-ncdiag_cat_serial.x} export MPISERIAL=${MPISERIAL:-${EXEChafs}/hafs_mpiserial.x} export COMPRESS=${COMPRESS:-gzip} export UNCOMPRESS=${UNCOMPRESS:-gunzip} @@ -292,7 +292,7 @@ if [ $netcdf_diag = ".true." ] ; then fi DIAG_COMPRESS=${DIAG_COMPRESS:-"YES"} DIAG_TARBALL=${DIAG_TARBALL:-"YES"} -if [ ${machine} = "wcoss_cray" ] || [ ${machine} = "wcoss2" ]; then +if [ ${machine} = "wcoss2" ]; then USE_MPISERIAL=${USE_MPISERIAL:-"NO"} USE_CFP=${USE_CFP:-"YES"} else diff --git a/scripts/exhafs_analysis_vr.sh b/scripts/exhafs_analysis_vr.sh index 61f1a0846..e25be8b8b 100755 --- a/scripts/exhafs_analysis_vr.sh +++ b/scripts/exhafs_analysis_vr.sh @@ -57,7 +57,7 @@ export NCP=${NCP:-"/bin/cp"} export NMV=${NMV:-"/bin/mv"} export NLN=${NLN:-"/bin/ln -sf"} export CHGRP_CMD=${CHGRP_CMD:-"chgrp ${group_name:-rstprod}"} -export CATEXEC=${CATEXEC:-${EXEChafs}/hafs_ncdiag_cat.x} +export CATEXEC=${CATEXEC:-ncdiag_cat_serial.x} export MPISERIAL=${MPISERIAL:-${EXEChafs}/hafs_mpiserial.x} export COMPRESS=${COMPRESS:-gzip} export UNCOMPRESS=${UNCOMPRESS:-gunzip} diff --git a/scripts/exhafs_atm_post.sh b/scripts/exhafs_atm_post.sh index 55f9e81ae..159a84c13 100755 --- a/scripts/exhafs_atm_post.sh +++ b/scripts/exhafs_atm_post.sh @@ -439,9 +439,7 @@ done if [ -s cmdfile_mppnccombine ]; then chmod +x cmdfile_mppnccombine -if [ ${machine} = "wcoss_cray" ]; then - ${APRUNF} cmdfile_mppnccombine -elif [ ${machine} = "wcoss2" ]; then +if [ ${machine} = "wcoss2" ]; then ncmd=$(cat ./cmdfile_mppnccombine | wc -l) ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) $APRUNCFP -n $ncmd_max cfp ./cmdfile_mppnccombine @@ -462,6 +460,14 @@ oro_data=oro_data${nesttilestr}.nc if [ -s ${INPdir}/INPUT/${oro_data} ] && [ ! -s ${INPdir}/RESTART/${oro_data} ]; then ${NCP} -pL ${INPdir}/INPUT/${oro_data} ${INPdir}/RESTART/ fi +oro_data_ls=oro_data_ls${nesttilestr}.nc +if [ -s ${INPdir}/INPUT/${oro_data_ls} ] && [ ! -s ${INPdir}/RESTART/${oro_data_ls} ]; then + ${NCP} -pL ${INPdir}/INPUT/${oro_data_ls} ${INPdir}/RESTART/ +fi +oro_data_ss=oro_data_ss${nesttilestr}.nc +if [ -s ${INPdir}/INPUT/${oro_data_ss} ] && [ ! -s ${INPdir}/RESTART/${oro_data_ss} ]; then + ${NCP} -pL ${INPdir}/INPUT/${oro_data_ss} ${INPdir}/RESTART/ +fi if [[ "${is_moving_nest:-.false.}" = *".true."* ]] || [[ "${is_moving_nest:-.false.}" = *".T."* ]] ; then # Pass over the grid_mspec files for moving nest (useful for storm cycling) diff --git a/scripts/exhafs_atm_prep.sh b/scripts/exhafs_atm_prep.sh index dea9f56e8..63710c932 100755 --- a/scripts/exhafs_atm_prep.sh +++ b/scripts/exhafs_atm_prep.sh @@ -38,21 +38,35 @@ export halop1=${halop1:-4} export halo0=${halo0:-0} export NTRAC=7 +export regional_esg=${regional_esg:-no} +export idim_nest=${idim_nest:-1320} +export jdim_nest=${jdim_nest:-1320} +export delx_nest=${delx_nest:-0.03} +export dely_nest=${dely_nest:-0.03} +export halop2=${halop2:-5} +export pazi=${pazi:--180.} + export FIXam=${FIXhafs}/fix_am export FIXorog=${FIXhafs}/fix_orog export FIXfv3=${FIXhafs}/fix_fv3 export FIXsfc_climo=${FIXhafs}/fix_sfc_climo -export MAKEHGRIDEXEC=${EXEChafs}/hafs_make_hgrid.x +if [ ${regional_esg} = yes ]; then + export MAKEHGRIDEXEC=${EXEChafs}/hafs_regional_esg_grid.x +else + export MAKEHGRIDEXEC=${EXEChafs}/hafs_make_hgrid.x +fi export MAKEMOSAICEXEC=${EXEChafs}/hafs_make_solo_mosaic.x export FILTERTOPOEXEC=${EXEChafs}/hafs_filter_topo.x export FREGRIDEXEC=${EXEChafs}/hafs_fregrid.x export OROGEXEC=${EXEChafs}/hafs_orog.x +export OROGGSLEXEC=${EXEChafs}/hafs_orog_gsl.x export SHAVEEXEC=${EXEChafs}/hafs_shave.x export SFCCLIMOEXEC=${EXEChafs}/hafs_sfc_climo_gen.x export MAKEGRIDSSH=${USHhafs}/hafs_make_grid.sh export MAKEOROGSSH=${USHhafs}/hafs_make_orog.sh +export MAKEOROGGSLSSH=${USHhafs}/hafs_make_orog_gsl.sh export FILTERTOPOSSH=${USHhafs}/hafs_filter_topo.sh export gridfixdir=${gridfixdir:-'/let/hafs_grid/generate/grid'} @@ -96,7 +110,17 @@ elif [ $gtype = nest -o $gtype = regional ]; then export halop1=${halop1:-4} # halo size that will be used for the orography and grid tile in chgres export halo0=${halo0:-0} # no halo, used to shave the filtered orography for use in the model + export regional_esg=${regional_esg:-no} + export idim_nest=${idim_nest:-1320} + export jdim_nest=${jdim_nest:-1320} + export delx_nest=${delx_nest:-0.03} + export dely_nest=${dely_nest:-0.03} + export halop2=${halop2:-5} + echo "creating grid for gtype of $gtype" + if [ ${regional_esg} = yes ]; then + echo "using regional esg grid: ${regional_esg}" + fi else echo "Error: please specify grid type with 'gtype' as uniform, stretch, nest or regional" exit 1 @@ -149,6 +173,36 @@ fi fi wait #rm $DATA/orog.file1 + + if [ ${use_orog_gsl:-no} = yes ]; then + + date + echo "............ execute $MAKEOROGGSLSSH ................." + # Run multiple tiles simulatneously for the gsl orography + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 1 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >$DATA/orog_gsl.file1 + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 2 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog_gsl.file1 + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 3 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog_gsl.file1 + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 4 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog_gsl.file1 + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 5 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog_gsl.file1 + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 6 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog_gsl.file1 +if [ "$machine" = hera ] || [ "$machine" = orion ] || [ "$machine" = jet ]; then + echo 'wait' >> $DATA/orog_gsl.file1 +fi + chmod u+x $DATA/orog_gsl.file1 + #aprun -j 1 -n 4 -N 4 -d 6 -cc depth cfp $DATA/orog_gsl.file1 + if [ ${machine} = "wcoss2" ]; then + ncmd=$(cat $DATA/orog_gsl.file1 | wc -l) + ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) +# $APRUNCFP -n $ncmd_max cfp $DATA/orog_gsl.file1 + $DATA/orog_gsl.file1 + else + ${APRUNF} $DATA/orog_gsl.file1 + fi + wait + #rm $DATA/orog_gsl.file1 + + fi + date echo "............ execute $FILTERTOPOSSH .............." $FILTERTOPOSSH $CRES $grid_dir $orog_dir $filter_dir @@ -172,7 +226,7 @@ elif [ $gtype = nest ]; then # Run multiple tiles simulatneously for the orography echo "${APRUNO} $MAKEOROGSSH $CRES 1 $grid_dir $orog_dir $script_dir $FIXorog $DATA ${BACKGROUND}" >$DATA/orog.file1 for itile in $(seq 2 $ntiles) - do + do echo "${APRUNO} $MAKEOROGSSH $CRES ${itile} $grid_dir $orog_dir $script_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog.file1 done if [ "$machine" = hera ] || [ "$machine" = orion ] || [ "$machine" = jet ]; then @@ -190,6 +244,35 @@ fi fi wait #rm $DATA/orog.file1 + + if [ ${use_orog_gsl:-no} = yes ]; then + + date + echo "............ execute $MAKEOROGGSLSSH ................." + # Run multiple tiles simulatneously for the gsl orography + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 1 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >$DATA/orog_gsl.file1 + for itile in $(seq 2 $ntiles) + do + echo "${APRUNO} $MAKEOROGGSLSSH $CRES ${itile} -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog_gsl.file1 + done +if [ "$machine" = hera ] || [ "$machine" = orion ] || [ "$machine" = jet ]; then + echo 'wait' >> $DATA/orog_gsl.file1 +fi + chmod u+x $DATA/orog_gsl.file1 + #aprun -j 1 -n 4 -N 4 -d 6 -cc depth cfp $DATA/orog_gsl.file1 + if [ ${machine} = "wcoss2" ]; then + ncmd=$(cat $DATA/orog_gsl.file1 | wc -l) + ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) +# $APRUNCFP -n $ncmd_max cfp $DATA/orog_gsl.file1 + $DATA/orog_gsl.file1 + else + ${APRUNF} $DATA/orog.file1 + fi + wait + #rm $DATA/orog_gsl.file1 + + fi + date echo "Grid and orography files are now prepared" @@ -198,6 +281,14 @@ elif [ $gtype = regional ] && [ ${nest_grids} -gt 1 ]; then export ntiles=$((6 + ${nest_grids})) echo "............ execute $MAKEGRIDSSH ................." + + if [ ${regional_esg:-no} = yes ] ; then + + echo "creating regional esg grid" + ${APRUNS} $MAKEGRIDSSH $CRES $grid_dir $target_lon $target_lat $pazi $halop2 $script_dir + + else + #${APRUNS} $MAKEGRIDSSH $CRES $grid_dir $stretch_fac $target_lon $target_lat $refine_ratio $istart_nest $jstart_nest $iend_nest $jend_nest $halo $script_dir ${APRUNS} $MAKEGRIDSSH $CRES $grid_dir $stretch_fac $target_lon $target_lat \ $nest_grids \ @@ -208,6 +299,9 @@ elif [ $gtype = regional ] && [ ${nest_grids} -gt 1 ]; then "$iend_nest" \ "$jend_nest" \ $halo $script_dir + + fi + date echo "............ execute $MAKEOROGSSH ................." # Run multiple tiles simulatneously for the orography @@ -231,6 +325,35 @@ fi fi wait #rm $DATA/orog.file1 + + if [ ${use_orog_gsl:-no} = yes ]; then + + date + echo "............ execute $MAKEOROGGSLSSH ................." + # Run multiple tiles simulatneously for the gsl orography + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 7 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >$DATA/orog_gsl.file1 + for itile in $(seq 8 $ntiles) + do + echo "${APRUNO} $MAKEOROGGSLSSH $CRES ${itile} -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >>$DATA/orog_gsl.file1 + done +if [ "$machine" = hera ] || [ "$machine" = orion ] || [ "$machine" = jet ]; then + echo 'wait' >> $DATA/orog_gsl.file1 +fi + chmod u+x $DATA/orog_gsl.file1 + #aprun -j 1 -n 4 -N 4 -d 6 -cc depth cfp $DATA/orog_gsl.file1 + if [ ${machine} = "wcoss2" ]; then + ncmd=$(cat $DATA/orog_gsl.file1 | wc -l) + ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) +# $APRUNCFP -n $ncmd_max cfp $DATA/orog_gsl.file1 + $DATA/orog_gsl.file1 + else + ${APRUNF} $DATA/orog_gsl.file1 + fi + wait + #rm $DATA/orog_gsl.file1 + + fi + date echo "Grid and orography files are now prepared" @@ -253,7 +376,7 @@ if [ $gtype = regional ]; then # number of compute grid points npts_cgx=`expr $nptsx \* $refine_ratio / 2` npts_cgy=`expr $nptsy \* $refine_ratio / 2` - + # figure out how many columns/rows to add in each direction so we have at least 5 halo points # for make_hgrid and the orography program index=0 @@ -266,7 +389,7 @@ if [ $gtype = regional ]; then newpoints_i=`expr $iend_nest_halo - $istart_nest_halo + 1` newpoints_cg_i=`expr $newpoints_i \* $refine_ratio / 2` diff=`expr $newpoints_cg_i - $npts_cgx` - if [ $diff -ge 10 ]; then + if [ $diff -ge 10 ]; then index=`expr $index + 1` fi done @@ -274,14 +397,27 @@ if [ $gtype = regional ]; then jstart_nest_halo=`expr $jstart_nest - $add_subtract_value` echo "================================================================================== " - echo "For refine_ratio= $refine_ratio" + echo "For refine_ratio= $refine_ratio" echo " iend_nest= $iend_nest iend_nest_halo= $iend_nest_halo istart_nest= $istart_nest istart_nest_halo= $istart_nest_halo" echo " jend_nest= $jend_nest jend_nest_halo= $jend_nest_halo jstart_nest= $jstart_nest jstart_nest_halo= $jstart_nest_halo" echo "================================================================================== " echo "............ execute $MAKEGRIDSSH ................." + if [ ${regional_esg:-no} = yes ] ; then + + if [ ${nest_grids} -eq 1 ] ; then + echo "Creating regional esg grid" + ${APRUNS} $MAKEGRIDSSH $CRES $grid_dir $target_lon $target_lat $pazi $halop2 $script_dir + else + echo "Regional esg grid parent already generated. No need to generate again." + fi + + else + ${APRUNS} $MAKEGRIDSSH $CRES $grid_dir $stretch_fac $target_lon $target_lat $refine_ratio $istart_nest_halo $jstart_nest_halo $iend_nest_halo $jend_nest_halo $halo $script_dir + fi + date echo "............ execute $MAKEOROGSSH ................." #echo "$MAKEOROGSSH $CRES 7 $grid_dir $orog_dir $script_dir $FIXorog $DATA " >$DATA/orog.file1 @@ -309,7 +445,7 @@ fi echo "............ execute shave to reduce grid and orography files to required compute size .............." cd $filter_dir # shave the orography file and then the grid file, the echo creates the input file that contains the number of required points - # in x and y and the input and output file names.This first run of shave uses a halo of 4. This is necessary so that chgres will create BC's + # in x and y and the input and output file names.This first run of shave uses a halo of 4. This is necessary so that chgres will create BC's # with 4 rows/columns which is necessary for pt. echo $npts_cgx $npts_cgy $halop1 \'$filter_dir/oro.${CASE}.tile${tile}.nc\' \'$filter_dir/oro.${CASE}.tile${tile}.shave.nc\' >input.shave.orog echo $npts_cgx $npts_cgy $halop1 \'$filter_dir/${CASE}_grid.tile${tile}.nc\' \'$filter_dir/${CASE}_grid.tile${tile}.shave.nc\' >input.shave.grid @@ -344,6 +480,31 @@ fi cp $filter_dir/oro.${CASE}.tile${tile}.shave.nc $out_dir/${CASE}_oro_data.tile${tile}.halo${halo0}.nc cp $filter_dir/${CASE}_grid.tile${tile}.shave.nc $out_dir/${CASE}_grid.tile${tile}.halo${halo0}.nc + if [ ${use_orog_gsl:-no} = yes ]; then + + date + echo "............ execute $MAKEOROGGSLSSH ................." + echo "${APRUNO} $MAKEOROGGSLSSH $CRES 7 -999 $grid_dir $orog_dir $FIXorog $DATA ${BACKGROUND}" >$DATA/orog_gsl.file1 +if [ "$machine" = hera ] || [ "$machine" = orion ] || [ "$machine" = jet ]; then + echo 'wait' >> $DATA/orog_gsl.file1 +fi + chmod u+x $DATA/orog_gsl.file1 + #aprun -j 1 -n 4 -N 4 -d 6 -cc depth cfp $DATA/orog_gsl.file1 + if [ ${machine} = "wcoss2" ]; then + ncmd=$(cat $DATA/orog_gsl.file1 | wc -l) + ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) +# $APRUNCFP -n $ncmd_max cfp $DATA/orog_gsl.file1 + $DATA/orog_gsl.file1 + else + ${APRUNF} $DATA/orog_gsl.file1 + fi + wait + #rm $DATA/orog_gsl.file1 + + cp $orog_dir/C${res}_oro_data_*.tile${tile}*.nc $out_dir/ # gsl drag suite oro_data files + + fi + echo "Grid and orography files are now prepared" fi @@ -359,6 +520,10 @@ if [ $gtype = uniform -o $gtype = stretch -o $gtype = nest ]; then ntiles=`expr ${nest_grids} + 6` while [ $tile -le $ntiles ]; do cp $filter_dir/oro.${CASE}.tile${tile}.nc $out_dir/${CASE}_oro_data.tile${tile}.nc + if [ ${use_orog_gsl:-no} = yes ]; then + cp $orog_dir/${CASE}_oro_data_ls.tile${tile}.nc $out_dir/${CASE}_oro_data_ls.tile${tile}.nc + cp $orog_dir/${CASE}_oro_data_ss.tile${tile}.nc $out_dir/${CASE}_oro_data_ss.tile${tile}.nc + fi cp $grid_dir/${CASE}_grid.tile${tile}.nc $out_dir/${CASE}_grid.tile${tile}.nc tile=`expr $tile + 1 ` done @@ -371,6 +536,10 @@ if [ $gtype = regional -a $nest_grids -gt 1 ]; then ntiles=`expr ${nest_grids} + 6` while [ $tile -le $ntiles ]; do cp $filter_dir/oro.${CASE}.tile${tile}.nc $out_dir/${CASE}_oro_data.tile${tile}.nc + if [ ${use_orog_gsl:-no} = yes ]; then + cp $orog_dir/${CASE}_oro_data_ls.tile${tile}.nc $out_dir/${CASE}_oro_data_ls.tile${tile}.nc + cp $orog_dir/${CASE}_oro_data_ss.tile${tile}.nc $out_dir/${CASE}_oro_data_ss.tile${tile}.nc + fi cp $grid_dir/${CASE}_grid.tile${tile}.nc $out_dir/${CASE}_grid.tile${tile}.nc tile=`expr $tile + 1 ` done diff --git a/scripts/exhafs_atm_vi.sh b/scripts/exhafs_atm_vi.sh index e4d894522..bbadb1def 100755 --- a/scripts/exhafs_atm_vi.sh +++ b/scripts/exhafs_atm_vi.sh @@ -64,7 +64,7 @@ fi basin=${pubbasin2:-AL} tcvital=${DATA}/tcvitals.vi -vmax_vit=`cat ${tcvital} | cut -c68-69` +vmax_vit=`cat ${tcvital} | cut -c68-69 | bc -l` # Below two lines: Extract the basin infomration from storm ID: L, E, C, W, S, P, A, B storm=`cat ${tcvital} | awk '{print $2}'` @@ -85,32 +85,26 @@ if [[ ${vmax_vit} -ge ${vi_warm_start_vmax_threshold} ]] && [ -d ${RESTARTinp} ] for vortexradius in 30 45; do -if [[ ${vortexradius} == 30 ]]; then - res=0.02 -elif [[ ${vortexradius} == 45 ]]; then - res=0.20 -fi -cat > hafsvi_preproc_guess_${vortexradius}.sh << EOF -#!/bin/sh - # prep - work_dir=${DATA}/prep_guess - mkdir -p \${work_dir} - cd \${work_dir} - time ${DATOOL} hafsvi_preproc --in_dir=${RESTARTinp} \ + if [[ ${vortexradius} == 30 ]]; then + res=0.02 + elif [[ ${vortexradius} == 45 ]]; then + res=0.20 + fi + # prep + work_dir=${DATA}/prep_guess + mkdir -p ${work_dir} + cd ${work_dir} + time ${APRUNC} ${DATOOL} hafsvi_preproc --in_dir=${RESTARTinp} \ --debug_level=1 --interpolation_points=5 \ --infile_date=${CDATE:0:8}.${CDATE:8:2}0000 \ --tcvital=${tcvital} \ --vortexradius=${vortexradius} --res=${res} \ --nestdoms=$((${nest_grids:-1}-1)) \ --out_file=vi_inp_${vortexradius}deg${res/\./p}.bin - if [[ ${nest_grids} -gt 1 ]]; then - mv vi_inp_${vortexradius}deg${res/\./p}.bin vi_inp_${vortexradius}deg${res/\./p}.bin_grid01 - mv vi_inp_${vortexradius}deg${res/\./p}.bin_nest$(printf "%02d" ${nest_grids}) vi_inp_${vortexradius}deg${res/\./p}.bin - fi -EOF -chmod +x hafsvi_preproc_guess_${vortexradius}.sh -echo "./hafsvi_preproc_guess_${vortexradius}.sh > ./hafsvi_preproc_guess_${vortexradius}.log 2>&1" >> cmdfile_hafsvi_preproc - + if [[ ${nest_grids} -gt 1 ]]; then + mv vi_inp_${vortexradius}deg${res/\./p}.bin vi_inp_${vortexradius}deg${res/\./p}.bin_grid01 + mv vi_inp_${vortexradius}deg${res/\./p}.bin_nest$(printf "%02d" ${nest_grids}) vi_inp_${vortexradius}deg${res/\./p}.bin + fi done fi @@ -119,42 +113,28 @@ cd $DATA # Stage 0.2: Process current cycle's vortex from the global/parent model for vortexradius in 30 45; do -if [[ ${vortexradius} == 30 ]]; then - res=0.02 -elif [[ ${vortexradius} == 45 ]]; then - res=0.20 -fi -cat > hafsvi_preproc_init_${vortexradius}.sh << EOF -#!/bin/sh - # prep - work_dir=${DATA}/prep_init - mkdir -p \${work_dir} - cd \${work_dir} - time ${DATOOL} hafsvi_preproc --in_dir=${RESTARTinit} \ + if [[ ${vortexradius} == 30 ]]; then + res=0.02 + elif [[ ${vortexradius} == 45 ]]; then + res=0.20 + fi + # prep + work_dir=${DATA}/prep_init + mkdir -p ${work_dir} + cd ${work_dir} + time ${APRUNC} ${DATOOL} hafsvi_preproc --in_dir=${RESTARTinit} \ --debug_level=1 --interpolation_points=5 \ --infile_date=${CDATE:0:8}.${CDATE:8:2}0000 \ --tcvital=${tcvital} \ --vortexradius=${vortexradius} --res=${res} \ --nestdoms=$((${nest_grids:-1}-1)) \ --out_file=vi_inp_${vortexradius}deg${res/\./p}.bin - if [[ ${nest_grids} -gt 1 ]]; then - mv vi_inp_${vortexradius}deg${res/\./p}.bin vi_inp_${vortexradius}deg${res/\./p}.bin_grid01 - mv vi_inp_${vortexradius}deg${res/\./p}.bin_nest$(printf "%02d" ${nest_grids}) vi_inp_${vortexradius}deg${res/\./p}.bin - fi -EOF -chmod +x hafsvi_preproc_init_${vortexradius}.sh -echo "./hafsvi_preproc_init_${vortexradius}.sh > ./hafsvi_preproc_init_${vortexradius}.log 2>&1" >> cmdfile_hafsvi_preproc - + if [[ ${nest_grids} -gt 1 ]]; then + mv vi_inp_${vortexradius}deg${res/\./p}.bin vi_inp_${vortexradius}deg${res/\./p}.bin_grid01 + mv vi_inp_${vortexradius}deg${res/\./p}.bin_nest$(printf "%02d" ${nest_grids}) vi_inp_${vortexradius}deg${res/\./p}.bin + fi done -chmod +x cmdfile_hafsvi_preproc -if [ ${machine} = "wcoss2" ]; then - ncmd=$(cat ./cmdfile_hafsvi_preproc | wc -l) - ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) - $APRUNCFP -n $ncmd_max cfp ./cmdfile_hafsvi_preproc -else - ${APRUNC} ${MPISERIAL} -m cmdfile_hafsvi_preproc -fi #=============================================================================== # Stage 1: Process prior cycle's vortex if exists and storm intensity is @@ -175,20 +155,21 @@ if [[ ${vmax_vit} -ge ${vi_warm_start_vmax_threshold} ]] && [ -d ${RESTARTinp} ] #== This part is NOT applied to WPAC and NHC basin TCs #For the Southern hemisphere TCs, the basin ID in trak.atcfunix.all will be changed from SI (or SP) to SH if [ $region = "S" ]; then - cat trak.atcfunix.all|tr 'SI' 'SH' > temp1.txt + sed -i 's/SI/SH/g' trak.atcfunix.all fi if [ $region = "P" ]; then - cat trak.atcfunix.all|tr 'SP' 'SH' > temp1.txt + sed -i 's/SP/SH/g' trak.atcfunix.all fi #For the Northern Indian Ocean TCs, the basin ID in trak.atcfunix.all will be changed from AA (or BB) to IO if [ $region = "A" ]; then - cat trak.atcfunix.all|tr 'AA' 'IO' > temp1.txt + sed -i 's/AA/IO/g' trak.atcfunix.all fi if [ $region = "B" ]; then - cat trak.atcfunix.all|tr 'BB' 'IO' > temp1.txt + sed -i 's/BB/IO/g' trak.atcfunix.all fi - if [ $region = "S" ] || [ $region = "P" ] || [ $region = "A" ] || [ $region = "B" ]; then - mv temp1.txt trak.atcfunix.all # Replace the old trak.atcfunix.all!! + # For rare Southern Atlantic TCs: NOT tested yet! + if [ $region = "Q" ]; then + sed -i 's/QQ/SL/g' trak.atcfunix.all fi #============================================================================================ @@ -200,7 +181,7 @@ if [[ ${vmax_vit} -ge ${vi_warm_start_vmax_threshold} ]] && [ -d ${RESTARTinp} ] touch trak.atcfunix.tmp fi # get vmax in kt then convert into m/s - vmax_guess=$(grep "^${basin^^}, ${STORMID:0:2}, ${CDATEprior}, .., ...., 00${gesfhr}," trak.atcfunix.tmp | grep "34, NEQ," | cut -c48-51) + vmax_guess=$(grep "^${basin^^}, ${STORMID:0:2}, ${CDATEprior}, .., ...., 00${gesfhr}," trak.atcfunix.tmp | grep "34, NEQ," | cut -c48-51 | bc -l) vmax_guess=${vmax_guess:-0} vmax_guess=$( printf "%.0f" $(bc <<< "scale=6; ${vmax_guess}*0.514444") ) # calculate the abs difference @@ -293,20 +274,21 @@ cd $DATA #== This part is NOT applied to WPAC and NHC basin TCs #For the Southern hemisphere TCs, the basin ID in trak.atcfunix.all will be changed from SI (or SP) to SH if [ $region = "S" ]; then - cat trak.atcfunix.all|tr 'SI' 'SH' > temp1.txt + sed -i 's/SI/SH/g' trak.atcfunix.all fi if [ $region = "P" ]; then - cat trak.atcfunix.all|tr 'SP' 'SH' > temp1.txt + sed -i 's/SP/SH/g' trak.atcfunix.all fi #For the Northern Indian Ocean TCs, the basin ID in trak.atcfunix.all will be changed from AA (or BB) to IO if [ $region = "A" ]; then - cat trak.atcfunix.all|tr 'AA' 'IO' > temp1.txt + sed -i 's/AA/IO/g' trak.atcfunix.all fi if [ $region = "B" ]; then - cat trak.atcfunix.all|tr 'BB' 'IO' > temp1.txt + sed -i 's/BB/IO/g' trak.atcfunix.all fi - if [ $region = "S" ] || [ $region = "P" ] || [ $region = "A" ] || [ $region = "B" ]; then - mv temp1.txt trak.atcfunix.all # Replace the old trak.atcfunix.all!! + # For rare Southern Atlantic TCs: Not tested yet! + if [ $region = "Q" ]; then + sed -i 's/QQ/SL/g' trak.atcfunix.all fi #============================================================================================ @@ -318,7 +300,7 @@ cd $DATA touch trak.atcfunix.tmp fi # get vmax in kt then convert into m/s - vmax_init=$(grep "^${basin^^}, ${STORMID:0:2}, ${CDATE}, .., ...., 000," trak.atcfunix.tmp | grep "34, NEQ," | cut -c48-51) + vmax_init=$(grep "^${basin^^}, ${STORMID:0:2}, ${CDATE}, .., ...., 000," trak.atcfunix.tmp | grep "34, NEQ," | cut -c48-51 | bc -l) vmax_init=${vmax_init:-0} vmax_init=$( printf "%.0f" $(bc <<< "scale=6; ${vmax_init}*0.514444") ) # calculate the abs difference @@ -546,27 +528,16 @@ ${NCP} -rp ${RESTARTdst}/grid_*spec*.nc ${RESTARTout}/ ${NCP} -rp ${RESTARTdst}/oro_data*.nc ${RESTARTout}/ rm -f cmdfile_hafsvi_postproc -for nd in $(seq 1 ${nest_grids}) -do +for nd in $(seq 1 ${nest_grids}); do -cat >> cmdfile_hafsvi_postproc < nems.configure ngrids=${nest_grids} @@ -1097,41 +1140,36 @@ fi #if [ ${run_ocean} = yes ]; then if [ ${run_wave} = yes ]; then # link ww3 related files - ${NLN} ${COMhafs}/${out_prefix}.mod_def.ww3 mod_def.ww3 - ${NLN} ${COMhafs}/${out_prefix}.wind.ww3 wind.ww3 - ${NLN} ${COMhafs}/${out_prefix}.current.ww3 current.ww3 - ${NLN} ${COMhafs}/${out_prefix}.restart_init.ww3 restart.ww3 - ${NLN} ${COMhafs}/${out_prefix}.nest.ww3 nest.ww3 + ${NLN} ${WORKhafs}/intercom/ww3/mod_def.ww3 mod_def.ww3 + ${NLN} ${WORKhafs}/intercom/ww3/ww3_mesh.nc ww3_mesh.nc + ${NLN} ${WORKhafs}/intercom/ww3/wind.ww3 wind.ww3 + ${NLN} ${WORKhafs}/intercom/ww3/current.ww3 current.ww3 + ${NLN} ${WORKhafs}/intercom/ww3/restart_init.ww3 restart.ww3 + ${NLN} ${WORKhafs}/intercom/ww3/nest.ww3 nest.ww3 # copy parms - ${NCP} ${PARMww3}/ww3_multi.inp_tmpl ./ww3_multi.inp_tmpl - # generate ww3_multi.inp + ${NCP} ${PARMww3}/ww3_shel.inp_tmpl ./ww3_shel.inp_tmpl + # generate ww3_shel.inp + INPUT_CURFLD="F F" + INPUT_WNDFLD=${INPUT_WNDFLD:-"C F"} + INPUT_ICEFLD="F F" EDATE=$($NDATE +${NHRS} ${CDATE}) RDATE=$($NDATE +6 ${CDATE}) RUN_BEG="${CDATE:0:8} ${CDATE:8:2}0000" - FLD_BEG="${RUN_BEG}" - PNT_BEG="${RUN_BEG}" - RST_BEG="${RUN_BEG}" + FLD_BEG=${RUN_BEG} + PNT_BEG=${RUN_BEG} + RST_BEG=${RUN_BEG} RUN_END="${EDATE:0:8} ${EDATE:8:2}0000" - FLD_END="${RUN_END}" - PNT_END="${RUN_END}" + FLD_END=${RUN_END} + PNT_END=${RUN_END} RST_END="${RDATE:0:8} ${RDATE:8:2}0000" FLD_DT=$((3600*${NOUTHRS})) PNT_DT=$((3600*${NOUTHRS})) RST_DT=$((3600*6)) + GOFILETYPE=0 + POFILETYPE=0 + OUTPARS_WAV="WND HS T01 T02 DIR FP DP PHS PTP PDIR UST CHA USP" + atparse < ./ww3_shel.inp_tmpl > ./ww3_shel.inp - sed -e "s//${CPL_WND}/g" \ - -e "s//${RUN_BEG}/g" \ - -e "s//${RUN_END}/g" \ - -e "s//${FLD_BEG}/g" \ - -e "s//${FLD_DT}/g" \ - -e "s//${FLD_END}/g" \ - -e "s//${PNT_BEG}/g" \ - -e "s//${PNT_DT}/g" \ - -e "s//${PNT_END}/g" \ - -e "s//${RST_BEG}/g" \ - -e "s//${RST_DT}/g" \ - -e "s//${RST_END}/g" \ - ./ww3_multi.inp_tmpl > ./ww3_multi.inp fi #if [ ${run_wave} = yes ]; then if [ ${run_init:-no} = no ]; then @@ -1145,7 +1183,7 @@ if [ ${ENSDA} = YES ]; then ${NCP} -p ${WORKhafs}/intercom/RESTART_init_ens/mem${ENSID}/atmos_static*.nc RESTART/ fi if [ -s ${WORKhafs}/intercom/RESTART_init_ens/mem${ENSID}/oro_data.nc ]; then - ${NCP} -p ${WORKhafs}/intercom/RESTART_init_ens/mem${ENSID}/oro_data.n*c RESTART/ + ${NCP} -p ${WORKhafs}/intercom/RESTART_init_ens/mem${ENSID}/oro_data*.n*c RESTART/ fi else if [ -s ${WORKhafs}/intercom/RESTART_init/grid_spec.nc ]; then @@ -1155,7 +1193,7 @@ else ${NCP} -p ${WORKhafs}/intercom/RESTART_init/atmos_static*.nc RESTART/ fi if [ -s ${WORKhafs}/intercom/RESTART_init/oro_data.nc ]; then - ${NCP} -p ${WORKhafs}/intercom/RESTART_init/oro_data.n*c RESTART/ + ${NCP} -p ${WORKhafs}/intercom/RESTART_init/oro_data*.n*c RESTART/ fi fi diff --git a/scripts/exhafs_merge.sh b/scripts/exhafs_merge.sh index c64c34fde..dfbfce984 100755 --- a/scripts/exhafs_merge.sh +++ b/scripts/exhafs_merge.sh @@ -21,7 +21,7 @@ NDATE=${NDATE:-ndate} export NCP=${NCP:-"/bin/cp"} export NMV=${NMV:-"/bin/mv"} export NLN=${NLN:-"/bin/ln -sf"} -export MPISERIAL=${MPISERIAL:-${EXEChafs}/hafs_mpiserial.x} +#export MPISERIAL=${MPISERIAL:-${EXEChafs}/hafs_mpiserial.x} export DATOOL=${DATOOL:-${EXEChafs}/hafs_datool.x} PDY=`echo $CDATE | cut -c1-8` @@ -48,9 +48,9 @@ else tcvital=${WORKhafs}/tmpvit fi if [ ${merge_method} = vortexreplace ]; then - MERGE_CMD="${DATOOL} vortexreplace --tcvital=${tcvital} --infile_date=${PDY}.${cyc}0000 --vortexradius=650:700" + MERGE_CMD="${APRUNC} ${DATOOL} vortexreplace --tcvital=${tcvital} --infile_date=${PDY}.${cyc}0000 --vortexradius=650:700" elif [ ${merge_method} = domainmerge ]; then - MERGE_CMD="${DATOOL} remap" + MERGE_CMD="${APRUNC} ${DATOOL} remap" else echo "Error: unsupported merge_method: ${merge_method}" exit 1 @@ -59,7 +59,6 @@ fi # Regional single domain configuration if [[ $nest_grids -eq 1 ]]; then -rm -f cmdfile_datool_merge #for var in fv_core.res.tile1 fv_tracer.res.tile1 fv_srf_wnd.res.tile1 sfc_data phy_data; for var in fv_core.res.tile1 fv_tracer.res.tile1 fv_srf_wnd.res.tile1 sfc_data; do @@ -72,26 +71,12 @@ do echo "ERROR: Missing in/out_grid or in/out_file. Exitting..." exit 1 fi - cat >> cmdfile_datool_merge << EOF time ${MERGE_CMD} \ --in_grid=${in_grid} \ --out_grid=${out_grid} \ --in_file=${in_file} \ - --out_file=${out_file} \ - > datool.${var}.log 2>&1 -EOF + --out_file=${out_file} done -chmod +x cmdfile_datool_merge -[ $machine = wcoss_cray ] && set +e -if [ ${machine} = "wcoss2" ]; then - ncmd=$(cat ./cmdfile_datool_merge | wc -l) - ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) - $APRUNCFP -n $ncmd_max cfp ./cmdfile_datool_merge -else - ${APRUNC} ${MPISERIAL} -m cmdfile_datool_merge -fi -[ $machine = wcoss_cray ] && set -e -cat datool.*.log # Regional with one nest configuration # The following steps are needed @@ -107,7 +92,6 @@ if [ ${MERGE_TYPE} = analysis ]; then # Step 1: merge src02 into src01 (for analysis_merge) ${NCP} -rp ${RESTARTsrc}/* ${RESTARTtmp}/ -rm -f cmdfile_datool_merge.step1 for var in fv_core.res fv_tracer.res fv_srf_wnd.res sfc_data; do in_grid=${RESTARTtmp}/grid_mspec.nest02_${yr}_${mn}_${dy}_${hh}.tile2.nc @@ -123,32 +107,17 @@ do echo "ERROR: Missing in/out_grid or in/out_file. Exitting..." exit 1 fi - cat >> cmdfile_datool_merge.step1 << EOF time ${MERGE_CMD} \ --in_grid=${in_grid} \ --out_grid=${out_grid} \ --in_file=${in_file} \ - --out_file=${out_file} \ - > datool.${var}.step1.log 2>&1 -EOF + --out_file=${out_file} done -chmod +x cmdfile_datool_merge.step1 -[ $machine = wcoss_cray ] && set +e -if [ ${machine} = "wcoss2" ]; then - ncmd=$(cat ./cmdfile_datool_merge.step1 | wc -l) - ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) - $APRUNCFP -n $ncmd_max cfp ./cmdfile_datool_merge.step1 -else - ${APRUNC} ${MPISERIAL} -m cmdfile_datool_merge.step1 -fi -[ $machine = wcoss_cray ] && set -e -cat datool.*.step1.log elif [ ${MERGE_TYPE} = init ]; then # Step 1: merge srcd02 into srcd01 (for atm_merge) ${NLN} ${RESTARTsrc}/* ${RESTARTtmp}/ -rm -f cmdfile_datool_merge.step1 for var in fv_core.res fv_tracer.res fv_srf_wnd.res sfc_data; do in_grid=${RESTARTtmp}/grid_mspec_${yr}_${mn}_${dy}_${hh}.nc @@ -164,26 +133,12 @@ do echo "ERROR: Missing in/out_grid or in/out_file. Exitting..." exit 1 fi - cat >> cmdfile_datool_merge.step1 << EOF time ${MERGE_CMD} \ --in_grid=${in_grid} \ --out_grid=${out_grid} \ --in_file=${in_file} \ - --out_file=${out_file} \ - > datool.${var}.step1.log 2>&1 -EOF + --out_file=${out_file} done -chmod +x cmdfile_datool_merge.step1 -[ $machine = wcoss_cray ] && set +e -if [ ${machine} = "wcoss2" ]; then - ncmd=$(cat ./cmdfile_datool_merge.step1 | wc -l) - ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) - $APRUNCFP -n $ncmd_max cfp ./cmdfile_datool_merge.step1 -else - ${APRUNC} ${MPISERIAL} -m cmdfile_datool_merge.step1 -fi -[ $machine = wcoss_cray ] && set -e -cat datool.*.step1.log else echo "Error unsupported MERGE_TYPE: ${MERGE_TYPE}" @@ -191,7 +146,6 @@ else fi # Step 2: merge srcd01 into dstd01 -rm -f cmdfile_datool_merge.step2 for var in fv_core.res fv_tracer.res fv_srf_wnd.res sfc_data; do in_grid=${RESTARTtmp}/grid_mspec_${yr}_${mn}_${dy}_${hh}.nc @@ -208,29 +162,14 @@ do echo "ERROR: Missing in/out_grid or in/out_file. Exitting..." exit 1 fi - cat >> cmdfile_datool_merge.step2 << EOF time ${MERGE_CMD} \ --in_grid=${in_grid} \ --out_grid=${out_grid} \ --in_file=${in_file} \ - --out_file=${out_file} \ - > datool.${var}.step2.log 2>&1 -EOF + --out_file=${out_file} done -chmod +x cmdfile_datool_merge.step2 -[ $machine = wcoss_cray ] && set +e -if [ ${machine} = "wcoss2" ]; then - ncmd=$(cat ./cmdfile_datool_merge.step2 | wc -l) - ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) - $APRUNCFP -n $ncmd_max cfp ./cmdfile_datool_merge.step2 -else - ${APRUNC} ${MPISERIAL} -m cmdfile_datool_merge.step2 -fi -[ $machine = wcoss_cray ] && set -e -cat datool.*.step2.log # Step 3: merge srcd02 into dstd02 -rm -f cmdfile_datool_merge.step3 for var in fv_core.res fv_tracer.res fv_srf_wnd.res sfc_data; do in_grid=${RESTARTtmp}/grid_mspec.nest02_${yr}_${mn}_${dy}_${hh}.tile2.nc @@ -242,26 +181,12 @@ do echo "ERROR: Missing in/out_grid or in/out_file. Exitting..." exit 1 fi - cat >> cmdfile_datool_merge.step3 << EOF time ${MERGE_CMD} \ --in_grid=${in_grid} \ --out_grid=${out_grid} \ --in_file=${in_file} \ - --out_file=${out_file} \ - > datool.${var}.step3.log 2>&1 -EOF + --out_file=${out_file} done -chmod +x cmdfile_datool_merge.step3 -[ $machine = wcoss_cray ] && set +e -if [ ${machine} = "wcoss2" ]; then - ncmd=$(cat ./cmdfile_datool_merge.step3 | wc -l) - ncmd_max=$((ncmd < TOTAL_TASKS ? ncmd : TOTAL_TASKS)) - $APRUNCFP -n $ncmd_max cfp ./cmdfile_datool_merge.step3 -else - ${APRUNC} ${MPISERIAL} -m cmdfile_datool_merge.step3 -fi -[ $machine = wcoss_cray ] && set -e -cat datool.*.step3.log else echo "Error: only support nest_grids = 1 or 2" diff --git a/sorc/build_forecast.sh b/sorc/build_forecast.sh index 97dc2e634..5ca404760 100755 --- a/sorc/build_forecast.sh +++ b/sorc/build_forecast.sh @@ -9,11 +9,8 @@ if [ $target = jet ]; then target=jet.intel ; fi if [ $target = cheyenne ]; then target=cheyenne.intel ; fi if [ $target = wcoss2 ]; then target=wcoss2.intel ; fi -if [ $target = wcoss_cray ]; then - app=HAFSW -else - app=HAFS-ALL -fi +app=HAFS-ALL + cd hafs_forecast.fd/tests ./compile.sh "$target" "-DAPP=HAFSW -DMOVING_NEST=ON -DCCPP_SUITES=FV3_HAFS_v0_thompson_noahmp_nonsst,FV3_HAFS_v0_thompson_noahmp,FV3_HAFS_v0_thompson_nonsst,FV3_HAFS_v0_thompson,FV3_HAFS_v0_gfdlmp_tedmf_nonsst,FV3_HAFS_v0_gfdlmp_tedmf,FV3_HAFS_v0_thompson_tedmf_gfdlsf -D32BIT=ON" 32bit YES NO diff --git a/sorc/build_gsi.sh b/sorc/build_gsi.sh index b2491a28d..1e19a6cab 100755 --- a/sorc/build_gsi.sh +++ b/sorc/build_gsi.sh @@ -5,7 +5,8 @@ cwd=`pwd` cd hafs_gsi.fd/ush/ -#./build_all_cmake.sh "PRODUCTION" "$cwd/hafs_gsi.fd" -./build_all_cmake.sh "BUILD_FV3reg" "$cwd/hafs_gsi.fd" +export GSI_MODE=Regional +export ENKF_MODE=FV3REG +./build.sh exit diff --git a/sorc/build_hycom_utils.sh b/sorc/build_hycom_utils.sh index 5b073fb75..676ccccac 100755 --- a/sorc/build_hycom_utils.sh +++ b/sorc/build_hycom_utils.sh @@ -3,14 +3,8 @@ set -eux source ./machine-setup.sh > /dev/null 2>&1 cwd=`pwd` -if [ $target = wcoss_cray ]; then - export DM_FC="ftn -static" - export DM_F90="ftn -free -static" - export DM_CC="cc -static" -fi - module use ../modulefiles -module load modulefile.hafs.$target +module load hafs.$target module list cd hafs_hycom_utils.fd/libs @@ -19,13 +13,9 @@ if [ -d "build" ]; then fi mkdir build cd build -if [ $target = wcoss_cray ]; then - CMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER:-ftn} - CMAKE_C_COMPILER=${CMAKE_C_COMPILER:-cc} -else - CMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER:-ifort} - CMAKE_C_COMPILER=${CMAKE_C_COMPILER:-icc} -fi + +CMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER:-ifort} +CMAKE_C_COMPILER=${CMAKE_C_COMPILER:-icc} cmake .. -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} make -j 8 VERBOSE=1 @@ -35,13 +25,8 @@ if [ -d "build" ]; then fi mkdir build cd build -if [ $target = wcoss_cray ]; then - CMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER:-ftn} - CMAKE_C_COMPILER=${CMAKE_C_COMPILER:-cc} -else - CMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER:-ifort} - CMAKE_C_COMPILER=${CMAKE_C_COMPILER:-icc} -fi +CMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER:-ifort} +CMAKE_C_COMPILER=${CMAKE_C_COMPILER:-icc} cmake .. -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} make -j 8 VERBOSE=1 make install diff --git a/sorc/build_tools.sh b/sorc/build_tools.sh index 1de6b2331..c6182283b 100755 --- a/sorc/build_tools.sh +++ b/sorc/build_tools.sh @@ -5,7 +5,7 @@ cwd=`pwd` export target=${target} module use ../modulefiles -module load modulefile.hafs.${target} +module load hafs.${target} module list if [ $target = hera ] || [ $target = orion ] || [ $target = jet ]; then @@ -13,17 +13,13 @@ if [ $target = hera ] || [ $target = orion ] || [ $target = jet ]; then export F90=ifort export CC=icc export MPIFC=mpif90 -elif [ $target = wcoss_cray ] || [ $target = wcoss2 ]; then +elif [ $target = wcoss2 ]; then export FC="ftn -static" export F90="ftn -free -static" export CC=icc export DM_FC="ftn -static" export DM_F90="ftn -free -static" export DM_CC="cc -static" -elif [ $target = wcoss_dell_p3 ]; then - export FC=ifort - export F90=ifort - export CC=icc else echo "Unknown machine = $target" exit 1 @@ -33,9 +29,9 @@ fi #export NETCDF_LDFLAGS=${NETCDF_LDFLAGS:-"-L${NETCDF}/lib -lnetcdf -lnetcdff"} export NETCDF_INCLUDE="-I${NETCDF}/include" export NETCDF_LDFLAGS="-L${NETCDF}/lib -lnetcdff -lnetcdf" -export HDF5_INCLUDE=${HDF5_INCLUDE:-"-I${HDF5_INCLUDES:-"-I${HDF5}/include"}}"} +export HDF5_INCLUDE=${HDF5_INCLUDE:-"-I${HDF5_INCLUDES:--I${HDF5}/include}"} #export HDF5_LDFLAGS=${HDF5_LDFLAGS:-"-L${HDF5}/lib -lhdf5_hl -lhdf5hl_fortran -lhdf5 -lhdf5_fortran"} -export HDF5_LDFLAGS=${HDF5_LDFLAGS:-"-L${HDF5_LIBRARIES:-"${HDF5}/lib"} -lhdf5_hl -lhdf5"} +export HDF5_LDFLAGS=${HDF5_LDFLAGS:-"-L${HDF5_LIBRARIES:-${HDF5}/lib} -lhdf5_hl -lhdf5"} export BUFR_LDFLAGS="${BUFR_LIBd}" #export ZLIB_INCLUDE=${ZLIB_INCLUDE:-"-I${ZLIB_INCLUDES:--I${ZLIB_ROOT}/include}"} #export ZLIB_LDFLAGS=${ZLIB_LDFLAGS:-"-L${ZLIB_LIBRARIES:--L${ZLIB_ROOT}/lib} -lz -ldl -lm"} @@ -49,11 +45,7 @@ if [ -d "${TOOLS_PATH}/build" ]; then fi mkdir ${TOOLS_PATH}/build cd ${TOOLS_PATH}/build -if [ $target = wcoss_cray ]; then - cmake .. -DCMAKE_Fortran_COMPILER=ftn -DCMAKE_C_COMPILER=cc -DBUILD_TYPE=RELEASE -else - cmake .. -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_C_COMPILER=icc -DBUILD_TYPE=RELEASE -fi +cmake .. -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} #make -j 8 make -j 8 VERBOSE=1 make install diff --git a/sorc/build_ww3_utils.sh b/sorc/build_ww3_utils.sh index 4ff1ea9d7..72777a1d6 100755 --- a/sorc/build_ww3_utils.sh +++ b/sorc/build_ww3_utils.sh @@ -9,7 +9,7 @@ if [ ! -d "../exec" ]; then fi module use ../modulefiles -module load modulefile.hafs.${target} +module load hafs.${target} module list if [ $target = hera ]; then target=hera.intel ; fi diff --git a/sorc/hafs_forecast.fd b/sorc/hafs_forecast.fd index 64ba88ba2..59546fe4e 160000 --- a/sorc/hafs_forecast.fd +++ b/sorc/hafs_forecast.fd @@ -1 +1 @@ -Subproject commit 64ba88ba2bfd75f23cac7872215d67de74d39fd7 +Subproject commit 59546fe4e0ea3183faa4a8f61d109ca04f07de64 diff --git a/sorc/hafs_graphics.fd/emc_graphics b/sorc/hafs_graphics.fd/emc_graphics index 8e935ad17..48fff9cbe 160000 --- a/sorc/hafs_graphics.fd/emc_graphics +++ b/sorc/hafs_graphics.fd/emc_graphics @@ -1 +1 @@ -Subproject commit 8e935ad170271c76800a58b900095504f48b42f0 +Subproject commit 48fff9cbeafe6a29e798c9e1ad873f4d3603f67d diff --git a/sorc/hafs_gsi.fd b/sorc/hafs_gsi.fd index 6b89a2a63..c9aa156ff 160000 --- a/sorc/hafs_gsi.fd +++ b/sorc/hafs_gsi.fd @@ -1 +1 @@ -Subproject commit 6b89a2a63c02ab150a2a422a2b7860cb0ec7b461 +Subproject commit c9aa156ffdb5b02ea93ba147de47e59490df0d27 diff --git a/sorc/hafs_tools.fd/sorc/build_hafs_utils.sh b/sorc/hafs_tools.fd/sorc/build_hafs_utils.sh index 2b9cd0829..c565cd1ea 100755 --- a/sorc/hafs_tools.fd/sorc/build_hafs_utils.sh +++ b/sorc/hafs_tools.fd/sorc/build_hafs_utils.sh @@ -77,11 +77,7 @@ _hafsutils_analysis_update (){ cd ${HAFS_UTILS_SORC}/build # Generate makefile using CMake for the application - if [[ $target = "wcoss_cray" ]]; then - cmake ../hafs_analysis_update -DCMAKE_Fortran_COMPILER=ftn -DCMAKE_C_COMPILER=cc - else - cmake ../hafs_analysis_update -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_C_COMPILER=icc - fi + cmake ../hafs_analysis_update -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} # Build the analysis-update application. @@ -121,11 +117,7 @@ _hafsutils_obs_preproc (){ cd ${HAFS_UTILS_SORC}/build # Generate makefile using CMake for the application - if [[ $target = "wcoss_cray" ]]; then - cmake ../hafs_obs_preproc -DCMAKE_Fortran_COMPILER=ftn -DCMAKE_C_COMPILER=cc - else - cmake ../hafs_obs_preproc -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_C_COMPILER=icc - fi + cmake ../hafs_obs_preproc -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} # Build the obs-preproc application. make all @@ -164,11 +156,7 @@ _hafsutils_change_prepbufr (){ cd ${HAFS_UTILS_SORC}/build # Generate makefile using CMake for the application - if [[ $target = "wcoss_cray" ]]; then - cmake ../hafs_change_prepbufr -DCMAKE_Fortran_COMPILER=ftn -DCMAKE_C_COMPILER=cc - else - cmake ../hafs_change_prepbufr -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_C_COMPILER=icc - fi + cmake ../hafs_change_prepbufr -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} # Build the hafs_change_prepbufr application. make all @@ -209,11 +197,7 @@ _hafsutils_datool (){ # Generate makefile using CMake for the application # BUILD_TYPE supports RELEASE OR DEBUG MODE - if [[ $target = "wcoss_cray" ]]; then - cmake ../hafs_datool -DCMAKE_Fortran_COMPILER=ftn -DCMAKE_C_COMPILER=cc -DBUILD_TYPE=RELEASE - else - cmake ../hafs_datool -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_C_COMPILER=icc -DBUILD_TYPE=RELEASE - fi + cmake ../hafs_datool -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} -DBUILD_TYPE=RELEASE # Build the hafs_datool application. make all VERBOSE=3 @@ -253,11 +237,7 @@ _hafsutils_vi (){ # Generate makefile using CMake for the application # BUILD_TYPE supports RELEASE OR DEBUG MODE - if [[ $target = "wcoss_cray" ]]; then - cmake ../hafs_vi -DCMAKE_Fortran_COMPILER=ftn -DCMAKE_C_COMPILER=cc -DBUILD_TYPE=RELEASE - else - cmake ../hafs_vi -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_C_COMPILER=icc -DBUILD_TYPE=RELEASE - fi + cmake ../hafs_vi -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} -DBUILD_TYPE=RELEASE # Build the hafs_vi application. make all VERBOSE=3 @@ -382,7 +362,7 @@ _extlib_shtns (){ # compilation. if [ $target = wcoss2 ]; then - export LDFLAGS=-L${HAFS_UTILS_EXTLIBS}/lib64 + export LDFLAGS=-L${HAFS_UTILS_EXTLIBS}/lib64 else export LDFLAGS=-L${HAFS_UTILS_EXTLIBS}/lib fi diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/hafs_datool.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/hafs_datool.f90 index 81e0727dc..67738f059 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/hafs_datool.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/hafs_datool.f90 @@ -8,7 +8,7 @@ program hafs_datool ! hafs_datool.x FUNCTION --in_file=input_files \ ! --in_grid=input_grids_file \ ! --in_format=restart \ -! --out_grid=output_grid_file +! --out_grid=output_grid_file ! ! Usage and Examples: ! @@ -25,13 +25,13 @@ program hafs_datool ! if no dir info, then find the file[s] in in_dir folder; ! --in_grid: input_grids_file, for FV3, it may be grid_spec.nc ! if no this argument, then find grid information from in_file. -! +! ! 3) Examples ! 3.1) remap ! * hafs_datool.x remap --in_file=${in_dir}/20190829.060000.phy_data.nc \ ! --in_grid=${in_dir}/grid_spec.nc \ -! --out_grid=${out_dir}/grid_spec.nc -! : interpolate 20190829.060000.phy_data.nc to grid_spec.nc grids, if grid_spec.nc +! --out_grid=${out_dir}/grid_spec.nc +! : interpolate 20190829.060000.phy_data.nc to grid_spec.nc grids, if grid_spec.nc ! domain is bigger than input, then fill missing values. ! * mpirun -np 32 hafs_datool.x remap \ ! --in_file=${in_dir}/20190829.060000.phy_data.nc \ @@ -55,9 +55,9 @@ program hafs_datool ! * hafs_datool.x hafsvi_preproc --in_dir=HAFS_restart_folder --infile_date=20200825.180000 \ ! [--vortexposition=user_define_vortex_file --tcvital=tcvitalfile \ ! --besttrack=bdeckfile ] [--vortexradius=deg ] \ -! [--nestdoms=nestdoms ] \ +! [--nestdoms=nestdoms ] \ ! [ --tc_date=tcvital_date] [--res=deg ] \ -! [--out_file=output_bin_file] +! [--out_file=output_bin_file or nc_file] ! ! 3.4) vi_postproc ! * hafs_datool.x hafsvi_postproc --in_file=[hafs_vi rot-ll bin file] \ @@ -67,7 +67,7 @@ program hafs_datool use module_mpi use var_type use netcdf - + implicit none !----parameter define @@ -76,21 +76,21 @@ program hafs_datool character (len=2500) :: in_dir='w', in_file='w', in_grid='w', & vortex_position_file='w', tcvital_file='w', besttrackfile='w', & out_dir='w', out_grid='w', out_data='w', out_file='w', infile_date='w' - character (len=50 ) :: vortexradius='w' ! for vortexreplace, vortexradius=600:900 km + character (len=50 ) :: vortexradius='w' ! for vortexreplace, vortexradius=600:900 km ! for hafsvi_preproc, vortexradius=30 deg or 45 deg - character (len=50 ) :: relaxzone='' ! + character (len=50 ) :: relaxzone='' ! character (len=50 ) :: tc_date='w' ! character (len=50 ) :: res='w' ! character (len=50 ) :: debug_levelc='' ! character (len=50 ) :: interpolation_pointsc='' ! - character (len=50 ) :: nestdomsc='' ! number for nest domains, 1-30, 1=nest02.tile2 + character (len=50 ) :: nestdomsc='' ! number for nest domains, 1-30, 1=nest02.tile2 ! in vi_preproc, combine all domains and output to one rot-ll grid. real, dimension(3) :: center !---------------------------------------------------------------- ! 0 --- initialization ! Initialize parallel stuff -! call parallel_start() + call parallel_start() !---------------------------------------------------------------- ! 1 --- argc and usage @@ -117,9 +117,9 @@ program hafs_datool case ('--tcvital'); tcvital_file=arg(j+1:n) case ('--besttrack'); besttrackfile=arg(j+1:n) case ('--vortexradius'); vortexradius=arg(j+1:n) - case ('--infile_date'); infile_date=arg(j+1:n) !20210312.0930 + case ('--infile_date'); infile_date=arg(j+1:n) !20210312.0930 case ('--relaxzone'); relaxzone=arg(j+1:n) - case ('--tc_date'); tc_date=arg(j+1:n) !20210312.0930 + case ('--tc_date'); tc_date=arg(j+1:n) !20210312.0930 case ('--res'); res=arg(j+1:n) !0.02 case ('--debug_level'); debug_levelc=arg(j+1:n) ! case ('--interpolation_points'); interpolation_pointsc=arg(j+1:n) ! @@ -170,7 +170,7 @@ program hafs_datool write(*,'(a)')' --infile_date=input_file_date' stop endif - endif + endif if ( trim(tc_date) == "w" .and. len_trim(infile_date) > 1 ) then tc_date=trim(infile_date) endif @@ -197,7 +197,11 @@ program hafs_datool ! 4.0 --- HAFS VI if ( trim(actions) == "hafsvi_preproc" ) then write(*,'(a)')' --- call hafsvi_preproc/hafs_datool for '//trim(in_grid) - call hafsvi_preproc(trim(in_dir), trim(infile_date), nestdoms, trim(vortexradius), trim(res), trim(out_file)) + if ( index(trim(out_file),'.nc') > 1 ) then + call hafsvi_preproc_nc(trim(in_dir), trim(infile_date), nestdoms, trim(vortexradius), trim(res), trim(out_file)) + else + call hafsvi_preproc(trim(in_dir), trim(infile_date), nestdoms, trim(vortexradius), trim(res), trim(out_file)) + endif endif if ( trim(actions) == "hafsvi_postproc" ) then @@ -206,6 +210,12 @@ program hafs_datool endif !---------------------------------------------------------------- -! call parallel_finish() + call parallel_finish() + + if ( trim(actions) == "hafsvi_postproc" ) then + write(*,'(a)')' === finished '//trim(actions)//' '//trim(out_dir)//' for nestdoms '//trim(nestdomsc)//' ===' + else + write(*,'(a)')' === finished '//trim(actions)//' '//trim(out_file)//' ===' + endif end program diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/module_mpi.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/module_mpi.f90 index 579b098af..c0fe110f3 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/module_mpi.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/module_mpi.f90 @@ -1,28 +1,11 @@ - - module module_mpi !----------------------------------------------------------------------------- ! PURPOSE: This module provides routines for parallelizing. -! !------------------------------------------------------------------------------ - - - use MPI - - - integer, parameter :: IO_NODE = 0 - integer :: nprocs, my_proc_id, comm, ierr, request, nprocs_mod, tag - double precision :: time_start, time_end - integer, dimension(MPI_STATUS_SIZE) :: status - - real :: mpisend - real, allocatable, dimension(: ) :: mpirecv - - real, allocatable, dimension(: ) :: mpisend1d - real, allocatable, dimension(:,:) :: mpirecv1d - - integer :: prev, next + use mpi + integer :: nprocs, my_proc_id, comm, ierr + integer, dimension(mpi_status_size) :: status contains @@ -31,29 +14,18 @@ module module_mpi !------------------------------------------------------------------------------ subroutine parallel_start() - implicit none - - ! Arguments - - ! Local variables - - integer :: mpi_rank, mpi_size - integer :: mpi_ierr - - ! Find out our rank and the total number of processors - call MPI_Init(mpi_ierr) - call MPI_Comm_rank(MPI_COMM_WORLD, mpi_rank, mpi_ierr) - call MPI_Comm_size(MPI_COMM_WORLD, mpi_size, mpi_ierr) - time_start = MPI_Wtime() - - comm = MPI_COMM_WORLD - nprocs = mpi_size - my_proc_id = mpi_rank - - - + implicit none + integer :: mpi_rank, mpi_size + integer :: mpi_ierr + ! Find out our rank and the total number of processors + call mpi_init(mpi_ierr) + call MPI_Comm_rank(MPI_COMM_WORLD, mpi_rank, mpi_ierr) + call MPI_Comm_size(MPI_COMM_WORLD, mpi_size, mpi_ierr) + comm = MPI_COMM_WORLD + nprocs = mpi_size + my_proc_id = mpi_rank end subroutine parallel_start @@ -62,19 +34,12 @@ end subroutine parallel_start !------------------------------------------------------------------------------ subroutine parallel_finish() - implicit none - - ! Arguments - - ! Local variables + implicit none - integer :: mpi_ierr - - time_end = MPI_Wtime() - call MPI_Finalize(mpi_ierr) + !integer :: mpi_ierr + call MPI_Finalize(ierr) end subroutine parallel_finish - end module module_mpi diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/module_structure.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/module_structure.f90 index 00f209c03..83845d36d 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/module_structure.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/module_structure.f90 @@ -55,12 +55,12 @@ module var_type type tc_track_info integer :: vortexrep ! 1=tc vortex-replacement, others are not real :: lat, lon, pmin, vmax - real, dimension(2) :: vortexreplace_r + real, dimension(2) :: vortexreplace_r end type tc_track_info type(tc_track_info) :: tc integer :: debug_level ! default is 1, only print basic information - ! 2-9: + ! 2-9: end module var_type - + diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_grids.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_grids.f90 index 1438b5999..763ae4506 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_grids.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_grids.f90 @@ -67,7 +67,7 @@ end subroutine rtll !-----------------------------------------------------------------------+ !--- from hwrf_wps.fd/geogrid/src/module_map_utils.f90 -!--- modified +!--- modified subroutine ijll_rotlatlon(i, j, phi, lambda, ixdim, jydim, lat1, lon1, stagger, lat,lon) implicit none @@ -265,5 +265,5 @@ subroutine EARTH_LATLON ( HLAT,HLON,VLAT,VLON, & !Earth lat,lon at H and V p ENDDO END SUBROUTINE EARTH_LATLON - + !-----------------------------------------------------------------------+ diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafs_remap.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafs_remap.f90 index 3e322d49a..02b29a5ad 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafs_remap.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafs_remap.f90 @@ -8,10 +8,10 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, ! This subroutine drives the interpolation from one-grid to another grid. ! src_file + dst_file -- > out_file in dst_grid: merge src_file and dst_file to out_file ! src_file --> out_file: only interpolate src_file to out_fuile -! +! ! note: -- input files should are on the same grids, which means only read grid info once. ! -- out_file is just one filename, which only out to one output file -! -- +! -- !----------------------------------------------------------------------------- use netcdf @@ -22,14 +22,14 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, character (len=*), intent(in) :: src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, out_file - integer :: i, j, k, n, i0, n_srcfl, n_dstfl, i1, j1, k1, n1, nf, nv - character (len=2500) :: srcdir, srcgridfl, dstdir, dstgridfl + integer :: i, j, k, n, i0, n_srcfl, n_dstfl, i1, j1, k1, n1, nf, nv, nm + character (len=2500) :: srcdir, srcgridfl, dstdir, dstgridfl character (len=2500),dimension(50) :: srcfiles, dstfiles - + type(grid2d_info) :: grid_src, grid_dst logical :: outside, if_fv_core_file - integer, allocatable, dimension(:,:) :: x_oini, y_oini + integer, allocatable, dimension(:,:) :: x_oini, y_oini real :: dis, dis0, out_ave_dx, out_ave_dy integer :: ixi, jxi, kxi, txi, ixo, jxo, kxo, txo integer :: ncid, varid, ndims, nvars, xtype, dimids(5), vdim(5), u_stag, v_stag @@ -54,14 +54,14 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, srcdir=trim(src_dir)//' ' endif write(*,'(a)')' --- source dir: '//trim(srcdir) - + ! 1.2 --- source files j=0; n_srcfl=0 do i = 1, len_trim(src_file) if ( src_file(i:i) == ":" .or. i == len_trim(src_file) ) then n_srcfl=n_srcfl+1 i0=1; if ( i == len_trim(src_file) ) i0=0 - if (src_file(j+1:j+1) == '/' .or. src_file(j+1:j+2) == './' ) then + if (src_file(j+1:j+1) == '/' .or. src_file(j+1:j+2) == './' .or. len_trim(srcdir) < 3 ) then srcfiles(n_srcfl) = src_file(j+1:i-i0) else srcfiles(n_srcfl) = trim(srcdir)//'/'//src_file(j+1:i-i0) @@ -69,20 +69,20 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, j=i endif !if ( src_file(i:i) == ":" enddo !do i = 1, len_trim(src_file) - write(*,'(a,i,a)')' --- there is', n_srcfl, ' source file(s)' + write(*,'(a,i,a)')' --- there is', n_srcfl, ' source file(s)' ! 1.3 --- source grid: one file includes grid-info, could be the same as the source files if (len_trim(src_grid) < 2 ) then srcgridfl=srcfiles(1) else - if (src_grid(1:1) == '/' .or. src_grid(1:2) == './' ) then + if (src_grid(1:1) == '/' .or. src_grid(1:2) == './' .or. len_trim(srcdir) < 3 ) then srcgridfl=trim(src_grid) else srcgridfl=trim(srcdir)//'/'//trim(src_grid) endif endif -! 1.4 --- destination dir : the files used for being-mergered. +! 1.4 --- destination dir : the files used for being-mergered. if (len_trim(dst_dir) < 2 .or. trim(dst_dir) == 'w' .or. trim(dst_dir) == 'null' ) then dstdir='.' else @@ -92,30 +92,33 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, ! 1.5 --- will-be-merged data: if have, src_file+dst_file-->out_file ! if not, src_file -->out_file -! - j=0; n_dstfl=0 - do i = 1, len_trim(dst_file) - if ( dst_file(i:i) == ":" .or. i == len_trim(dst_file) ) then - n_dstfl=n_dstfl+1 - i0=1; if ( i == len_trim(dst_file) ) i0=0 - if (dst_file(j+1:j+1) == '/' .or. dst_file(j+1:j+2) == './' ) then - dstfiles(n_dstfl) = dst_file(j+1:i-i0) - else - dstfiles(n_dstfl) = trim(dstdir)//'/'//dst_file(j+1:i-i0) - endif - j=i - endif !if ( dst_file(i:i) == ":" - enddo !do i = 1, len_trim(dst_file) - write(*,'(a,i,a)')' --- there is', n_dstfl, ' file(s) will be merged.' - +! + n_dstfl=0 + if ( len_trim(dst_file) > 2 ) then + j=0 + do i = 1, len_trim(dst_file) + if ( dst_file(i:i) == ":" .or. i == len_trim(dst_file) ) then + n_dstfl=n_dstfl+1 + i0=1; if ( i == len_trim(dst_file) ) i0=0 + if (dst_file(j+1:j+1) == '/' .or. dst_file(j+1:j+2) == './' .or. len_trim(dstdir) < 2) then + dstfiles(n_dstfl) = dst_file(j+1:i-i0) + else + dstfiles(n_dstfl) = trim(dstdir)//'/'//dst_file(j+1:i-i0) + endif + j=i + endif !if ( dst_file(i:i) == ":" + enddo !do i = 1, len_trim(dst_file) + write(*,'(a,i,a)')' --- there is', n_dstfl, ' file(s) will be merged.' + endif + ! 1.6 --- destination grid if (len_trim(dst_grid) < 2 ) then dstgridfl=dstfiles(1) else - if ( dst_grid(1:1) == '/' .or. dst_grid(1:2) == './' ) then + if ( dst_grid(1:1) == '/' .or. dst_grid(1:2) == './' .or. len_trim(dstdir) < 2) then dstgridfl=dst_grid else - dstgridfl=trim(dst_dir)//'/'//trim(dst_grid) + dstgridfl=trim(dstdir)//'/'//trim(dst_grid) endif endif write(*,'(a)')' --- remap to grid: '//trim(dstgridfl) @@ -123,10 +126,11 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, ! 1.7 --- out_file if (len_trim(out_file) > 2) then !output to one file - if ( out_file(1:1) == '/' .or. out_file(1:2) == './' ) then - do j = 1, n_srcfl; dstfiles(j)=trim(out_file); enddo + if ( out_file(1:1) == '/' .or. out_file(1:2) == './' .or. len_trim(dstdir) < 2) then + do j = 1, n_srcfl; n_dstfl=n_dstfl+1; dstfiles(j)=trim(out_file); enddo else do j = 1, n_srcfl; write(*,*)'j=',j + n_dstfl=n_dstfl+1 dstfiles(j)=trim(dstdir)//'/'//trim(out_file); enddo endif else @@ -135,7 +139,7 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, !------------------------------------------------------------------------------ ! 2 --- input grid info -! read from grid file grid_spec.nc: +! read from grid file grid_spec.nc: write(*,'(a)')' --- read grid info from '//trim(srcgridfl) call rd_grid_spec_data(trim(srcgridfl), grid_src) @@ -150,10 +154,10 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, !------------------------------------------------------------------------------ ! 5 --- inputfiles' loop - do_inputfiles_loop: do nf = 1, n_srcfl !srcfiles(nf) + do_inputfiles_loop: do nf = 1, n_srcfl !srcfiles(nf) call nccheck(nf90_open(trim(srcfiles(nf)), nf90_nowrite, ncid), 'wrong in open '//trim(srcfiles(nf)), .false.) call nccheck(nf90_inquire(ncid, ndims, nvars), 'wrong in inquire ncid', .true.) - !dimensions of fv3 restart: + !dimensions of fv3 restart: ! grid_spec.nc: grid_xt = 2880, grid_yt = 2400, grid_x = 2881, grid_y = 2401 ! fv_core.res.tile1.nc: xaxis_1 = 2880, yaxis_2 = 2400, xaxis_2 = 2881, yaxis_1 = 2401, zaxis_1 = 91 ! fv_srf_wnd.res.tile1.nc: xaxis_1 = 2880, yaxis_1 = 2400 @@ -171,16 +175,22 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, ! if ( trim(dimname) == 'xaxis_1' .or. trim(dimname) == 'yaxis_2' .or. trim(dimname) == 'xaxis_2' .or. trim(dimname) == 'yaxis_1' ) & ! k=k+1 !enddo - !if ( k == 4 ) if_fv_core_file = .true. + !if ( k == 4 ) if_fv_core_file = .true. ! 5.1 --- variables' loop - do_input_var_loop: do nv=1, nvars - + !do_input_var_loop: do nv=1, nvars + !----change parallel computing for variables + nm=max(1,int((nvars+nprocs-1)/nprocs)) + do_input_var_loop: do n1=1, nm + nv=(n1-1)*nprocs+my_proc_id+1 + if ( nv > nvars ) exit do_input_var_loop + ! 5.1.1 --- get variable's dimension dimids=-1; vdim=-1 call nccheck(nf90_inquire_variable(ncid,nv,varname,xtype,ndims,dimids), & 'wrong in inquire_variable '//trim(varname), .false.) - + write(*,*)' my_proc_id,nprocs,nv,varname: ',my_proc_id,nprocs,nv, trim(varname) + do i = 1, ndims call nccheck(nf90_inquire_dimension(ncid,dimids(i), len=vdim(i)), 'wrong in inquire '//trim(varname)//' dim', .false.) enddo @@ -189,11 +199,11 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, !write(*,'(a,2i6)')' NF90_FLOAT, NF90_DOUBLE=', NF90_FLOAT,NF90_DOUBLE !---skip xaxis_1(xaxis_1), yaxis_1(yaxis_1), zaxis_1(zaxis_1) - if ( ndims < 2 ) cycle do_input_var_loop + if ( ndims < 2 ) cycle do_input_var_loop ! 5.1.2 --- determine mass/u/v grids u_stag=0; v_stag=0 - if ( ndims == 4 ) then + if ( ndims == 4 ) then ixi=vdim(1); jxi=vdim(2); kxi=vdim(3); txi=vdim(4) else if ( ndims == 3) then ixi=vdim(1); jxi=vdim(2); kxi=vdim(3); txi=1 !here kxi is time dimension @@ -211,38 +221,38 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, write(*,'(a,2i5)')' --- '//trim(varname)//' dimension: ', ixi, jxi cycle do_input_var_loop endif - if (jxi == grid_src%grid_y ) u_stag=1 - if (ixi == grid_src%grid_x ) v_stag=1 - + if (jxi == grid_src%grid_y ) u_stag=1 + if (ixi == grid_src%grid_x ) v_stag=1 + ! 5.1.3 --- get src data write(*,'(a)')'---get '//trim(varname)//' from '//trim(srcfiles(nf)) call nccheck(nf90_inq_varid(ncid, trim(varname), varid), 'wrong in inquire '//trim(varname)//' varid', .false.) allocate(fdat_src(ixi, jxi, kxi, txi)) if ( xtype == nf90_float .or. xtype == nf90_real .or. xtype == nf90_real4 ) then - call nccheck(nf90_get_var(ncid, varid, fdat_src), 'wrong in get '//trim(varname)//' from '//trim(srcfiles(nf)), .true.) + call nccheck(nf90_get_var(ncid, varid, fdat_src), 'wrong in get '//trim(varname)//' from '//trim(srcfiles(nf)), .true.) else if ( xtype == nf90_double .or. xtype == nf90_real8 ) then allocate(ddat_src(ixi, jxi, kxi, txi)) - call nccheck(nf90_get_var(ncid, varid, ddat_src), 'wrong in get '//trim(varname)//' from '//trim(srcfiles(nf)), .true.) + call nccheck(nf90_get_var(ncid, varid, ddat_src), 'wrong in get '//trim(varname)//' from '//trim(srcfiles(nf)), .true.) fdat_src=real(ddat_src) deallocate(ddat_src) else write(*,*)' !!!! please add ',xtype,' xtype data here ' stop endif - + ! 5.1.4 --- get dst data ixo=grid_dst%grid_xt+v_stag; jxo=grid_dst%grid_yt+u_stag; kxo=kxi; txo=txi !current no vertical/time interpolation allocate(fdat_dst(ixo,jxo,kxo,txo)) - + !---inqure the variables from dstfiles(n_dstfl) if ( n_dstfl > 0 ) then noutfl=-1 - do_search_var_from_dstfiles: do n = 1, n_dstfl + do_search_var_from_dstfiles: do n = 1, n_dstfl call nccheck(nf90_open(trim(dstfiles(n)), nf90_nowrite, ncid1), 'wrong in open '//trim(dstfiles(n)), .false.) rcode=nf90_inq_varid(ncid1, trim(varname), varid1) write(*,'(a,2i6)')'---inq '//trim(varname), rcode, nf90_noerr if ( rcode /= nf90_noerr ) then - call nccheck(nf90_close(ncid1), 'wrong in close '//trim(dstfiles(n)), .false.) + call nccheck(nf90_close(ncid1), 'wrong in close '//trim(dstfiles(n)), .false.) cycle do_search_var_from_dstfiles else !write(*,'(a,4i5)')'dst grid size: ', ixo,jxo,kxo,txo @@ -261,7 +271,7 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, endif enddo do_search_var_from_dstfiles endif !if ( n_dstfl > 0 ) then - + ! 5.1.5 --- merge dat_src + dat_dst --> data_merge: with distance-weightnening average ! --- when output is out of input-grid: xin/yin < 0 or xin/yin > max, fill with output data !----allocate gw, gw=gwt%gwt_t, gwt_u, gwt_v @@ -284,7 +294,7 @@ subroutine hafs_remap(src_dir, src_grid, src_file, dst_dir, dst_grid, dst_file, else if ( u_stag == 0 .and. v_stag == 1 ) then call combine_grids_for_remap(ixi, jxi, kxi, txi, fdat_src, ixo, jxo, kxo, txo, fdat_dst, & gwt%gwt_v, fdat_out) - endif + endif if ( xtype == nf90_double .or. xtype == nf90_real8 ) then allocate(ddat_out(ixo,jxo,kxo,txo)) ddat_out=dble(fdat_out) diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafsvi_proc.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafsvi_proc.f90 index c9b586005..019f0ed34 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafsvi_proc.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_hafsvi_proc.f90 @@ -37,8 +37,8 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) implicit none character (len=*), intent(in) :: in_dir, in_date, radius, res, out_file - integer, intent(in) :: nestdoms -!--- in_dir, HAFS_restart_folder, which holds grid_spec.nc, fv_core.res.tile1.nc, + integer, intent(in) :: nestdoms +!--- in_dir, HAFS_restart_folder, which holds grid_spec.nc, fv_core.res.tile1.nc, ! fv_srf_wnd.res.tile1.nc, fv_tracer.res.tile1.nc, phy_data.nc, sfc_data.nc !--- in_date, HAFS_restart file date, like 20200825.120000 !--- radius, to cut a square, default value is 40, which means a 40deg x 40deg square. @@ -48,19 +48,20 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) !--- 2-nest03.tile3 + 1 character (len=2500) :: indir, infile - character (len=2500) :: infile_fvcore, infile_core, infile_tracer, infile_phy, infile_sfc, infile_grid, infile_grid2, infile_atmos, infile_oro + character (len=2500) :: infile_fvcore, infile_core, infile_tracer, infile_phy, & + infile_sfc, infile_grid, infile_grid2, infile_atmos, infile_oro type(grid2d_info) :: dstgrid ! rot-ll grid for output type(grid2d_info) :: ingrid ! hafs restart grid real :: radiusf logical :: file_exist - + !----for hafs restart integer :: ix, iy, iz, kz, ndom, nd character (len=50) :: nestfl, tilefl, tempfl ! grid_spec.nc : grid_spec.nest02.tile2.nc ! fv_core.res.tile1.nc : fv_core.res.nest02.tile2.nc ! phy_data.nc : phy_data.nest02.tile2.nc - + !----for hafsvi integer :: nx, ny, nz, filetype ! filetype: 1=bin, 2=nc real :: lon1,lat1,lon2,lat2,cen_lat,cen_lon,dlat,dlon @@ -76,14 +77,17 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) !real, allocatable, dimension(:) :: pfull, phalf real, allocatable, dimension(:,:) :: cangu, sangu, cangv, sangv - real :: cputime1, cputime2, cputime3 - + real :: cputime1, cputime2, cputime3 + integer :: io_proc, nm, ks, ke, nv + + !------------------------------------------------------------------------------ ! 1 --- arg process + io_proc=nprocs-1 + !io_proc=0 ! ! 1.1 --- ndom - ndom=nestdoms+1 - + ndom=nestdoms+1 ! 1.2 --- input_dir if (len_trim(in_dir) < 2 .or. trim(in_dir) == 'w' .or. trim(in_dir) == 'null') then @@ -98,9 +102,9 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) read(radius,*)i radiusf = real(i) if ( radiusf < 3. .or. radiusf > 70. ) then - write(*,'(a)')'!!! hafsvi cut radius number wrong: '//trim(radius) - write(*,'(a)')'!!! please call with --vortexradius=40 (75< 3)' - stop 'hafsvi_preproc' + if ( my_proc_id == 0 ) write(*,'(a)')'!!! hafsvi cut radius number wrong: '//trim(radius) + if ( my_proc_id == 0 ) write(*,'(a)')'!!! please call with --vortexradius=40 (75< 3)' + stop 'hafsvi_preproc' endif endif @@ -116,7 +120,7 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) ! 2.1 --- define rot-ll grid cen_lat = tc%lat cen_lon = tc%lon - nx = int(radiusf/2.0/dlon+0.5)*2+1 + nx = int(radiusf/2.0/dlon+0.5)*2+1 ny = int(radiusf/2.0/dlat+0.5)*2+1 lon1 = - radiusf/2.0 lat1 = - radiusf/2.0 @@ -124,15 +128,17 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) lat2 = radiusf/2.0 !!--- get rot-ll grid allocate(glon(nx,ny), glat(nx,ny)) + !$omp parallel do & + !$omp& private(i,j,rot_lon,rot_lat) do j = 1, ny; do i = 1, nx rot_lon = lon1 + dlon*(i-1) rot_lat = lat1 + dlat*(j-1) call rtll(rot_lon, rot_lat, glon(i,j), glat(i,j), cen_lon, cen_lat) enddo; enddo - write(*,'(a)')'---rot-ll grid: nx, ny, cen_lon, cen_lat, dlon, dlat, lon1, lon2, lat1, lat2' - write(*,'(15x,2i5,8f10.5)') nx, ny, cen_lon, cen_lat, dlon, dlat, lon1, lon2, lat1, lat2 - !write(*,'(a,4f10.5)')'---rot-ll grid rot_lon:', glon(1,1), glon(1,ny), glon(nx,ny), glon(nx,1) - !write(*,'(a,4f10.5)')'---rot-ll grid rot_lat:', glat(1,1), glat(1,ny), glat(nx,ny), glat(nx,1) + if ( my_proc_id == 0 ) write(*,'(a)')'---rot-ll grid: nx, ny, cen_lon, cen_lat, dlon, dlat, lon1, lon2, lat1, lat2' + if ( my_proc_id == 0 ) write(*,'(15x,2i5,8f10.5)') nx, ny, cen_lon, cen_lat, dlon, dlat, lon1, lon2, lat1, lat2 + !write(*,'(a,4f10.5)')'---rot-ll grid rot_lon:', glon(1,1), glon(1,ny), glon(nx,ny), glon(nx,1) + !write(*,'(a,4f10.5)')'---rot-ll grid rot_lat:', glat(1,1), glat(1,ny), glat(nx,ny), glat(nx,1) ! 2.2 --- set dstgrid dstgrid%grid_x = nx @@ -148,14 +154,14 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) allocate(dstgrid%grid_latt(dstgrid%grid_x,dstgrid%grid_y)) dstgrid%grid_lat = glat dstgrid%grid_latt = glat - + !------------------------------------------------------------------------------ ! 3 --- process output file type: now is only for bin ! i=len_trim(out_file) ! if ( out_file(i-2:i) == '.nc' ) then ! write(*,'(a)')' --- output to '//trim(out_file) ! filetype=2 -! call nccheck(nf90_open(trim(out_file), nf90_write, flid), 'wrong in open '//trim(out_file), .true.) +! call nccheck(nf90_open(trim(out_file), nf90_write, flid), 'wrong in open '//trim(out_file), .true.) ! else ! filetype=1 ! flid=71 @@ -176,7 +182,7 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) ! read from grid file grid_spec.nc: ! nestfl, tilefl: infile_core, infile_tracer, infile_grid, infile_atmos, infile_oro write(nestfl,'(a4,i2.2)')'nest',nd - write(tilefl,'(a4,i0)')'tile',nd + write(tilefl,'(a4,i0)')'tile',nd if ( nd == 1 ) then infile_grid=trim(indir)//'/grid_spec.nc' infile_grid2=trim(indir)//'/grid_mspec_'//in_date(1:4)//'_'//in_date(5:6)//'_'//in_date(7:8)//'_'//in_date(10:11)//'.nc' @@ -202,362 +208,1631 @@ subroutine hafsvi_preproc(in_dir, in_date, nestdoms, radius, res, out_file) inquire(file=infile_grid2, exist=file_exist) if ( file_exist ) infile_grid = infile_grid2 - if ( debug_level > 10 ) write(*,'(a)')' --- read grid info from '//trim(infile_grid) + if ( debug_level > 10 .and. my_proc_id == 0 ) write(*,'(a)')' --- read grid info from '//trim(infile_grid) call rd_grid_spec_data(trim(infile_grid), ingrid) ix=ingrid%grid_xt iy=ingrid%grid_yt - if ( debug_level > 10 ) then + if ( debug_level > 10 .and. my_proc_id == 0 ) then write(*,'(a,i,1x,i,1x,f,1x,f,1x,f,1x,f)')' --- ingrid info: ', ix, iy, & - ingrid%grid_lon(int(ix/2), int(iy/2)), ingrid%grid_lat(int(ix/2), int(iy/2)), & + ingrid%grid_lon(int(ix/2), int(iy/2)), ingrid%grid_lat(int(ix/2), int(iy/2)), & ingrid%grid_lont(int(ix/2), int(iy/2)), ingrid%grid_latt(int(ix/2), int(iy/2)) endif !---to add the test if the tc was inside of the domain - + ! call FV3-grid cos and sin - allocate( cangu(ix,iy+1),sangu(ix,iy+1),cangv(ix+1,iy),sangv(ix+1,iy) ) - call cal_uv_coeff_fv3(ix, iy, ingrid%grid_lat, ingrid%grid_lon, cangu, sangu, cangv, sangv) + allocate( cangu(ix,iy+1),sangu(ix,iy+1),cangv(ix+1,iy),sangv(ix+1,iy) ) + call cal_uv_coeff_fv3(ix, iy, ingrid%grid_lat, ingrid%grid_lon, cangu, sangu, cangv, sangv) !------------------------------------------------------------------------- ! 5 --- calculate output-grid in input-grid's positions (xin, yin), and each grid's weight to dst if ( debug_level > 10 ) then - write(*,'(a)')' --- call cal_src_dst_grid_weight' - write(*,'(a,2(I,1x),2(f,1x))')' --- dstgrid: ', nx, ny, & - dstgrid%grid_lont(int(nx/2),int(ny/2)), dstgrid%grid_latt(int(nx/2),int(ny/2)) + if ( my_proc_id == 0 ) write(*,'(a)')' --- call cal_src_dst_grid_weight' + write(*,'(i,a,2(i,1x),2(f,1x))')my_proc_id,' --- dstgrid: ', nx, ny, & + dstgrid%grid_lont(int(nx/2),int(ny/2)), dstgrid%grid_latt(int(nx/2),int(ny/2)) endif call cal_src_dst_grid_weight(ingrid, dstgrid) !------------------------------------------------------------------------- ! 6 --- dst files - flid_in=71 !inner domain rot-ll file - flid_out=72 !current domain rot-ll file - if ( nd == 1 ) then - open(unit=flid_out,file=trim(out_file),form='unformatted',status='unknown') - else - open(unit=flid_out,file=trim(out_file)//'_'//trim(nestfl),form='unformatted',status='unknown') - endif - if ( nd == 2 ) then !if ( nd >= 1 .and. nd < ndom .and. ndom > 1 ) then - open(unit=flid_in,file=trim(out_file),form='unformatted',status='old') - elseif ( nd > 2 ) then !if ( nd >= 1 .and. nd < ndom .and. ndom > 1 ) then - write(tempfl,'(a4,i2.2)')'nest',nd-1 - open(unit=flid_in,file=trim(out_file)//'_'//trim(tempfl),form='unformatted',status='old') + if ( my_proc_id == io_proc ) then + flid_in=71 !inner domain rot-ll file + flid_out=72 !current domain rot-ll file + if ( nd == 1 ) then + open(unit=flid_out,file=trim(out_file),form='unformatted',status='unknown') + else + open(unit=flid_out,file=trim(out_file)//'_'//trim(nestfl),form='unformatted',status='unknown') + endif + if ( nd == 2 ) then !if ( nd >= 1 .and. nd < ndom .and. ndom > 1 ) then + open(unit=flid_in,file=trim(out_file),form='unformatted',status='old') + elseif ( nd > 2 ) then !if ( nd >= 1 .and. nd < ndom .and. ndom > 1 ) then + write(tempfl,'(a4,i2.2)')'nest',nd-1 + open(unit=flid_in,file=trim(out_file)//'_'//trim(tempfl),form='unformatted',status='old') + endif endif !------------------------------------------------------------------------- ! 7 --- output do_out_var_loop: do nrecord = 1, 17 + !write(*,*)my_proc_id, '=== nrecord =',nrecord !----------------------------- - !---7.1 record 1: nx, ny, nz + !---7.1 record 1: nx, ny, nz !---nx, ny, nz, & lon1,lat1,lon2,lat2,cen_lon,cen_lat call cpu_time(cputime1) - write(*,'(a,i3,f)')' --- record start cputime: ', nrecord, cputime1 - if ( nrecord == 1 ) then + if ( my_proc_id == io_proc ) write(*,'(a,i3,f)')' --- record start cputime: ', nrecord, cputime1 + if ( nrecord == 1 ) then call get_var_dim(trim(infile_atmos), 'pfull', ndims, dims) nz=dims(1) - iz=nz !same vertical levels - - write(*,'(a,3i6)')'=== record1: ',nx, ny, nz - write(flid_out) nx, ny, nz - if ( nd > 1 ) read(flid_in) + + if ( my_proc_id == io_proc ) write(*,'(a,3i6)')'=== record1: ',nx, ny, nz + if ( my_proc_id == io_proc ) write(flid_out) nx, ny, nz + if ( nd > 1 .and. my_proc_id == io_proc ) read(flid_in) endif + iz=nz !same vertical levels + if ( nrecord == 12 .or. nrecord == 15 .or. nrecord == 16 .or. nrecord ==17 ) iz=1 + if ( nrecord == 9 .or. nrecord == 11 ) iz=nz+1 + !----------------------------- !---7.2 record 2: lon1,lat1,lon2,lat2,cen_lon,cen_lat if ( nrecord == 2 ) then - write(*,'(a,6f8.3)')'=== record2: ',lon1,lat1,lon2,lat2,cen_lon,cen_lat - write(flid_out) lon1,lat1,lon2,lat2,cen_lon,cen_lat - if ( nd > 1 ) read(flid_in) - endif + write(*,'(i,a,6f8.3)')my_proc_id, '=== record2: ',lon1,lat1,lon2,lat2,cen_lon,cen_lat + if ( my_proc_id == io_proc ) write(*,'(a,6f8.3)')'=== record2: ',lon1,lat1,lon2,lat2,cen_lon,cen_lat + if ( my_proc_id == io_proc ) write(flid_out) lon1,lat1,lon2,lat2,cen_lon,cen_lat + if ( nd > 1 .and. my_proc_id == io_proc ) read(flid_in) + write(*,*)'==== finished record 2 at ', my_proc_id + endif !----------------------------- !---7.3 record 3: (((pf1(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) !--- hafs-VI/read_hafs_out.f90 pf: !--- ph(k) = ak(k) + bk(k)*p_s --> half level pressure !--- pf(k) = (ph(k+1) - ph(k)) / log(ph(k+1)/ph(k)) --> full level pressure - !--- - !---seem pf1 is pressure on full level, use + !--- + !---seem pf1 is pressure on full level, use !--- pf1(k) = phalf(1) + sum(delp(1:k)) - if ( nrecord == 3 ) then - allocate(dat4(iz+1,1,1,1)) - call get_var_data(trim(infile_atmos), 'phalf', iz+1, 1, 1, 1, dat4) - ptop=dat4(1,1,1,1)*100. !phalf:units = "mb" ; - deallocate(dat4) + if ( nrecord == 3 .or. nrecord == 9 .or. nrecord == 11 ) then + if ( nrecord == 3 ) then + allocate(dat4(iz+1,1,1,1)) + call get_var_data(trim(infile_atmos), 'phalf', iz+1, 1, 1, 1, dat4) + ptop=dat4(1,1,1,1)*100. !phalf:units = "mb" ; + deallocate(dat4) + endif - allocate(dat4(ix, iy, iz,1)) - allocate(dat41(ix, iy, iz,1)) - allocate(dat2(ix, iy)) - !write(*,'(a,3i5)')'delp: ',ix, iy, iz - call get_var_data(trim(infile_core), 'delp', ix, iy, iz,1, dat4) - dat2(:,:)=ptop - do k = 1, iz - dat41(:,:,k,1)=dat2(:,:)+dat4(:,:,k,1)/2.0 - dat2(:,:)=dat2(:,:)+dat4(:,:,k,1) - enddo - allocate(sfcp(ix, iy)) - sfcp=dat41(:,:,iz,1) - deallocate(dat2,dat4) + if ( my_proc_id == io_proc ) then + if ( nrecord == 3 ) then + allocate(dat4(ix, iy, iz,1)) + allocate(dat41(ix, iy, iz,1)) + allocate(dat2(ix, iy)) + !write(*,'(a,3i5)')'delp: ',ix, iy, iz + call get_var_data(trim(infile_core), 'delp', ix, iy, iz,1, dat4) + dat2(:,:)=ptop + do k = 1, iz + dat41(:,:,k,1)=dat2(:,:)+dat4(:,:,k,1)/2.0 + dat2(:,:)=dat2(:,:)+dat4(:,:,k,1) + enddo + allocate(sfcp(ix, iy)) + sfcp=dat41(:,:,iz,1) + deallocate(dat2, dat4) + else if ( nrecord == 9 ) then + allocate(dat4(ix, iy, 1,1)) + call get_var_data(trim(infile_core), 'phis', ix, iy, 1, 1, dat4) + allocate(dat41(ix, iy, iz, 1)) + dat41(:,:,iz,1)=dat4(:,:,1,1)/g + deallocate(dat4) + allocate(dat4(ix, iy, iz-1, 1)) + call get_var_data(trim(infile_core), 'DZ', ix, iy, iz-1, 1, dat4) + do k = iz-1, 1, -1 + dat41(:,:,k,1)=dat41(:,:,k+1,1)-dat4(:,:,k,1) + enddo + deallocate(dat4) + else if ( nrecord == 11 ) then + allocate(dat4(ix, iy, iz-1, 1), dat41(ix, iy, iz, 1)) + call get_var_data(trim(infile_core), 'delp', ix, iy, iz-1, 1, dat4) + dat41(:,:,1,1)=ptop + do k = 2, iz + dat41(:,:,k,1)=dat41(:,:,k-1,1)+dat4(:,:,k-1,1) + enddo + deallocate(dat4) + endif !if ( nrecord == 3 ) then + + !---broadcast dat41 to each computing-core + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) !devide iz to each processor + do k = 0, nprocs-1 + ks=k*nm+1 !k-start + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(ix, iy, ke-ks+1,1)) + dat42(:,:,:,1)=dat41(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1), size(dat42), mpi_real, k, 3000+ks, comm, ierr) + else + allocate(dat43(ix, iy, ke-ks+1,1)) + dat43=dat42 + endif + deallocate(dat42) + endif + enddo + else !if ( nprocs > 1 ) then + allocate(dat43(ix, iy, iz,1)) + dat43=dat41 + endif + deallocate(dat41) + else ! if ( my_proc_id == io_proc ) then + !---receive dat43 + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat43(ix, iy, ke-ks+1,1)) + !call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, mpi_any_tag, comm, status, ierr) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 3000+ks, comm, status, ierr) + endif + endif endif !----------------------------- !---7.4 record 4: (((tmp(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) - if ( nrecord == 4 ) then - allocate(dat4(ix, iy, iz,1)) - call get_var_data(trim(infile_core), 'T', ix, iy, iz,1, dat4) - !--- need any other processing? - allocate(dat41(ix, iy, iz,1)) - dat41=dat4*1.0 - deallocate(dat4) - endif - - !----------------------------- !---7.5 record 5: (((spfh(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) - if ( nrecord == 5 ) then - allocate(dat4(ix, iy, iz,1)) - call get_var_data(trim(infile_tracer), 'sphum', ix, iy, iz,1, dat4) - allocate(dat41(ix, iy, iz,1)) - dat41=dat4*1.0 - deallocate(dat4) + !---7.8 record 8: (((dzdt(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) + if ( nrecord == 4 .or. nrecord == 5 .or. nrecord == 8 ) then + if ( my_proc_id == io_proc ) then + !---read in + allocate(dat4(ix, iy, iz,1)) + if ( nrecord == 4 ) call get_var_data(trim(infile_core), 'T', ix, iy, iz,1, dat4) + if ( nrecord == 5 ) call get_var_data(trim(infile_tracer), 'sphum', ix, iy, iz,1, dat4) + if ( nrecord == 8 ) call get_var_data(trim(infile_core), 'W', ix, iy, iz,1, dat4) + !---send to other core + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(ix, iy, ke-ks+1,1)) + dat42(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1), size(dat42), mpi_real, k, 4000+ks, comm, ierr) + else + allocate(dat43(ix, iy, ke-ks+1,1)) + dat43=dat42 + endif + deallocate(dat42) + endif + enddo + else + allocate(dat43(ix, iy, iz,1)) + dat43=dat4 + endif + deallocate(dat4) + else !if ( my_proc_id == io_proc ) then + !---receive dat43 + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat43(ix, iy, ke-ks+1,1)) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 4000+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then endif - + !----------------------------- !---7.6 record 6: (((ugrd(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) !---7.7 record 7: (((vgrd(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) if ( nrecord == 6 ) then !---get u,v from restart - allocate(dat41(ix, iy+1, iz,1), dat42(ix+1, iy, iz, 1)) - call get_var_data(trim(infile_core), 'u', ix, iy+1, iz, 1, dat41) - call get_var_data(trim(infile_core), 'v', ix+1, iy, iz, 1, dat42) + if ( my_proc_id == io_proc ) then + do nv = 1, 2 + if (nv==1) then + allocate(dat4(ix, iy+1, iz,1)) + call get_var_data(trim(infile_core), 'u', ix, iy+1, iz, 1, dat4) + else if (nv==2) then + allocate(dat4(ix+1, iy, iz,1)) + call get_var_data(trim(infile_core), 'v', ix+1, iy, iz, 1, dat4) + endif + !---send to other core + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + if (nv==1) then + allocate(dat41(ix, iy+1, ke-ks+1,1)) + else if (nv==2) then + allocate(dat41(ix+1, iy, ke-ks+1,1)) + endif + dat41(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat41(1,1,1,1), size(dat41), mpi_real, k, 200*nv+ks, comm, ierr) + else + if (nv==1) then + allocate(dat42(ix, iy+1, ke-ks+1,1)) + dat42=dat41 + else if (nv==2) then + allocate(dat43(ix+1, iy, ke-ks+1,1)) + dat43=dat41 + endif + endif + deallocate(dat41) + endif + enddo + else !if ( nprocs > 1 ) then + if (nv==1) then + allocate(dat42(ix, iy+1, iz,1)) + dat42=dat4 + else if (nv==2) then + allocate(dat43(ix+1, iy, iz,1)) + dat43=dat4 + endif + endif + deallocate(dat4) + enddo !do nv = 1, 2 + else !if ( my_proc_id == io_proc ) then + !---receive dat42 dat43 + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(ix, iy+1, ke-ks+1,1), dat43(ix+1, iy, ke-ks+1,1)) + call mpi_recv(dat42(1,1,1,1), size(dat42), mpi_real, io_proc, 200*1+ks, comm, status, ierr) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 200*2+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then + !write(*,*)'===w11 distributed u,v @ dat42,dat43' + endif - !---convert u,v from fv3grid to earth - allocate(u(ix, iy, iz,1), v(ix, iy, iz, 1)) - allocate(dat2(ix, iy+1), dat21(ix+1, iy)) - do k = 1, iz - call fv3uv2earth(ix, iy, dat41(:,:,k,1), dat42(:,:,k,1), cangu, sangu, cangv, sangv, dat2, dat21) - !---destage: C-/D- grid to A-grid - u(:,:,k,1) = (dat2 (:,1:iy)+dat2 (:,2:iy+1))/2.0 - v(:,:,k,1) = (dat21(1:ix,:)+dat21(2:ix+1,:))/2.0 - enddo + !!----------------------------- + !!---7.9 record 9: (((z1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) + !!--- hafs-VI/read_hafs_out.f90 z1: + !!--- z1(I,J,K)=z1(I,J,K+1)+rdgas1*tmp(i,j,k)*(1.+0.608*spfh(i,j,k))*ALOG(ph1(i,j,k+1)/ph1(i,j,k)) + !!--- hgt: phis/g-sum(DZ) + !if ( nrecord == 9 ) then + ! allocate(dat4(ix, iy, 1,1)) + ! call get_var_data(trim(infile_core), 'phis', ix, iy, 1, 1, dat4) + ! allocate(dat41(ix, iy, iz+1, 1)) + ! dat41(:,:,iz+1,1)=dat4(:,:,1,1)/g + ! deallocate(dat4) + + ! allocate(dat4(ix, iy, iz, 1)) + ! call get_var_data(trim(infile_core), 'DZ', ix, iy, iz, 1, dat4) + ! do k = iz, 1, -1 + ! dat41(:,:,k,1)=dat41(:,:,k+1,1)-dat4(:,:,k,1) + ! enddo + ! !write(*,'(a,200f)')'z1: ',dat41(int(ix/2),int(iy/2),:,1) + ! deallocate(dat4) + !endif - deallocate(dat41, dat42, dat2, dat21, cangu, sangu, cangv, sangv) - endif - !----------------------------- - !---7.8 record 8: (((dzdt(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) - if ( nrecord == 8 ) then - allocate(dat4(ix, iy+1, iz,1)) - call get_var_data(trim(infile_core), 'W', ix, iy, iz,1, dat4) + !---7.10 record 10: glon,glat,glon,glat ! 2D + !--- glat=grid_yt*180./pi, grid_yt=1:2160, what is this? + if ( nrecord == 10 ) then + if ( my_proc_id == io_proc ) then + write(*,'(a,4f8.3)')'=== record10: ',glon(1,1), glat(1,1), glon(nx,ny), glat(nx,ny) + +! New change: Jul 2022 JH Shin------------------------------------------------------------- + + !For WPAC storms located near the west of international date line, add 360 to + !longitude value in the eastern side of IDL (western hemisphere) so that all + !longitude values have positive values in the VI domain. + !if ( cen_lon > 0. ) then + ! do j = 1, ny; do i = 1, nx + ! if(glon(i,j).lt.0.0) glon(i,j)=glon(i,j)+360.0 + ! enddo; enddo + !endif + if ( cen_lon > 0. ) where ( glon < 0.) glon=glon+360. + + !For CPAC storms located near the east of international date line, subrtact 360 + !from longitude value in the western side of IDL (eastern hemisphere) so + !that all longitude values have negative values in the VI domain. + !if ( cen_lon < -140. )then + ! do j = 1, ny; do i = 1, nx + ! if(glon(i,j).gt.0.0) glon(i,j)=glon(i,j)-360.0 + ! enddo; enddo + !endif + if ( cen_lon < -140. ) where ( glon > 0. ) glon=glon-360. + +! New change: Jul 2022 JH Shin------------------------------------------------------------- + + write(flid_out) glon,glat,glon,glat + if ( nd > 1 ) read(flid_in) + endif + endif - !-- w (m/s) or omega (pa/s) is needed here? - allocate(dat41(ix, iy, iz,1)) - dat41=dat4*1.0 - deallocate(dat4) + !!----------------------------- + !!---7.11 record 11: (((ph1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) + !!--- hafs-VI/read_hafs_out.f90 ph: + !!--- ph(k) = ak(k) + bk(k)*p_s --> pressure in pa + !!--- 64.270-->100570 + !!---seem ph1 is pressure on half level, use + !!--- pf1(k) = phalf(1) + sum(delp(1:k)) + !if ( nrecord == 11 ) then + ! allocate(dat4(iz+1,1,1,1)) + ! call get_var_data(trim(infile_atmos), 'phalf', iz+1, 1, 1, 1, dat4) + ! ptop=dat4(1,1,1,1)*100. !phalf:units = "mb" ; + ! deallocate(dat4) + + ! allocate(dat4(ix, iy, iz,1)) + ! allocate(dat41(ix, iy, iz+1,1)) + ! call get_var_data(trim(infile_core), 'delp', ix, iy, iz,1, dat4) + ! dat41(:,:,1,1)=ptop + ! do k = 1, iz + ! dat41(:,:,k+1,1)=dat41(:,:,k,1)+dat4(:,:,k,1) + ! enddo + ! deallocate(dat4) + !endif + + !----------------------------- + !---7.12 record 12: pressfc1 ! 2D + !--- use lowest-level pressure? + if ( nrecord == 12 ) then + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1, 1)) + dat43(:,:,1,1)=sfcp(:,:) + deallocate(sfcp) + endif endif !----------------------------- - !---7.9 record 9: (((z1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) - !--- hafs-VI/read_hafs_out.f90 z1: - !--- z1(I,J,K)=z1(I,J,K+1)+rdgas1*tmp(i,j,k)*(1.+0.608*spfh(i,j,k))*ALOG(ph1(i,j,k+1)/ph1(i,j,k)) - !--- hgt: phis/g-sum(DZ) - if ( nrecord == 9 ) then - allocate(dat4(ix, iy, 1,1)) - call get_var_data(trim(infile_core), 'phis', ix, iy, 1, 1, dat4) - allocate(dat41(ix, iy, iz+1, 1)) - dat41(:,:,iz+1,1)=dat4(:,:,1,1)/g - deallocate(dat4) + !---7.13 record 13: ak + if ( nrecord == 13 ) then + if ( my_proc_id == io_proc ) then + allocate(dat4(iz+1,1,1,1)) + call get_var_data(trim(infile_fvcore), 'ak', iz+1, 1, 1, 1, dat4) + write(*,'(a,200f12.1)')'=== record13: ', (dat4(k,1,1,1),k=1,iz+1) + write(flid_out) (dat4(k,1,1,1),k=1,iz+1) + if ( nd > 1 ) read(flid_in) + deallocate(dat4) + endif + endif - allocate(dat4(ix, iy, iz, 1)) - call get_var_data(trim(infile_core), 'DZ', ix, iy, iz, 1, dat4) - do k = iz, 1, -1 - dat41(:,:,k,1)=dat41(:,:,k+1,1)-dat4(:,:,k,1) - enddo - !write(*,'(a,200f)')'z1: ',dat41(int(ix/2),int(iy/2),:,1) - deallocate(dat4) + !----------------------------- + !---7.14 record 14: bk + if ( nrecord == 14 ) then + if ( my_proc_id == io_proc ) then + allocate(dat4(iz+1,1,1,1)) + call get_var_data(trim(infile_fvcore), 'bk', iz+1, 1, 1, 1, dat4) + write(*,'(a,200f10.3)')'=== record14: ', (dat4(k,1,1,1),k=1,iz+1) + write(flid_out) (dat4(k,1,1,1),k=1,iz+1) + if ( nd > 1 ) read(flid_in) + deallocate(dat4) + endif endif !----------------------------- - !---7.10 record 10: glon,glat,glon,glat ! 2D - !--- glat=grid_yt*180./pi, grid_yt=1:2160, what is this? - if ( nrecord == 10 ) then - !write(*,'(a,4i8)')'=== record10: ',ix, iy, nx, ny - - !For WPAC storms located near the west of international date line, add 360 to - !longitude value in the eastern side of IDL (western hemisphere) so that all - !longitude values have positive values in the VI domain. - if ( cen_lon > 0. ) then - do j = 1, ny; do i = 1, nx - if(glon(i,j).lt.0.0) glon(i,j)=glon(i,j)+360.0 - enddo; enddo + !---7.15 record 15: land ! =A101 = land sea mask, B101 = ZNT + !--- hafs-VI/read_hafs_out.f90 land:long_name = "sea-land-ice mask (0-sea, 1-land, 2-ice)" ; + !--- sfc_data.nc: slmsk + if ( nrecord == 15 ) then + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1,1)) + call get_var_data(trim(infile_sfc), 'slmsk', ix, iy, 1, 1, dat43) + endif + endif + + !----------------------------- + !---7.16 record 16: sfcr ! =B101 = Z0 + !---surface roughness + if ( nrecord == 16 ) then + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1,1)) + call get_var_data(trim(infile_sfc), 'zorl', ix, iy, 1, 1, dat43) + ! convert from cm to m + dat43=dat43/100. + endif + endif + + !----------------------------- + !---7.17 record 17: C101 ! =C101 = (10m wind speed)/(level 1 wind speed) + !--- ! =C101 = f10m (in the sfc_data.nc) + if ( nrecord == 17 ) then + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1, 1)) + call get_var_data(trim(infile_sfc), 'f10m', ix, iy, 1, 1, dat43) + endif + endif + + !----------------------------- + !---7.18 output 3d + if ( nrecord == 3 .or. nrecord == 4 .or. nrecord == 5 .or. & + nrecord == 8 .or. nrecord == 9 .or. nrecord ==11 )then + call mpi_barrier(comm,ierr) + kz=nz + if ( nrecord == 9 .or. nrecord == 11 ) then + kz=nz+1 endif + !--- map fv3 grid to rot-ll grid: ingrid-->dstgrid + !call cpu_time(cputime2) + !write(*,'(a,i3,f)')' --- read rot-ll grid for 1 record ', nrecord, cputime2 + + if ( nprocs == 1 ) then !--no mpi + !----only 1-core + allocate(dat41(nx,ny,kz,1), dat42(nx,ny,kz,1)) + if ( nd > 1 ) then + read(flid_in)dat42 + do k = 1, kz + dat41(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + dat42=-999999. + else + dat41=-999999. + endif + call combine_grids_for_remap(ix,iy,kz,1,dat43,nx,ny,kz,1,dat41,gwt%gwt_t,dat42) - !For CPAC storms located near the east of international date line, subrtact 360 - !from longitude value in the western side of IDL (eastern hemisphere) so - !that all longitude values have negative values in the VI domain. - if ( cen_lon < -140. )then - do j = 1, ny; do i = 1, nx - if(glon(i,j).gt.0.0) glon(i,j)=glon(i,j)-360.0 - enddo; enddo + !--- output + !write(*,'(a,i2.2,a,200f)')'=== record',nrecord,': ', dat42(int(nx/2),int(ny/2),:,1) + write(flid_out) (((dat42(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + deallocate(dat41, dat42, dat43) + else + !----mpi: 0 is for IO, >0 is for computing + + !---when nd>1, get previous data at 0, and then send to other cores + if ( nd > 1 ) then + if ( my_proc_id == io_proc ) then + allocate(dat4(nx,ny,kz,1), dat42(nx,ny,kz,1)) + read(flid_in)dat42 + do k = 1, kz + dat4(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + deallocate(dat42) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, k, 4000+ks, comm, ierr) + else + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=dat42 + endif + deallocate(dat42) + endif + enddo + deallocate(dat4) + else !if ( my_proc_id == io_proc ) then + !---receive dat42 for each core + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, io_proc, 4000+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then + else !if ( nd > 1 ) then + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=-999999. + endif + endif !if ( nd > 1 ) then + + !---combine dat43+dat41 --> dat42 + !call mpi_barrier(comm,ierr) + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42=-999999. + call combine_grids_for_remap(ix,iy,ke-ks+1,1,dat43,nx,ny,ke-ks+1,1,dat41,gwt%gwt_t,dat42) + if ( my_proc_id /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, io_proc, 5000+ks, comm, ierr) + deallocate(dat42) + endif + deallocate(dat41, dat43) + endif + + !---collect dat43 to io_proc, and output + !call mpi_barrier(comm,ierr) + if ( my_proc_id == io_proc ) then + allocate(dat43(nx,ny,kz,1)) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + if ( k /= io_proc ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, k, 5000+ks, comm, status, ierr) + dat43(:,:,ks:ke,1)=dat41(:,:,1:ke-ks+1,1) + deallocate(dat41) + else + dat43(:,:,ks:ke,1)=dat42(:,:,1:ke-ks+1,1) + deallocate(dat42) + endif + endif + enddo + !write(*,'(a,3i5,100f12.3)')'===w34 ', nx, ny, kz, (dat43(10,10,k,1),k=kz,1,-1) + write(flid_out) (((dat43(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + deallocate(dat43) + endif !if ( my_proc_id == io_proc ) then + endif ! if ( nprocs == 1 ) then !--no mpi + else if ( nrecord == 6 ) then !---u,v + kz=nz + !---convert u,v from fv3grid to earth + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1; ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(u(ix,iy,ke-ks+1,1), v(ix,iy,ke-ks+1,1)) + allocate(dat2(ix, iy+1), dat21(ix+1, iy)) + do k = 1, ke-ks+1 + call fv3uv2earth(ix, iy, dat42(:,:,k,1), dat43(:,:,k,1), cangu, sangu, cangv, sangv, dat2, dat21) + !---destage: C-/D- grid to A-grid + u(:,:,k,1) = (dat2 (:,1:iy)+dat2 (:,2:iy+1))/2.0 + v(:,:,k,1) = (dat21(1:ix,:)+dat21(2:ix+1,:))/2.0 + enddo + deallocate(dat42, dat43, dat2, dat21, cangu, sangu, cangv, sangv) endif + !write(*,*)'===w12 dat42,dat43 to earth wind u,v' + + !--- loop u,v + do nv = 1, 2 + !--- get outer domain u,v + if ( nd > 1 ) then + if ( my_proc_id == io_proc ) then + allocate(dat4(nx,ny,kz,1), dat42(nx,ny,kz,1)) + read(flid_in)dat42 + do k = 1, kz + dat4(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + deallocate(dat42) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, k, 300*nv+ks, comm, ierr) + else + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=dat42 + endif + deallocate(dat42) + endif + enddo + deallocate(dat4) + else !if ( my_proc_id == io_proc ) then + !---receive dat42 for each core + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, io_proc, 300*nv+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then + else + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=-999999. + endif + endif !if ( nd > 1 ) then + !write(*,*)'===w13 got outer domain dat41' + + !--- map u/v to rot-ll grid: ingrid-->dstgrid + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42=-999999. + if (nv==1) then + call combine_grids_for_remap(ix,iy,ke-ks+1,1,u,nx,ny,ke-ks+1,1,dat41,gwt%gwt_t,dat42) + else if (nv==2) then + call combine_grids_for_remap(ix,iy,ke-ks+1,1,v,nx,ny,ke-ks+1,1,dat41,gwt%gwt_t,dat42) + endif + if ( my_proc_id /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, io_proc, 400*nv+ks, comm, ierr) + deallocate(dat42) + endif + deallocate(dat41) + endif + !write(*,*)'===w14 got dat42' + + !---collect dat43 to io_proc, and output + !call mpi_barrier(comm,ierr) + if ( my_proc_id == io_proc ) then + allocate(dat43(nx,ny,kz,1)) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + if ( k /= io_proc ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, k, 400*nv+ks, comm, status, ierr) + dat43(:,:,ks:ke,1)=dat41(:,:,1:ke-ks+1,1) + deallocate(dat41) + else + dat43(:,:,ks:ke,1)=dat42(:,:,1:ke-ks+1,1) + deallocate(dat42) + endif + endif + enddo + !write(*,'(a,3i5,100f12.3)')'===w51 ', nx, ny, kz, (dat43(10,10,k,1),k=kz,1,-1) + write(flid_out) (((dat43(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + deallocate(dat43) + endif !if ( my_proc_id == io_proc ) then + if (nv==1) then + deallocate(u) + else if (nv==2) then + deallocate(v) + endif + enddo !do nv = 1, 2 + else if ( nrecord ==12 .or. nrecord ==15 .or. nrecord ==16 .or. nrecord ==17 ) then + kz=1 + if ( my_proc_id == io_proc ) then + allocate(dat41(nx,ny,kz,1), dat42(nx,ny,kz,1)) + if ( nd > 1 ) then + read(flid_in)dat42 + do k = 1, kz + dat41(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + dat42=-999999. + else + dat41=-999999. + dat42=-999999. + endif + call combine_grids_for_remap(ix,iy,kz,1,dat43,nx,ny,kz,1,dat41,gwt%gwt_t,dat42) + write(flid_out) (((dat42(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + deallocate(dat41, dat42, dat43) + endif !if ( my_proc_id == io_proc ) then + endif + + enddo do_out_var_loop !: for nrecord = 1, 17 + + !------------------------------------------------------------------------- + ! 8 --- clean ingrid gwt + deallocate( ingrid%grid_lon, ingrid%grid_lat, ingrid%grid_lont, ingrid%grid_latt) + deallocate( gwt%gwt_t, gwt%gwt_u, gwt%gwt_v ) + + enddo do_nestdom_loop !: do nd = 1, ndom + write(*,*)' === finished hafsvi_preproc ===' + + return + end subroutine hafsvi_preproc + +!======================================================================================== + subroutine hafsvi_preproc_nc(in_dir, in_date, nestdoms, radius, res, out_file) + +!----------------------------------------------------------------------------- +! HAFS DA tool - hafsvi_preproc +! Yonghui Weng, 20211210 +! +! This subroutine read hafs restart files and output hafsvi needed input. +! Variables needed: +! WRITE(IUNIT) NX,NY,NZ +! WRITE(IUNIT) lon1,lat1,lon2,lat2,cen_lon,cen_lat +! WRITE(IUNIT) (((pf1(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) ! 3D, NZ +! WRITE(IUNIT) (((tmp(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) +! WRITE(IUNIT) (((spfh(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) +! WRITE(IUNIT) (((ugrd(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) +! WRITE(IUNIT) (((vgrd(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) +! WRITE(IUNIT) (((dzdt(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) +!! WRITE(IUNIT) hgtsfc ! 2D +! WRITE(IUNIT) (((z1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) +! WRITE(IUNIT) glon,glat,glon,glat ! 2D +! WRITE(IUNIT) (((ph1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) ! 3D, NZ+1 +! WRITE(IUNIT) pressfc1 ! 2D +! WRITE(IUNIT) ak +! WRITE(IUNIT) bk +! WRITE(IUNIT) land ! =A101 = land sea mask, B101 = ZNT +! WRITE(IUNIT) sfcr ! =B101 = Z0 +! WRITE(IUNIT) C101 ! =C101 = (10m wind speed)/(level 1 wind speed) +! + +!----------------------------------------------------------------------------- + + use constants + use netcdf + use module_mpi + use var_type + + implicit none + + character (len=*), intent(in) :: in_dir, in_date, radius, res, out_file + integer, intent(in) :: nestdoms +!--- in_dir, HAFS_restart_folder, which holds grid_spec.nc, fv_core.res.tile1.nc, +! fv_srf_wnd.res.tile1.nc, fv_tracer.res.tile1.nc, phy_data.nc, sfc_data.nc +!--- in_date, HAFS_restart file date, like 20200825.120000 +!--- radius, to cut a square, default value is 40, which means a 40deg x 40deg square. +!--- out_file: output file, default is bin format, if the file name is *.nc, then output nc format. +!--- nestdoms: total nest domain number: 0-no nesting +!--- 1-nest02.tile2 + 0 +!--- 2-nest03.tile3 + 1 + + character (len=2500) :: indir, infile + character (len=2500) :: infile_fvcore, infile_core, infile_tracer, infile_phy, & + infile_sfc, infile_grid, infile_grid2, infile_atmos, infile_oro + type(grid2d_info) :: dstgrid ! rot-ll grid for output + type(grid2d_info) :: ingrid ! hafs restart grid + real :: radiusf + logical :: file_exist + +!----for hafs restart + integer :: ix, iy, iz, kz, ndom, nd + character (len=50) :: nestfl, tilefl, tempfl + ! grid_spec.nc : grid_spec.nest02.tile2.nc + ! fv_core.res.tile1.nc : fv_core.res.nest02.tile2.nc + ! phy_data.nc : phy_data.nest02.tile2.nc + character (len=2500):: fl_in, fl_out + +!----for hafsvi + integer :: nx, ny, nz, filetype ! filetype: 1=bin, 2=nc + real :: lon1,lat1,lon2,lat2,cen_lat,cen_lon,dlat,dlon + real, allocatable, dimension(:,:) :: glon,glat + + integer :: i, j, k, n, flid_in, flid_out, ncid, ndims, nrecord + real :: rot_lon, rot_lat, ptop + integer, dimension(nf90_max_var_dims) :: dims + real, allocatable, dimension(:,:,:,:) :: dat4, dat41, dat42, dat43, u, v + real, allocatable, dimension(:,:,:) :: dat3, dat31 + real, allocatable, dimension(:,:) :: dat2, dat21, sfcp + real, allocatable, dimension(:) :: dat1 + + !real, allocatable, dimension(:) :: pfull, phalf + real, allocatable, dimension(:,:) :: cangu, sangu, cangv, sangv + real :: cputime1, cputime2, cputime3 + integer :: io_proc, nm, ks, ke, nv + character (len=50) :: varname, varname_long, units, nzc + +!------------------------------------------------------------------------------ +! 1 --- arg process + io_proc=nprocs-1 + !io_proc=0 +! +! 1.1 --- ndom + ndom=nestdoms+1 + +! 1.2 --- input_dir + if (len_trim(in_dir) < 2 .or. trim(in_dir) == 'w' .or. trim(in_dir) == 'null') then + indir='.' + else + indir=trim(in_dir) + endif + + if (trim(radius) == 'w' .or. trim(radius) == 'null') then + radiusf = 40. !deg + else + read(radius,*)i + radiusf = real(i) + if ( radiusf < 3. .or. radiusf > 70. ) then + if ( my_proc_id == 0 ) write(*,'(a)')'!!! hafsvi cut radius number wrong: '//trim(radius) + if ( my_proc_id == 0 ) write(*,'(a)')'!!! please call with --vortexradius=40 (75< 3)' + stop 'hafsvi_preproc' + endif + endif + + if (trim(res) == 'w' .or. trim(res) == 'null') then + dlat=0.02 + else + read(res,*)dlat + endif + dlon=dlat + +!------------------------------------------------------------------------------ +! 2 --- set dstgrid: rot-ll grid +! 2.1 --- define rot-ll grid + cen_lat = tc%lat + cen_lon = tc%lon + nx = int(radiusf/2.0/dlon+0.5)*2+1 + ny = int(radiusf/2.0/dlat+0.5)*2+1 + lon1 = - radiusf/2.0 + lat1 = - radiusf/2.0 + lon2 = radiusf/2.0 + lat2 = radiusf/2.0 + !!--- get rot-ll grid + allocate(glon(nx,ny), glat(nx,ny)) + !$omp parallel do & + !$omp& private(i,j,rot_lon,rot_lat) + do j = 1, ny; do i = 1, nx + rot_lon = lon1 + dlon*(i-1) + rot_lat = lat1 + dlat*(j-1) + call rtll(rot_lon, rot_lat, glon(i,j), glat(i,j), cen_lon, cen_lat) + enddo; enddo + if ( my_proc_id == 0 ) write(*,'(a)')'---rot-ll grid: nx, ny, cen_lon, cen_lat, dlon, dlat, lon1, lon2, lat1, lat2' + if ( my_proc_id == 0 ) write(*,'(15x,2i5,8f10.5)') nx, ny, cen_lon, cen_lat, dlon, dlat, lon1, lon2, lat1, lat2 + !write(*,'(a,4f10.5)')'---rot-ll grid rot_lon:', glon(1,1), glon(1,ny), glon(nx,ny), glon(nx,1) + !write(*,'(a,4f10.5)')'---rot-ll grid rot_lat:', glat(1,1), glat(1,ny), glat(nx,ny), glat(nx,1) + +! 2.2 --- set dstgrid + dstgrid%grid_x = nx + dstgrid%grid_y = ny + dstgrid%ntime = 1 + dstgrid%grid_xt = nx + dstgrid%grid_yt = ny + allocate(dstgrid%grid_lon (dstgrid%grid_x,dstgrid%grid_y)) + allocate(dstgrid%grid_lont(dstgrid%grid_x,dstgrid%grid_y)) + dstgrid%grid_lon = glon + dstgrid%grid_lont = glon + allocate(dstgrid%grid_lat (dstgrid%grid_x,dstgrid%grid_y)) + allocate(dstgrid%grid_latt(dstgrid%grid_x,dstgrid%grid_y)) + dstgrid%grid_lat = glat + dstgrid%grid_latt = glat + +!------------------------------------------------------------------------------ +! 3 --- process output file type: now is only for bin +! i=len_trim(out_file) +! if ( out_file(i-2:i) == '.nc' ) then +! write(*,'(a)')' --- output to '//trim(out_file) +! filetype=2 +! call nccheck(nf90_open(trim(out_file), nf90_write, flid), 'wrong in open '//trim(out_file), .true.) +! else +! filetype=1 +! flid=71 +! open(unit=flid,file=trim(out_file),form='unformatted',status='unknown') +! endif + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! --- domain loop: from inner domain to outer domain, so the number is from max to 1 + do_nestdom_loop: do nd = 1, ndom + + !------------------------------------------------------------------------- + ! 3 --- initialization: clean ingrid, weight + ! ingrid%grid_x=-99; ingrid%grid_y=-99; ingrid%grid_xt=-99; ingrid%grid_yt=-99 + + !------------------------------------------------------------------------- + ! 4 --- input grid info + ! read from grid file grid_spec.nc: + ! nestfl, tilefl: infile_core, infile_tracer, infile_grid, infile_atmos, infile_oro + write(nestfl,'(a4,i2.2)')'nest',nd + write(tilefl,'(a4,i0)')'tile',nd + if ( nd == 1 ) then + infile_grid=trim(indir)//'/grid_spec.nc' + infile_grid2=trim(indir)//'/grid_mspec_'//in_date(1:4)//'_'//in_date(5:6)//'_'//in_date(7:8)//'_'//in_date(10:11)//'.nc' + infile_oro =trim(indir)//'/oro_data.nc' + infile_atmos=trim(indir)//'/atmos_static.nc' + infile_fvcore=trim(indir)//'/'//trim(in_date)//'.fv_core.res.nc' + infile_core=trim(indir)//'/'//trim(in_date)//'.fv_core.res.tile1.nc' + infile_tracer=trim(indir)//'/'//trim(in_date)//'.fv_tracer.res.tile1.nc' + infile_phy =trim(indir)//'/'//trim(in_date)//'.phy_data.nc' + infile_sfc =trim(indir)//'/'//trim(in_date)//'.sfc_data.nc' + else + infile_grid=trim(indir)//'/grid_spec.'//trim(nestfl)//'.'//trim(tilefl)//'.nc' + infile_grid2=trim(indir)//'/grid_mspec.'//trim(nestfl)//'_'//in_date(1:4)//'_'//in_date(5:6)//'_'//in_date(7:8)//'_'//in_date(10:11)//'.'//trim(tilefl)//'.nc' + infile_oro =trim(indir)//'/oro_data.'//trim(nestfl)//'.'//trim(tilefl)//'.nc' + infile_atmos=trim(indir)//'/atmos_static.'//trim(nestfl)//'.'//trim(tilefl)//'.nc' + infile_fvcore=trim(indir)//'/'//trim(in_date)//'.fv_core.res.'//trim(nestfl)//'.nc' + infile_core=trim(indir)//'/'//trim(in_date)//'.fv_core.res.'//trim(nestfl)//'.'//trim(tilefl)//'.nc' + infile_tracer=trim(indir)//'/'//trim(in_date)//'.fv_tracer.res.'//trim(nestfl)//'.'//trim(tilefl)//'.nc' + infile_phy =trim(indir)//'/'//trim(in_date)//'.phy_data.'//trim(nestfl)//'.'//trim(tilefl)//'.nc' + infile_sfc =trim(indir)//'/'//trim(in_date)//'.sfc_data.'//trim(nestfl)//'.'//trim(tilefl)//'.nc' + endif + + inquire(file=infile_grid2, exist=file_exist) + if ( file_exist ) infile_grid = infile_grid2 + + if ( debug_level > 10 .and. my_proc_id == 0 ) write(*,'(a)')' --- read grid info from '//trim(infile_grid) + call rd_grid_spec_data(trim(infile_grid), ingrid) + ix=ingrid%grid_xt + iy=ingrid%grid_yt + if ( debug_level > 10 .and. my_proc_id == 0 ) then + write(*,'(a,i,1x,i,1x,f,1x,f,1x,f,1x,f)')' --- ingrid info: ', ix, iy, & + ingrid%grid_lon(int(ix/2), int(iy/2)), ingrid%grid_lat(int(ix/2), int(iy/2)), & + ingrid%grid_lont(int(ix/2), int(iy/2)), ingrid%grid_latt(int(ix/2), int(iy/2)) + endif + + !---to add the test if the tc was inside of the domain - write(*,'(a,4f8.3)')'=== record10: ',glon(1,1), glat(1,1), glon(nx,ny), glat(nx,ny) - write(flid_out) glon,glat,glon,glat - if ( nd > 1 ) read(flid_in) + + ! call FV3-grid cos and sin + allocate( cangu(ix,iy+1),sangu(ix,iy+1),cangv(ix+1,iy),sangv(ix+1,iy) ) + call cal_uv_coeff_fv3(ix, iy, ingrid%grid_lat, ingrid%grid_lon, cangu, sangu, cangv, sangv) + + !------------------------------------------------------------------------- + ! 5 --- calculate output-grid in input-grid's positions (xin, yin), and each grid's weight to dst + if ( debug_level > 10 ) then + if ( my_proc_id == 0 ) write(*,'(a)')' --- call cal_src_dst_grid_weight' + write(*,'(i,a,2(i,1x),2(f,1x))')my_proc_id,' --- dstgrid: ', nx, ny, & + dstgrid%grid_lont(int(nx/2),int(ny/2)), dstgrid%grid_latt(int(nx/2),int(ny/2)) + endif + call cal_src_dst_grid_weight(ingrid, dstgrid) + + !------------------------------------------------------------------------- + ! 6 --- dst files + if ( nd == 1 ) then + fl_in="" !inner domain rot-ll file + fl_out=trim(out_file) !current domain rot-ll file + else if ( nd == 2 ) then + fl_in=trim(out_file) + fl_out=trim(out_file)//'_'//trim(nestfl) + else + write(tempfl,'(a4,i2.2)')'nest',nd-1 + fl_out=trim(out_file)//'_'//trim(nestfl) + fl_in=trim(out_file)//'_'//trim(tempfl) + endif + + !------------------------------------------------------------------------- + ! 7 --- output + call cpu_time(cputime1) + if ( my_proc_id == io_proc ) write(*,'(a,i3,f)')' --- record start cputime: ', 0, cputime1 + + ! 7.1 --- no-interp-needed variables: dimension and domain info + !--- record 1: nx, ny, nz + !--- record 2: lon1,lat1,lon2,lat2,cen_lon,cen_lat + !--- record 10: glon,glat,glon,glat ! 2D + !--- record 13: ak + !--- record 14: bk + call get_var_dim(trim(infile_atmos), 'pfull', ndims, dims) + nz=dims(1) + if ( my_proc_id == 0 ) then + !write(flid_out) nx, ny, nz + call write_nc_dim(trim(fl_out), 'nx', nx) + call write_nc_dim(trim(fl_out), 'ny', ny) + call write_nc_dim(trim(fl_out), 'nz', nz) + call write_nc_dim(trim(fl_out), 'nz1', nz+1) + call write_nc_real0d(trim(fl_out), 'lon1', lon1, 'degree', 'longtitude 1') + call write_nc_real0d(trim(fl_out), 'lat1', lat1, 'degree', 'latitude 1') + call write_nc_real0d(trim(fl_out), 'lon2', lon2, 'degree', 'longtitude 2') + call write_nc_real0d(trim(fl_out), 'lat2', lat2, 'degree', 'latitude 1') + call write_nc_real0d(trim(fl_out), 'cen_lon', cen_lon, 'degree', 'center of longtitude') + call write_nc_real0d(trim(fl_out), 'cen_lat', cen_lat, 'degree', 'center of latitude') + + !---- + !--- change: Jul 2022 JH Shin + ! For WPAC storms located near the west of international date line, add 360 to + ! longitude value in the eastern side of IDL (western hemisphere) so that all + ! longitude values have positive values in the VI domain. + ! if ( cen_lon > 0. ) then + ! do j = 1, ny; do i = 1, nx + ! if(glon(i,j).lt.0.0) glon(i,j)=glon(i,j)+360.0 + ! enddo; enddo + ! endif + if ( cen_lon > 0. ) where ( glon < 0.) glon=glon+360. + + ! For CPAC storms located near the east of international date line, subrtact 360 + ! from longitude value in the western side of IDL (eastern hemisphere) so + ! that all longitude values have negative values in the VI domain. + ! if ( cen_lon < -140. )then + ! do j = 1, ny; do i = 1, nx + ! if(glon(i,j).gt.0.0) glon(i,j)=glon(i,j)-360.0 + ! enddo; enddo + ! endif + if ( cen_lon < -140. ) where ( glon > 0. ) glon=glon-360. + + call write_nc_real(trim(fl_out), 'glon', nx, ny, -1, -1, 'nx', 'ny', '-', '-', glon, 'degree', 'rot-ll longtitude') + call write_nc_real(trim(fl_out), 'glat', nx, ny, -1, -1, 'nx', 'ny', '-', '-', glat, 'degree', 'rot-ll latitude') + allocate(dat4(nz+1,1,1,1)) + call get_var_data(trim(infile_fvcore), 'ak', nz+1, 1, 1, 1, dat4) + call write_nc_real(trim(fl_out), 'ak', -1, -1, nz+1, -1, '-', '-', 'nz1', '-', dat4, 'scalar', 'ak') + deallocate(dat4) + allocate(dat4(nz+1,1,1,1)) + call get_var_data(trim(infile_fvcore), 'bk', nz+1, 1, 1, 1, dat4) + call write_nc_real(trim(fl_out), 'bk', -1, -1, nz+1, -1, '-', '-', 'nz1', '-', dat4, 'scalar', 'bk') + deallocate(dat4) + + endif + call mpi_barrier(comm,ierr) + + ! 7.2 --- remapp-needed variables: + do_out_var_loop: do nrecord = 3, 17 + if ( nrecord == 7 .or. nrecord == 10 .or. nrecord == 13 .or. nrecord == 14 ) cycle do_out_var_loop + + iz=nz !same vertical levels + if ( nrecord == 12 .or. nrecord == 15 .or. nrecord == 16 .or. nrecord ==17 ) iz=1 + if ( nrecord == 9 .or. nrecord == 11 ) iz=nz+1 + if ( nrecord == 3 ) then + varname='pf1' + units='pa' + varname_long='pressure' + elseif ( nrecord == 4 ) then + varname='T' + units='K' + varname_long='temperature' + elseif ( nrecord == 5 ) then + varname='sphum' + units='kg/kg' + varname_long='sphum' + elseif ( nrecord == 8 ) then + varname='dzdt' + units='m/s' + varname_long='vertical velocity w' + elseif ( nrecord == 9 ) then + varname='z1' + units='gpm' + varname_long='Geopotential Height' + elseif ( nrecord == 11 ) then + varname='ph1' + units='pa' + varname_long='pressure on half level' + elseif ( nrecord == 12 ) then + varname='sfcp' + units='pa' + varname_long='surface pressure' + elseif ( nrecord == 15 ) then + varname='slmsk' + units='numeric' + varname_long='sea-land-ice mask (0-sea, 1-land, 2-ice)' + elseif ( n == 16 ) then + varname='zorl' + units='numeric' + varname_long='sfcr - surface roughness' + elseif ( n == 17 ) then + varname='f10m' + units='numeric' + varname_long='(10m wind speed)/(level 1 wind speed)' endif - + nzc='nz' + if ( iz == nz+1 ) nzc='nz1' + if ( iz == 1 ) nzc='-' + !----------------------------- - !---7.11 record 11: (((ph1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) - !--- hafs-VI/read_hafs_out.f90 ph: - !--- ph(k) = ak(k) + bk(k)*p_s --> pressure in pa - !--- 64.270-->100570 - !---seem ph1 is pressure on half level, use + !---7.1 record 1: nx, ny, nz + !---nx, ny, nz, & lon1,lat1,lon2,lat2,cen_lon,cen_lat + + !----------------------------- + !---7.2 record 2: lon1,lat1,lon2,lat2,cen_lon,cen_lat + + !----------------------------- + !---7.3 record 3: (((pf1(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) + !--- hafs-VI/read_hafs_out.f90 pf: + !--- ph(k) = ak(k) + bk(k)*p_s --> half level pressure + !--- pf(k) = (ph(k+1) - ph(k)) / log(ph(k+1)/ph(k)) --> full level pressure + !--- + !---seem pf1 is pressure on full level, use !--- pf1(k) = phalf(1) + sum(delp(1:k)) - if ( nrecord == 11 ) then - allocate(dat4(iz+1,1,1,1)) - call get_var_data(trim(infile_atmos), 'phalf', iz+1, 1, 1, 1, dat4) - ptop=dat4(1,1,1,1)*100. !phalf:units = "mb" ; - deallocate(dat4) + if ( nrecord == 3 .or. nrecord == 9 .or. nrecord == 11 ) then + if ( nrecord == 3 ) then + allocate(dat4(iz+1,1,1,1)) + call get_var_data(trim(infile_atmos), 'phalf', iz+1, 1, 1, 1, dat4) + ptop=dat4(1,1,1,1)*100. !phalf:units = "mb" ; + deallocate(dat4) + endif - allocate(dat4(ix, iy, iz,1)) - allocate(dat41(ix, iy, iz+1,1)) - call get_var_data(trim(infile_core), 'delp', ix, iy, iz,1, dat4) - dat41(:,:,1,1)=ptop - do k = 1, iz - dat41(:,:,k+1,1)=dat41(:,:,k,1)+dat4(:,:,k,1) - enddo - deallocate(dat4) + if ( my_proc_id == io_proc ) then + if ( nrecord == 3 ) then + allocate(dat4(ix, iy, iz,1)) + allocate(dat41(ix, iy, iz,1)) + allocate(dat2(ix, iy)) + !write(*,'(a,3i5)')'delp: ',ix, iy, iz + call get_var_data(trim(infile_core), 'delp', ix, iy, iz,1, dat4) + dat2(:,:)=ptop + do k = 1, iz + dat41(:,:,k,1)=dat2(:,:)+dat4(:,:,k,1)/2.0 + dat2(:,:)=dat2(:,:)+dat4(:,:,k,1) + enddo + allocate(sfcp(ix, iy)) + sfcp=dat41(:,:,iz,1) + deallocate(dat2, dat4) + else if ( nrecord == 9 ) then + allocate(dat4(ix, iy, 1,1)) + call get_var_data(trim(infile_core), 'phis', ix, iy, 1, 1, dat4) + allocate(dat41(ix, iy, iz, 1)) + dat41(:,:,iz,1)=dat4(:,:,1,1)/g + deallocate(dat4) + allocate(dat4(ix, iy, iz-1, 1)) + call get_var_data(trim(infile_core), 'DZ', ix, iy, iz-1, 1, dat4) + do k = iz-1, 1, -1 + dat41(:,:,k,1)=dat41(:,:,k+1,1)-dat4(:,:,k,1) + enddo + deallocate(dat4) + else if ( nrecord == 11 ) then + allocate(dat4(ix, iy, iz-1, 1), dat41(ix, iy, iz, 1)) + call get_var_data(trim(infile_core), 'delp', ix, iy, iz-1, 1, dat4) + dat41(:,:,1,1)=ptop + do k = 2, iz + dat41(:,:,k,1)=dat41(:,:,k-1,1)+dat4(:,:,k-1,1) + enddo + deallocate(dat4) + endif !if ( nrecord == 3 ) then + + !---broadcast dat41 to each computing-core + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) !devide iz to each processor + do k = 0, nprocs-1 + ks=k*nm+1 !k-start + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(ix, iy, ke-ks+1,1)) + dat42(:,:,:,1)=dat41(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1), size(dat42), mpi_real, k, 3000+ks, comm, ierr) + else + allocate(dat43(ix, iy, ke-ks+1,1)) + dat43=dat42 + endif + deallocate(dat42) + endif + enddo + else !if ( nprocs > 1 ) then + allocate(dat43(ix, iy, iz,1)) + dat43=dat41 + endif + deallocate(dat41) + else ! if ( my_proc_id == io_proc ) then + !---receive dat43 + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat43(ix, iy, ke-ks+1,1)) + !call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, mpi_any_tag, comm, status, ierr) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 3000+ks, comm, status, ierr) + endif + endif + endif + + !----------------------------- + !---7.4 record 4: (((tmp(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) + !---7.5 record 5: (((spfh(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) + !---7.8 record 8: (((dzdt(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) + if ( nrecord == 4 .or. nrecord == 5 .or. nrecord == 8 ) then + if ( my_proc_id == io_proc ) then + !---read in + allocate(dat4(ix, iy, iz,1)) + if ( nrecord == 4 ) call get_var_data(trim(infile_core), 'T', ix, iy, iz,1, dat4) + if ( nrecord == 5 ) call get_var_data(trim(infile_tracer), 'sphum', ix, iy, iz,1, dat4) + if ( nrecord == 8 ) call get_var_data(trim(infile_core), 'W', ix, iy, iz,1, dat4) + !---send to other core + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(ix, iy, ke-ks+1,1)) + dat42(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1), size(dat42), mpi_real, k, 4000+ks, comm, ierr) + else + allocate(dat43(ix, iy, ke-ks+1,1)) + dat43=dat42 + endif + deallocate(dat42) + endif + enddo + else + allocate(dat43(ix, iy, iz,1)) + dat43=dat4 + endif + deallocate(dat4) + else !if ( my_proc_id == io_proc ) then + !---receive dat43 + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat43(ix, iy, ke-ks+1,1)) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 4000+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then + endif + + !----------------------------- + !---7.6 record 6: (((ugrd(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) + !---7.7 record 7: (((vgrd(i,j,k),i=1,nx),j=1,ny),k=nz,1,-1) + if ( nrecord == 6 ) then + !---get u,v from restart + if ( my_proc_id == io_proc ) then + do nv = 1, 2 + if (nv==1) allocate(dat4(ix, iy+1, iz,1)) + if (nv==1) call get_var_data(trim(infile_core), 'u', ix, iy+1, iz, 1, dat4) + if (nv==2) allocate(dat4(ix+1, iy, iz,1)) + if (nv==2) call get_var_data(trim(infile_core), 'v', ix+1, iy, iz, 1, dat4) + !---send to other core + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + if (nv==1) allocate(dat41(ix, iy+1, ke-ks+1,1)) + if (nv==2) allocate(dat41(ix+1, iy, ke-ks+1,1)) + dat41(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat41(1,1,1,1), size(dat41), mpi_real, k, 200*nv+ks, comm, ierr) + else + if (nv==1) allocate(dat42(ix, iy+1, ke-ks+1,1)) + if (nv==1) dat42=dat41 + if (nv==2) allocate(dat43(ix+1, iy, ke-ks+1,1)) + if (nv==2) dat43=dat41 + endif + deallocate(dat41) + endif + enddo + else !if ( nprocs > 1 ) then + if (nv==1) allocate(dat42(ix, iy+1, iz,1)) + if (nv==1) dat42=dat4 + if (nv==2) allocate(dat43(ix+1, iy, iz,1)) + if (nv==1) dat43=dat4 + endif + deallocate(dat4) + enddo !do nv = 1, 2 + else !if ( my_proc_id == io_proc ) then + !---receive dat42 dat43 + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(ix, iy+1, ke-ks+1,1), dat43(ix+1, iy, ke-ks+1,1)) + call mpi_recv(dat42(1,1,1,1), size(dat42), mpi_real, io_proc, 200*1+ks, comm, status, ierr) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 200*2+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then endif - + + !!----------------------------- + !!---7.9 record 9: (((z1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) + !!--- hafs-VI/read_hafs_out.f90 z1: + !!--- z1(I,J,K)=z1(I,J,K+1)+rdgas1*tmp(i,j,k)*(1.+0.608*spfh(i,j,k))*ALOG(ph1(i,j,k+1)/ph1(i,j,k)) + !!--- hgt: phis/g-sum(DZ) + + !----------------------------- + !---7.10 record 10: glon,glat,glon,glat ! 2D + !--- glat=grid_yt*180./pi, grid_yt=1:2160, what is this? + + !!----------------------------- + !!---7.11 record 11: (((ph1(i,j,k),i=1,nx),j=1,ny),k=nz1,1,-1) + !!--- hafs-VI/read_hafs_out.f90 ph: + !!--- ph(k) = ak(k) + bk(k)*p_s --> pressure in pa + !!--- 64.270-->100570 + !!---seem ph1 is pressure on half level, use + !!--- pf1(k) = phalf(1) + sum(delp(1:k)) + !----------------------------- !---7.12 record 12: pressfc1 ! 2D !--- use lowest-level pressure? if ( nrecord == 12 ) then - allocate(dat41(ix, iy, 1, 1)) - dat41(:,:,1,1)=sfcp(:,:) - deallocate(sfcp) + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1, 1)) + dat43(:,:,1,1)=sfcp(:,:) + deallocate(sfcp) + endif endif - + !----------------------------- !---7.13 record 13: ak - if ( nrecord == 13 ) then - allocate(dat4(iz+1,1,1,1)) - call get_var_data(trim(infile_fvcore), 'ak', iz+1, 1, 1, 1, dat4) - write(*,'(a,200f12.1)')'=== record13: ', (dat4(k,1,1,1),k=1,iz+1) - write(flid_out) (dat4(k,1,1,1),k=1,iz+1) - if ( nd > 1 ) read(flid_in) - deallocate(dat4) - endif - + !----------------------------- - !---7.14 record 14: bk - if ( nrecord == 14 ) then - allocate(dat4(iz+1,1,1,1)) - call get_var_data(trim(infile_fvcore), 'bk', iz+1, 1, 1, 1, dat4) - write(*,'(a,200f10.3)')'=== record14: ', (dat4(k,1,1,1),k=1,iz+1) - write(flid_out) (dat4(k,1,1,1),k=1,iz+1) - if ( nd > 1 ) read(flid_in) - deallocate(dat4) - endif - + !---7.14 record 14: bk + !----------------------------- !---7.15 record 15: land ! =A101 = land sea mask, B101 = ZNT !--- hafs-VI/read_hafs_out.f90 land:long_name = "sea-land-ice mask (0-sea, 1-land, 2-ice)" ; !--- sfc_data.nc: slmsk if ( nrecord == 15 ) then - allocate(dat41(ix, iy, 1,1)) - call get_var_data(trim(infile_sfc), 'slmsk', ix, iy, 1, 1, dat41) + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1,1)) + call get_var_data(trim(infile_sfc), 'slmsk', ix, iy, 1, 1, dat43) + endif endif - + !----------------------------- !---7.16 record 16: sfcr ! =B101 = Z0 !---surface roughness if ( nrecord == 16 ) then - allocate(dat41(ix, iy, 1,1)) - call get_var_data(trim(infile_sfc), 'zorl', ix, iy, 1, 1, dat41) - ! convert from cm to m - dat41=dat41/100. + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1,1)) + call get_var_data(trim(infile_sfc), 'zorl', ix, iy, 1, 1, dat43) + ! convert from cm to m + dat43=dat43/100. + endif endif - + !----------------------------- !---7.17 record 17: C101 ! =C101 = (10m wind speed)/(level 1 wind speed) !--- ! =C101 = f10m (in the sfc_data.nc) if ( nrecord == 17 ) then - allocate(dat41(ix, iy, 1, 1)) - call get_var_data(trim(infile_sfc), 'f10m', ix, iy, 1, 1, dat41) + if ( my_proc_id == io_proc ) then + allocate(dat43(ix, iy, 1, 1)) + call get_var_data(trim(infile_sfc), 'f10m', ix, iy, 1, 1, dat43) + endif endif - + !----------------------------- !---7.18 output 3d if ( nrecord == 3 .or. nrecord == 4 .or. nrecord == 5 .or. & - nrecord == 8 .or. nrecord == 9 .or. nrecord ==11 .or. & - nrecord ==12 .or. nrecord ==15 .or. nrecord ==16 .or. nrecord ==17 ) then + nrecord == 8 .or. nrecord == 9 .or. nrecord ==11 )then + call mpi_barrier(comm,ierr) kz=nz - if ( nrecord == 12 .or. nrecord == 15 .or. nrecord == 16 .or. nrecord ==17 ) then - kz=1 - endif if ( nrecord == 9 .or. nrecord == 11 ) then kz=nz+1 endif !--- map fv3 grid to rot-ll grid: ingrid-->dstgrid !call cpu_time(cputime2) !write(*,'(a,i3,f)')' --- read rot-ll grid for 1 record ', nrecord, cputime2 - allocate(dat42(nx,ny,kz,1), dat43(nx,ny,kz,1)) - if ( nd > 1 ) then - read(flid_in)dat43 - do k = 1, kz - dat42(:,:,k,1)=dat43(:,:,kz-k+1,1) - enddo - dat43=-999999. + + if ( nprocs == 1 ) then !--no mpi + !----only 1-core + allocate(dat41(nx,ny,kz,1), dat42(nx,ny,kz,1)) + if ( nd > 1 ) then + !read(flid_in)dat42 + call get_var_data(trim(fl_in), trim(varname), nx, ny, kz, 1, dat42) + do k = 1, kz + dat41(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + dat42=-999999. + else + dat41=-999999. + endif + call combine_grids_for_remap(ix,iy,kz,1,dat43,nx,ny,kz,1,dat41,gwt%gwt_t,dat42) + + !--- output + !write(*,'(a,i2.2,a,200f)')'=== record',nrecord,': ', dat42(int(nx/2),int(ny/2),:,1) + !write(flid_out) (((dat42(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + call write_nc_real(trim(fl_out), trim(varname), nx, ny, kz, -1, 'nx', 'ny', trim(nzc), '-', dat42, trim(units), trim(varname_long)) + deallocate(dat41, dat42, dat43) else - dat42=-9999999.; - endif - call combine_grids_for_remap(ix,iy,kz,1,dat41,nx,ny,kz,1,dat42,gwt%gwt_t,dat43) - - !--- output - !write(*,'(a,i2.2,a,200f)')'=== record',nrecord,': ', dat43(int(nx/2),int(ny/2),:,1) - write(flid_out) (((dat43(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) - deallocate(dat41, dat42, dat43) + !----mpi: 0 is for IO, >0 is for computing + + !---when nd>1, get previous data at 0, and then send to other cores + if ( nd > 1 ) then + if ( my_proc_id == io_proc ) then + allocate(dat4(nx,ny,kz,1), dat42(nx,ny,kz,1)) + !read(flid_in)dat42 + call get_var_data(trim(fl_in), trim(varname), nx, ny, kz, 1, dat42) + do k = 1, kz + dat4(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + deallocate(dat42) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, k, 4000+ks, comm, ierr) + else + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=dat42 + endif + deallocate(dat42) + endif + enddo + deallocate(dat4) + else !if ( my_proc_id == io_proc ) then + !---receive dat42 for each core + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, io_proc, 4000+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then + else !if ( nd > 1 ) then + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=-999999. + endif + endif !if ( nd > 1 ) then + + !---combine dat43+dat41 --> dat42 + !call mpi_barrier(comm,ierr) + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42=-999999. + call combine_grids_for_remap(ix,iy,ke-ks+1,1,dat43,nx,ny,ke-ks+1,1,dat41,gwt%gwt_t,dat42) + if ( my_proc_id /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, io_proc, 5000+ks, comm, ierr) + deallocate(dat42) + endif + deallocate(dat41, dat43) + endif + + !---collect dat43 to io_proc, and output + !call mpi_barrier(comm,ierr) + if ( my_proc_id == io_proc ) then + allocate(dat43(nx,ny,kz,1)) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + if ( k /= io_proc ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, k, 5000+ks, comm, status, ierr) + dat43(:,:,ks:ke,1)=dat41(:,:,1:ke-ks+1,1) + deallocate(dat41) + else + dat43(:,:,ks:ke,1)=dat42(:,:,1:ke-ks+1,1) + deallocate(dat42) + endif + endif + enddo + !write(*,'(a,3i5,100f12.3)')'===w34 ', nx, ny, kz, (dat43(10,10,k,1),k=kz,1,-1) + !write(flid_out) (((dat43(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + call write_nc_real(trim(fl_out), trim(varname), nx, ny, kz, -1, 'nx', 'ny', trim(nzc), '-', dat43, trim(units), trim(varname_long)) + deallocate(dat43) + endif !if ( my_proc_id == io_proc ) then + endif ! if ( nprocs == 1 ) then !--no mpi else if ( nrecord == 6 ) then !---u,v kz=nz - !--- map u to rot-ll grid: ingrid-->dstgrid - allocate(dat42(nx,ny,kz,1), dat43(nx,ny,kz,1)) - if ( nd > 1 ) then - !read(flid_in)(((dat42(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) - read(flid_in)dat43 - do k = 1, kz - dat42(:,:,k,1)=dat43(:,:,kz-k+1,1) - enddo - dat43=-999999. - else - dat42=-9999999.; dat43=0.0 - endif - call combine_grids_for_remap(ix,iy,kz,1,u,nx,ny,kz,1,dat42,gwt%gwt_t,dat43) - write(flid_out) (((dat43(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) - if ( nd > 1 ) then - !read(flid_in)(((dat42(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) - read(flid_in)dat43 - do k = 1, kz - dat42(:,:,k,1)=dat43(:,:,kz-k+1,1) + !---convert u,v from fv3grid to earth + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1; ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(u(ix,iy,ke-ks+1,1), v(ix,iy,ke-ks+1,1)) + allocate(dat2(ix, iy+1), dat21(ix+1, iy)) + do k = 1, ke-ks+1 + call fv3uv2earth(ix, iy, dat42(:,:,k,1), dat43(:,:,k,1), cangu, sangu, cangv, sangv, dat2, dat21) + !---destage: C-/D- grid to A-grid + u(:,:,k,1) = (dat2 (:,1:iy)+dat2 (:,2:iy+1))/2.0 + v(:,:,k,1) = (dat21(1:ix,:)+dat21(2:ix+1,:))/2.0 enddo - dat43=-999999. - else - dat42=-9999999.; dat43=0.0 + deallocate(dat42, dat43, dat2, dat21, cangu, sangu, cangv, sangv) endif - call combine_grids_for_remap(ix,iy,kz,1,v,nx,ny,kz,1,dat42,gwt%gwt_t,dat43) - write(flid_out) (((dat43(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) - deallocate(u, v, dat42, dat43) - endif + + !--- loop u,v + do nv = 1, 2 + !--- get outer domain u,v + if ( nd > 1 ) then + if ( my_proc_id == io_proc ) then + allocate(dat4(nx,ny,kz,1), dat42(nx,ny,kz,1)) + !read(flid_in)dat42 + if (nv==1)call get_var_data(trim(fl_in), 'u', nx, ny, kz, 1, dat42) + if (nv==2)call get_var_data(trim(fl_in), 'v', nx, ny, kz, 1, dat42) + do k = 1, kz + dat4(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + deallocate(dat42) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, k, 300*nv+ks, comm, ierr) + else + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=dat42 + endif + deallocate(dat42) + endif + enddo + deallocate(dat4) + else !if ( my_proc_id == io_proc ) then + !---receive dat42 for each core + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, io_proc, 300*nv+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then + else + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41=-999999. + endif + endif !if ( nd > 1 ) then + + !--- map u/v to rot-ll grid: ingrid-->dstgrid + nm=max(1,int((kz+nprocs-1)/nprocs)) + ks=my_proc_id*nm+1 + ke=my_proc_id*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42=-999999. + if (nv==1) call combine_grids_for_remap(ix,iy,ke-ks+1,1,u,nx,ny,ke-ks+1,1,dat41,gwt%gwt_t,dat42) + if (nv==2) call combine_grids_for_remap(ix,iy,ke-ks+1,1,v,nx,ny,ke-ks+1,1,dat41,gwt%gwt_t,dat42) + if ( my_proc_id /= io_proc ) then + call mpi_send(dat42(1,1,1,1),size(dat42),mpi_real, io_proc, 400*nv+ks, comm, ierr) + deallocate(dat42) + endif + deallocate(dat41) + endif + + !---collect dat43 to io_proc, and output + !call mpi_barrier(comm,ierr) + if ( my_proc_id == io_proc ) then + allocate(dat43(nx,ny,kz,1)) + nm=max(1,int((kz+nprocs-1)/nprocs)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > kz ) ke=kz + if ( ks >= 1 .and. ks <= kz .and. ke >= 1 .and. ke <= kz ) then + if ( k /= io_proc ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, k, 400*nv+ks, comm, status, ierr) + dat43(:,:,ks:ke,1)=dat41(:,:,1:ke-ks+1,1) + deallocate(dat41) + else + dat43(:,:,ks:ke,1)=dat42(:,:,1:ke-ks+1,1) + deallocate(dat42) + endif + endif + enddo + !write(*,'(a,3i5,100f12.3)')'===w51 ', nx, ny, kz, (dat43(10,10,k,1),k=kz,1,-1) + !write(flid_out) (((dat43(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + if (nv==1) call write_nc_real(trim(fl_out), 'u', nx, ny, kz, -1, 'nx', 'ny', 'nz', '-', dat43, 'm/s', 'u-component') + if (nv==2) call write_nc_real(trim(fl_out), 'v', nx, ny, kz, -1, 'nx', 'ny', 'nz', '-', dat43, 'm/s', 'v-component') + deallocate(dat43) + endif !if ( my_proc_id == io_proc ) then + if (nv==1) deallocate(u) + if (nv==2) deallocate(v) + enddo !do nv = 1, 2 + else if ( nrecord ==12 .or. nrecord ==15 .or. nrecord ==16 .or. nrecord ==17 ) then + kz=1 + if ( my_proc_id == io_proc ) then + allocate(dat41(nx,ny,kz,1), dat42(nx,ny,kz,1)) + if ( nd > 1 ) then + !read(flid_in)dat42 + call get_var_data(trim(fl_in), trim(varname), nx, ny, kz, 1, dat42) + do k = 1, kz + dat41(:,:,k,1)=dat42(:,:,kz-k+1,1) + enddo + dat42=-999999. + else + dat41=-999999. + dat42=-999999. + endif + call combine_grids_for_remap(ix,iy,kz,1,dat43,nx,ny,kz,1,dat41,gwt%gwt_t,dat42) + !write(flid_out) (((dat42(i,j,k,1),i=1,nx),j=1,ny),k=kz,1,-1) + call write_nc_real(trim(fl_out), trim(varname), nx, ny, -1, -1, 'nx', 'ny', '-', '-', dat42, trim(units), trim(varname_long)) + deallocate(dat41, dat42, dat43) + endif !if ( my_proc_id == io_proc ) then + endif enddo do_out_var_loop !: for nrecord = 1, 17 !------------------------------------------------------------------------- - ! 8 --- clean ingrid gwt + ! 8 --- clean ingrid gwt deallocate( ingrid%grid_lon, ingrid%grid_lat, ingrid%grid_lont, ingrid%grid_latt) deallocate( gwt%gwt_t, gwt%gwt_u, gwt%gwt_v ) enddo do_nestdom_loop !: do nd = 1, ndom + write(*,*)' === finished hafsvi_preproc ===' return - end subroutine hafsvi_preproc + end subroutine hafsvi_preproc_nc !======================================================================================== subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) @@ -570,7 +1845,7 @@ subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) ! hafs_vi binary output: ! WRITE(IUNIT) NX,NY,NZ,I360 ! WRITE(IUNIT) LON1,LAT1,LON2,LAT2,CENTRAL_LON,CENTRAL_LAT -! WRITE(IUNIT) PMID1 +! WRITE(IUNIT) PMID1 ! WRITE(IUNIT) T1 ! WRITE(IUNIT) Q1 ! WRITE(IUNIT) U1 @@ -628,7 +1903,7 @@ subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) real, allocatable, dimension(:,:) :: hlon, hlat, vlon, vlat integer :: i, j, k, n, flid, ncid, ndims, nrecord, iunit - real, allocatable, dimension(:,:,:,:) :: dat4, dat41, dat42, dat43, phis1, phis2, sfcp1, sfcp2, u1, v1, u, v + real, allocatable, dimension(:,:,:,:) :: dat4, dat41, dat42, dat43, dat44, phis1, phis2, sfcp1, sfcp2, u1, v1, u, v real, allocatable, dimension(:,:,:) :: dat3, dat31 real, allocatable, dimension(:,:) :: dat2, dat21 real, allocatable, dimension(:) :: dat1 @@ -637,9 +1912,15 @@ subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) real, allocatable, dimension(:,:) :: cangu, sangu, cangv, sangv + integer :: io_proc, nm, ks, ke, nv + !------------------------------------------------------------------------------ ! 1 --- arg process -! 1.1 --- ndom +! 1.1 --- i/o processor + io_proc=nprocs-1 !last processor as I/O + !io_proc=0 + +! 1.2 --- ndom ndom=nestdoms+1 !------------------------------------------------------------------------------ @@ -649,8 +1930,8 @@ subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) !---2.1 get input grid info from binary file iunit=36 open(iunit, file=trim(in_file), form='unformatted') - read(iunit) nx, ny, nz, i360 - write(*,'(a,4i5)')'nx, ny, nz, i360 = ',nx, ny, nz, i360 + read(iunit) nx, ny, nz, i360 + write(*,'(a,4i5)')'===w40 nx, ny, nz, i360 = ',nx, ny, nz, i360 read(iunit) lon1,lat1,lon2,lat2,cen_lon,cen_lat write(*,'(a,6f10.3)')'lon1,lat1,lon2,lat2,cen_lon,cen_lat =', lon1,lat1,lon2,lat2,cen_lon,cen_lat @@ -665,33 +1946,36 @@ subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) enddo allocate(hlon(nx,ny), hlat(nx,ny), vlon(nx,ny), vlat(nx,ny)) read(iunit)hlon, hlat, vlon, vlat + close(iunit) +! New change: Jul 2022 JH Shin ! ------------------------------------------------------------- - ! For WPAC storms, CONVERT positive values of western hemisphere within the VI domain - ! into negative value, IF the portion of western hemisphere (e.g., the eastern side of IDL) - ! is included in VI domain, because VI is completed +! For WPAC storms, CONVERT positive values of western hemisphere within the VI domain +! into negative value, IF the portion of western hemisphere (e.g., the eastern side of IDL) +! is included in VI domain, because VI is completed if ( cen_lon > 0. ) then - do j = 1, ny; do i = 1, nx - if(hlon(i,j).gt.180.0) hlon(i,j)=hlon(i,j)-360.0 - if(vlon(i,j).gt.180.0) vlon(i,j)=vlon(i,j)-360.0 - enddo; enddo + where ( hlon > 180. ) hlon=hlon-360. + where ( vlon > 180. ) vlon=vlon-360. endif - ! For CPAC storms located near the east of international date line - ! CONVERT negative values of eastern hemisphere within the VI domain into positive value - ! because VI is done +! For CPAC storms located near the east of international date line +! CONVERT negative values of eastern hemisphere within the VI domain into positive value +! because VI is done if ( cen_lon < -140. )then - do j = 1, ny; do i = 1, nx - if(hlon(i,j).le.-180.0) hlon(i,j)=hlon(i,j)+360.0 - if(vlon(i,j).le.-180.0) vlon(i,j)=vlon(i,j)+360.0 - enddo; enddo + where ( hlon <= -180. ) hlon=hlon+360. + where ( vlon <= -180. ) vlon=vlon+360. endif +! New change: Jul 2022 JH Shin ! ------------------------------------------------------------- - write(*, '(a,8f10.3)')' hlon,hlat(1,1; nx,1; nx,ny; 1,ny) =', & - hlon(1,1), hlat(1,1), hlon(nx,1), hlat(nx,1), hlon(nx,ny), hlat(nx,ny), hlon(1,ny), hlat(1,ny) - write(*, '(a,8f10.3)')' vlon,vlat(1,1; nx,1; nx,ny; 1,ny) =', & - vlon(1,1), vlat(1,1), vlon(nx,1), vlat(nx,1), vlon(nx,ny), vlat(nx,ny), vlon(1,ny), vlat(1,ny) + + + if (my_proc_id==0) then + write(*, '(a,8f10.3)')' hlon,hlat(1,1; nx,1; nx,ny; 1,ny) =', & + hlon(1,1), hlat(1,1), hlon(nx,1), hlat(nx,1), hlon(nx,ny), hlat(nx,ny), hlon(1,ny), hlat(1,ny) + write(*, '(a,8f10.3)')' vlon,vlat(1,1; nx,1; nx,ny; 1,ny) =', & + vlon(1,1), vlat(1,1), vlon(nx,1), vlat(nx,1), vlon(nx,ny), vlat(nx,ny), vlon(1,ny), vlat(1,ny) + endif !----------------------------- !---2.2 define input rot-ll grids @@ -764,11 +2048,12 @@ subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) !----------------------------- !---4.3 calculate output-grid in input-grid's positions (xin, yin), and each grid's weight to dst call cal_src_dst_grid_weight(ingrid, dstgrid) - + !------------------------------------------------------------------------- ! 5 --- process record one-by-one - rewind(iunit) - do_record_loop: do nrecord = 1, 14 + do_record_loop: do nrecord = 1, 14 + + if ( my_proc_id == io_proc ) open(iunit, file=trim(in_file), form='unformatted') !----------------------------- !---5.1 read data and derive out the var for restart @@ -781,152 +2066,403 @@ subroutine hafsvi_postproc(in_file, in_date, out_dir, nestdoms) !---record 2 : lon1,lat1,lon2,lat2,cen_lon,cen_lat !---record 3 : pmid1(nx,ny,nz): pressure on full level !--- ignore, we use p1 to derive delp. - !---record 10: hlon, hlat, vlon, vlat + !---record 10: hlon, hlat, vlon, vlat !---record 12: pd1, PD1(NX,NY): surface pressure !---record 13: eta1, ETA1(NZ+1) !---record 14: eta2, ETA2(NZ+1) - if ( nrecord == 12 ) then - allocate(dat2(nx,ny)) - read(iunit)dat2 - !write(*,'(a,200f10.1)')'pd1: ',dat2(int(nx/2),int(ny/2)) - deallocate(dat2) - elseif ( nrecord == 13 .or. nrecord == 14 ) then - allocate(dat1(nz+1)) - read(iunit)dat1 - !if ( nrecord == 13 ) write(*,'(a3,i1,a,200f10.1)')'eta',nrecord-12,': ',dat1 - !if ( nrecord == 14 ) write(*,'(a3,i1,a,200f10.6)')'eta',nrecord-12,': ',dat1 - deallocate(dat1) - else - read(iunit) + if ( my_proc_id == io_proc ) then + if ( nrecord == 12 ) then + allocate(dat2(nx,ny)) + read(iunit)dat2 + deallocate(dat2) + elseif ( nrecord == 13 .or. nrecord == 14 ) then + allocate(dat1(nz+1)) + read(iunit)dat1 + deallocate(dat1) + else + read(iunit) + endif endif - endif - + endif + ! ALLOCATE ( T1(NX,NY,NZ),Q1(NX,NY,NZ) ) ! ALLOCATE ( U1(NX,NY,NZ),V1(NX,NY,NZ),DZDT(NX,NY,NZ) ) ! ALLOCATE ( Z1(NX,NY,NZ+1),P1(NX,NY,NZ+1) ) if ( nrecord == 6 ) then !u,v - 6,7 + !---record 6 : U1 + !---record 7 : V1 iz=nz - allocate(dat3(nx,ny,iz), u1(nx,ny,iz,1), v1(nx,ny,iz,1)) - read(iunit) dat3 - do k = 1, nz - u1(:,:,nz-k+1,1)=dat3(:,:,k) - enddo - read(iunit) dat3 - do k = 1, nz - v1(:,:,nz-k+1,1)=dat3(:,:,k) - enddo - deallocate(dat3) + if ( my_proc_id == io_proc ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) + do nv = 1, 2 + !---get data + allocate(dat3(nx,ny,iz), dat4(nx,ny,iz,1)) + read(iunit) dat3 + do k = 1, nz + dat4(:,:,nz-k+1,1)=dat3(:,:,k) + enddo + deallocate(dat3) + + !---send + if ( nprocs > 1 ) then + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat41(nx, ny, ke-ks+1,1)) + dat41(:,:,:,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat41(1,1,1,1), size(dat41), mpi_real, k, 200*nv+ks, comm, ierr) + else + if ( nv == 1 ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42=dat41 + else if ( nv == 2 ) then + allocate(dat43(nx, ny, ke-ks+1,1)) + dat43=dat41 + endif + endif + deallocate(dat41) + endif + enddo + else !if ( nprocs > 1 ) then + if ( nv == 1 ) then + allocate(dat42(nx, ny, iz, 1)) + dat42=dat4 + else if ( nv == 2 ) then + allocate(dat43(nx, ny, iz, 1)) + dat43=dat4 + endif + endif !if ( nprocs > 1 ) then + deallocate(dat4) + enddo !do nv = 1, 2 + else !if ( my_proc_id == io_proc ) then + !---receive dat42 dat43 + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(nx, ny, ke-ks+1,1),dat43(nx, ny, ke-ks+1,1)) + call mpi_recv(dat42(1,1,1,1), size(dat42), mpi_real, io_proc, 200*1+ks, comm, status, ierr) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 200*2+ks, comm, status, ierr) + endif + endif + endif !if ( my_proc_id == io_proc ) then endif !if ( nrecord == 6 ) then !u,v - 6,7 if ( nrecord == 4 .or. nrecord == 5 .or. nrecord == 8 .or. & nrecord == 9 .or. nrecord == 11 ) then !---record 4 : t1-->T !---record 5 : Q1 - !---record 6 : U1 - !---record 7 : V1 !---record 8 : DZDT !---record 9 : z1 --> DZ !---record 11: p1-->delp, p1(nx,ny,nz+1): (((p1(i,j,k),i=1,nx),j=1,ny),k=nz+1,1,-1) !--- p1-->ps iz=nz - if ( nrecord == 9 .or. nrecord == 11 ) then - allocate(dat3(nx,ny,iz+1)) - else - allocate(dat3(nx,ny,iz)) - endif - read(iunit) dat3 - allocate(dat41(nx,ny,iz,1)) - - if ( nrecord == 9 .or. nrecord == 11 ) then ! z1 to dz; p1 to delp - !---back pressure to delp on fv_core.res.tile1.nc - do k = 1, nz - dat41(:,:,nz-k+1,1)=dat3(:,:,k)-dat3(:,:,k+1) - enddo - !---phis - if ( nrecord == 9 ) then - allocate(phis1(nx,ny,1,1)) - phis1(:,:,1,1)=dat3(:,:,1)*g + if ( my_proc_id == io_proc ) then + !---get data + if ( nrecord == 9 .or. nrecord == 11 ) then + allocate(dat3(nx,ny,iz+1)) + else + allocate(dat3(nx,ny,iz)) + endif + read(iunit) dat3 + + allocate(dat41(nx,ny,iz,1)) + if ( nrecord == 9 .or. nrecord == 11 ) then ! z1 to dz; p1 to delp + !---back pressure to delp on fv_core.res.tile1.nc + do k = 1, nz + dat41(:,:,nz-k+1,1)=dat3(:,:,k)-dat3(:,:,k+1) + enddo + !---phis + if ( nrecord == 9 ) then + allocate(phis1(nx,ny,1,1)) + phis1(:,:,1,1)=dat3(:,:,1)*g + endif + else + do k = 1, iz + dat41(:,:,iz-k+1,1)=dat3(:,:,k) + enddo + endif + deallocate(dat3) + + !---send data to other cores + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) !devide iz to each processor + do k = 0, nprocs-1 + ks=k*nm+1 !k-start + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(nx, ny, ke-ks+1,1)) + dat42(:,:,:,1)=dat41(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat42(1,1,1,1), size(dat42), mpi_real, k, 3000+ks, comm, ierr) + else + allocate(dat43(nx, ny, ke-ks+1,1)) + dat43=dat42 + endif + deallocate(dat42) + endif + enddo + else !if ( nprocs > 1 ) then + allocate(dat43(nx, ny, iz,1)) + dat43=dat41 + endif + deallocate(dat41) + else ! if ( my_proc_id == io_proc ) then + !---receive dat43 + nm=max(1,int((iz+nprocs-1)/nprocs)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat43(nx, ny, ke-ks+1,1)) + call mpi_recv(dat43(1,1,1,1), size(dat43), mpi_real, io_proc, 3000+ks, comm, status, ierr) endif - else - do k = 1, iz - dat41(:,:,iz-k+1,1)=dat3(:,:,k) - enddo endif - deallocate(dat3) - endif + endif !if ( nrecord == 4 .or. nrecord == 5 .or. nrecord == 8 .or. & !----------------------------- !---5.2 merge hafs restart and update restart files !--- note: need to change nesting domain's filenames - if ( nrecord == 4) then !T - allocate(dat42(ix, iy, iz, 1), dat43(ix, iy, iz, 1)) - call get_var_data(trim(ncfile_core), 'T', ix, iy, iz,1, dat42) - call combine_grids_for_remap(nx,ny,nz,1,dat41,ix,iy,iz,1,dat42,gwt%gwt_t,dat43) - call update_hafs_restart(trim(ncfile_core), 'T', ix, iy, iz, 1, dat43) - deallocate(dat41, dat42, dat43) - elseif ( nrecord == 5 ) then !sphum - allocate(dat42(ix, iy, iz, 1), dat43(ix, iy, iz, 1)) - call get_var_data(trim(ncfile_tracer), 'sphum', ix, iy, iz,1, dat42) - call combine_grids_for_remap(nx,ny,nz,1,dat41,ix,iy,iz,1,dat42,gwt%gwt_t,dat43) - call update_hafs_restart(trim(ncfile_tracer), 'sphum', ix, iy, iz, 1, dat43) - deallocate(dat41, dat42, dat43) - elseif ( nrecord == 6 ) then !u and v + if ( nrecord == 6 ) then !u and v !---get u,v - allocate(u(ix, iy+1, iz, 1)) - call get_var_data(trim(ncfile_core), 'u', ix, iy+1, iz,1, u) - allocate(v(ix+1, iy, iz, 1)) - call get_var_data(trim(ncfile_core), 'v', ix+1, iy, iz,1, v) + iz=nz + nm=max(1,int((iz+nprocs-1)/nprocs)) + do nv = 1, 2 + if ( my_proc_id == io_proc ) then + allocate(dat4(ix+nv-1, iy+2-nv, iz, 1)) !u(ix, iy+1, iz, 1), v(ix+1, iy, iz, 1) + if ( nv == 1 ) then + call get_var_data(trim(ncfile_core), 'u', ix, iy+1, iz,1, dat4) + else if ( nv == 2 ) then + call get_var_data(trim(ncfile_core), 'v', ix+1, iy, iz,1, dat4) + endif + !---send to other core + if ( nprocs > 1 ) then + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + if ( k /= io_proc ) then + allocate(dat41(ix+nv-1, iy+2-nv, ke-ks+1, 1)) + dat41(:,:,1:ke-ks+1,1)=dat4(:,:,ks:ke,1) + call mpi_send(dat41(1,1,1,1), size(dat41), mpi_real, k, 200*nv+ks, comm, ierr) + deallocate(dat41) + else + allocate(dat44(ix+nv-1, iy+2-nv, ke-ks+1, 1)) + dat44(:,:,1:ke-ks+1,1)=dat4(:,:,ks:ke,1) + endif !if ( k /= io_proc ) then + endif !if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + enddo !do k = 0, nprocs-1 + else + allocate(dat44(ix+nv-1, iy+2-nv, iz, 1)) + dat44=dat4 + endif !if ( nprocs > 1 ) then + deallocate(dat4) + else !if ( my_proc_id == io_proc ) then + !---receive u,v + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat44(ix+nv-1, iy+2-nv, ke-ks+1, 1)) + call mpi_recv(dat44, size(dat43), mpi_real, io_proc, 200*nv+ks, comm, status, ierr) + endif + endif !if ( my_proc_id == io_proc ) then + + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( nv == 1 ) then + allocate(u(ix, iy+1, ke-ks+1,1)) + u(:,:,1:ke-ks+1,1)=dat44(:,:,1:ke-ks+1,1) + else if ( nv == 2 ) then + allocate(v(ix+1, iy, ke-ks+1,1)) + v(:,:,1:ke-ks+1,1)=dat44(:,:,1:ke-ks+1,1) + endif + deallocate(dat44) + enddo !do nv = 1, 2 !---convert fv3grid to earth - allocate(dat42(ix, iy+1, iz, 1), dat43(ix+1, iy, iz, 1)) - do k = 1, iz - call fv3uv2earth(ix, iy, u(:,:,k,1), v(:,:,k,1), cangu, sangu, cangv, sangv, dat42(:,:,k,1), dat43(:,:,k,1)) + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + allocate(dat4 (ix, iy+1, ke-ks+1, 1), dat41(ix+1, iy, ke-ks+1, 1)) + !$omp parallel do & + !$omp& private(k) + do k = 1, ke-ks+1 + call fv3uv2earth(ix, iy, u(:,:,k,1), v(:,:,k,1), cangu, sangu, cangv, sangv, dat4(:,:,k,1), dat41(:,:,k,1)) enddo + deallocate(u,v) !---merge - u=0.; v=0. - call combine_grids_for_remap(nx,ny,nz,1,u1,ix,iy+1,iz,1,dat42,gwt%gwt_u,u) - call combine_grids_for_remap(nx,ny,nz,1,v1,ix+1,iy,iz,1,dat43,gwt%gwt_v,v) + allocate(u1(ix, iy+1, ke-ks+1, 1), v1(ix+1, iy, ke-ks+1, 1)) + u1=0.; v1=0. + call combine_grids_for_remap(nx,ny,ke-ks+1,1,dat42,ix,iy+1,ke-ks+1,1,dat4,gwt%gwt_u,u1) + call combine_grids_for_remap(nx,ny,ke-ks+1,1,dat43,ix+1,iy,ke-ks+1,1,dat41,gwt%gwt_v,v1) + deallocate(dat42, dat43, dat4, dat41) !---convert earth wind to fv3grid wind - dat42=-999999.; dat43=-99999999.; - do k = 1, iz - call earthuv2fv3(ix, iy, u(:,:,k,1), v(:,:,k,1), cangu, sangu, cangv, sangv, dat42(:,:,k,1), dat43(:,:,k,1)) + allocate(u(ix, iy+1, ke-ks+1, 1), v(ix+1, iy, ke-ks+1, 1)) + u=-999999.; v=-99999999.; + !$omp parallel do & + !$omp& private(k) + do k = 1, ke-ks+1 + call earthuv2fv3(ix, iy, u1(:,:,k,1), v1(:,:,k,1), cangu, sangu, cangv, sangv, u(:,:,k,1), v(:,:,k,1)) enddo + deallocate(u1,v1,cangu, sangu, cangv, sangv) + + !---send and collect + if ( nprocs == 1 ) then + allocate(u1(ix, iy+1, iz, 1), v1(ix+1, iy, iz, 1)) + u1=u + v1=v + deallocate(u,v) + else + nm=max(1,int((iz+nprocs-1)/nprocs)) + if ( my_proc_id /= io_proc ) then + call mpi_send(u(1,1,1,1),size(u),mpi_real, io_proc, 400*1+my_proc_id, comm, ierr) + call mpi_send(v(1,1,1,1),size(v),mpi_real, io_proc, 400*2+my_proc_id, comm, ierr) + deallocate(u,v) + else + allocate(u1(ix, iy+1, iz, 1), v1(ix+1, iy, iz, 1)) + do k = 0, nprocs-1 + ks=k*nm+1 !k-start + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + if ( k /= io_proc ) then + allocate(dat41(ix, iy+1, ke-ks+1, 1), dat42(ix+1, iy, ke-ks+1, 1)) + call mpi_recv(dat41(1,1,1,1), size(dat41), mpi_real, k, 400*1+k, comm, status, ierr) + call mpi_recv(dat42(1,1,1,1), size(dat42), mpi_real, k, 400*2+k, comm, status, ierr) + u1(:,:,ks:ke,1)=dat41(:,:,1:ke-ks+1,1) + v1(:,:,ks:ke,1)=dat42(:,:,1:ke-ks+1,1) + deallocate(dat41,dat42) + else + u1(:,:,ks:ke,1)=u(:,:,1:ke-ks+1,1) + v1(:,:,ks:ke,1)=v(:,:,1:ke-ks+1,1) + deallocate(u,v) + endif + endif + enddo !do k = 0, nprocs-1 + endif + endif !if ( nprocs > 1 ) then !need recv !---output - call update_hafs_restart(trim(ncfile_core), 'u', ix, iy+1, iz, 1, dat42) - call update_hafs_restart(trim(ncfile_core), 'v', ix+1, iy, iz, 1, dat43) - deallocate(u1, v1, u, v, dat42, dat43, cangu, sangu, cangv, sangv) - elseif ( nrecord == 8 ) then !W - allocate(dat42(ix, iy, iz, 1), dat43(ix, iy, iz, 1)) - call get_var_data(trim(ncfile_core), 'W', ix, iy, iz,1, dat42) - call combine_grids_for_remap(nx,ny,nz,1,dat41,ix,iy,iz,1,dat42,gwt%gwt_t,dat43) - call update_hafs_restart(trim(ncfile_core), 'W', ix, iy, iz, 1, dat43) - deallocate(dat41, dat42, dat43) - elseif ( nrecord == 9 ) then !DZ, phis - allocate(dat42(ix, iy, iz, 1), dat43(ix, iy, iz, 1)) - call get_var_data(trim(ncfile_core), 'DZ', ix, iy, iz,1, dat42) - call combine_grids_for_remap(nx,ny,nz,1,dat41,ix,iy,iz,1,dat42,gwt%gwt_t,dat43) - call update_hafs_restart(trim(ncfile_core), 'DZ', ix, iy, iz, 1, dat43) - deallocate(dat41, dat42, dat43) - allocate(phis2(ix, iy, 1, 1), dat43(ix, iy, 1, 1)) - call get_var_data(trim(ncfile_core), 'phis', ix, iy, 1, 1, phis2) - call combine_grids_for_remap(nx,ny,1,1,phis1,ix,iy,1,1,phis2,gwt%gwt_t,dat43) - call update_hafs_restart(trim(ncfile_core), 'phis', ix, iy, 1, 1, dat43) - deallocate(phis1, phis2, dat43) - elseif ( nrecord == 11 ) then !delp - allocate(dat42(ix, iy, iz, 1), dat43(ix, iy, iz, 1)) - call get_var_data(trim(ncfile_core), 'delp', ix, iy, iz,1, dat42) - call combine_grids_for_remap(nx,ny,nz,1,dat41,ix,iy,iz,1,dat42,gwt%gwt_t,dat43) - call update_hafs_restart(trim(ncfile_core), 'delp', ix, iy, iz, 1, dat43) - deallocate(dat41, dat42, dat43) + if ( my_proc_id == io_proc ) then + call update_hafs_restart(trim(ncfile_core), 'u', ix, iy+1, iz, 1, u1) + call update_hafs_restart(trim(ncfile_core), 'v', ix+1, iy, iz, 1, v1) + deallocate(u1, v1) + endif + elseif ( nrecord == 4 .or. nrecord == 5 .or. nrecord == 8 .or. & + nrecord == 9 .or. nrecord == 11 ) then + iz=nz + nm=max(1,int((iz+nprocs-1)/nprocs)) + if ( my_proc_id == io_proc ) then + !---get restart data + allocate(dat4(ix, iy, iz, 1)) + if ( nrecord == 4 ) call get_var_data(trim(ncfile_core), 'T', ix, iy, iz,1, dat4) + if ( nrecord == 5 ) call get_var_data(trim(ncfile_tracer), 'sphum', ix, iy, iz,1, dat4) + if ( nrecord == 8 ) call get_var_data(trim(ncfile_core), 'W', ix, iy, iz,1, dat4) + if ( nrecord == 9 ) call get_var_data(trim(ncfile_core), 'DZ', ix, iy, iz,1, dat4) + if ( nrecord == 11 ) call get_var_data(trim(ncfile_core), 'delp', ix, iy, iz,1, dat4) + + !---send data to other cores + if ( nprocs > 1 ) then + nm=max(1,int((iz+nprocs-1)/nprocs)) !devide iz to each processor + do k = 0, nprocs-1 + ks=k*nm+1 !k-start + ke=k*nm+nm !k-end + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat41(ix, iy, ke-ks+1,1)) + dat41(:,:,1:ke-ks+1,1)=dat4(:,:,ks:ke,1) + if ( k /= io_proc ) then + call mpi_send(dat41(1,1,1,1), size(dat41), mpi_real, k, 3000+ks, comm, ierr) + else + allocate(dat42(ix, iy, ke-ks+1,1)) + dat42=dat41 + endif + deallocate(dat41) + endif + enddo + else !if ( nprocs > 1 ) then + allocate(dat42(ix, iy, iz,1)) + dat42=dat4 + endif + deallocate(dat4) + else ! if ( my_proc_id == io_proc ) then + !---receive dat43 + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + allocate(dat42(ix, iy, ke-ks+1,1)) + call mpi_recv(dat42(1,1,1,1), size(dat42), mpi_real, io_proc, 3000+ks, comm, status, ierr) + endif + endif + + !---merge + ks=min(iz,my_proc_id*nm+1) + ke=min(iz,my_proc_id*nm+nm) + allocate(dat4(ix, iy, ke-ks+1, 1)) + call combine_grids_for_remap(nx,ny,ke-ks+1,1,dat43,ix,iy,ke-ks+1,1,dat42,gwt%gwt_t,dat4) + deallocate(dat43, dat42) + + !---collect data to io_proc + if ( nprocs == 1 ) then + allocate(dat41(ix, iy, iz, 1)) + dat41=dat4 + else + nm=max(1,int((iz+nprocs-1)/nprocs)) !devide iz to each processor + if ( my_proc_id /= io_proc ) then + call mpi_send(dat4(1,1,1,1),size(dat4),mpi_real, io_proc, 600+ks, comm, ierr) + else + allocate(dat41(ix, iy, iz, 1)) + do k = 0, nprocs-1 + ks=k*nm+1 + ke=k*nm+nm + if ( ke > iz ) ke=iz + if ( ks >= 1 .and. ks <= iz .and. ke >= 1 .and. ke <= iz ) then + if ( k /= io_proc ) then + allocate(dat42(ix, iy, ke-ks+1,1)) + call mpi_recv(dat42(1,1,1,1), size(dat42), mpi_real, k, 600+ks, comm, status, ierr) + dat41(:,:,ks:ke,1)=dat42(:,:,1:ke-ks+1,1) + deallocate(dat42) + else + dat41(:,:,ks:ke,1)=dat4(:,:,1:ke-ks+1,1) + endif + endif + enddo + endif !if ( my_proc_id /= io_proc ) then + endif !if ( nprocs == 1 ) then + + !---output + if ( my_proc_id == io_proc ) then + !---update restartr + if ( nrecord == 4 ) call update_hafs_restart(trim(ncfile_core), 'T', ix, iy, iz, 1, dat41) + if ( nrecord == 5 ) call update_hafs_restart(trim(ncfile_tracer), 'sphum', ix, iy, iz, 1, dat41) + if ( nrecord == 8 ) call update_hafs_restart(trim(ncfile_core), 'W', ix, iy, iz, 1, dat41) + if ( nrecord == 9 ) call update_hafs_restart(trim(ncfile_core), 'DZ', ix, iy, iz, 1, dat41) + if ( nrecord ==11 ) call update_hafs_restart(trim(ncfile_core), 'delp', ix, iy, iz, 1, dat41) + deallocate(dat41) + + !---2d phis + if ( nrecord == 9 .and. my_proc_id == io_proc ) then !phis + allocate(phis2(ix, iy, 1, 1), dat41(ix, iy, 1, 1)) + call get_var_data(trim(ncfile_core), 'phis', ix, iy, 1, 1, phis2) + call combine_grids_for_remap(nx,ny,1,1,phis1,ix,iy,1,1,phis2,gwt%gwt_t,dat41) + call update_hafs_restart(trim(ncfile_core), 'phis', ix, iy, 1, 1, dat41) + deallocate(phis1, phis2, dat41) + endif + + endif !if ( my_proc_id == io_proc ) then + deallocate(dat4) endif - + enddo do_record_loop !----------------------------- - ! 6 --- clean + ! 6 --- clean deallocate( dstgrid%grid_lon, dstgrid%grid_lat, dstgrid%grid_lont, dstgrid%grid_latt) deallocate( gwt%gwt_t, gwt%gwt_u, gwt%gwt_v ) diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_netcdf.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_netcdf.f90 index ac2b516be..91083be3e 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_netcdf.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_netcdf.f90 @@ -2,6 +2,7 @@ subroutine rd_grid_spec_data(ncfile, grid) use netcdf + use module_mpi use var_type implicit none @@ -24,58 +25,64 @@ subroutine rd_grid_spec_data(ncfile, grid) case ('grid_yt') ; grid%grid_yt = i end select enddo - + if (allocated(grid%grid_lon)) deallocate(grid%grid_lon) allocate(grid%grid_lon(grid%grid_x,grid%grid_y)) call nccheck(nf90_inq_varid(ncid, 'grid_lon', varid), 'wrong in nf90_inq_varid grid_lon', .false.) call nccheck(nf90_get_var(ncid, varid, grid%grid_lon), 'wrong in get data of grid_lon', .false.) where ( grid%grid_lon > 180. ) grid%grid_lon=grid%grid_lon-360. - + if (allocated(grid%grid_lat)) deallocate(grid%grid_lat) allocate(grid%grid_lat(grid%grid_x,grid%grid_y)) call nccheck(nf90_inq_varid(ncid, 'grid_lat', varid), 'wrong in nf90_inq_varid grid_lat', .false.) call nccheck(nf90_get_var(ncid, varid, grid%grid_lat), 'wrong in get data of grid_lat', .false.) - + if (allocated(grid%times)) deallocate(grid%times) allocate(grid%times(grid%ntime)) call nccheck(nf90_inq_varid(ncid, 'time', varid), 'wrong in nf90_inq_varid time', .false.) call nccheck(nf90_get_var(ncid, varid, grid%times), 'wrong in get data of time', .false.) - call nccheck(nf90_get_att(ncid, varid, 'units', grid%times_unit), 'wrong in get times_unit', .false.) - + call nccheck(nf90_get_att(ncid, varid, 'units', grid%times_unit), 'wrong in get times_unit', .false.) + if (allocated(grid%grid_lont)) deallocate(grid%grid_lont) allocate(grid%grid_lont(grid%grid_xt,grid%grid_yt)) call nccheck(nf90_inq_varid(ncid, 'grid_lont', varid), 'wrong in nf90_inq_varid grid_lont', .false.) call nccheck(nf90_get_var(ncid, varid, grid%grid_lont), 'wrong in get data of grid_lont', .false.) where ( grid%grid_lont > 180. ) grid%grid_lont=grid%grid_lont-360. - + if (allocated(grid%grid_latt)) deallocate(grid%grid_latt) allocate(grid%grid_latt(grid%grid_xt,grid%grid_yt)) call nccheck(nf90_inq_varid(ncid, 'grid_latt', varid), 'wrong in nf90_inq_varid grid_latt', .false.) call nccheck(nf90_get_var(ncid, varid, grid%grid_latt), 'wrong in get data of grid_latt', .false.) - + !if (allocated(grid%grid_area)) deallocate(grid%grid_area) !allocate(grid%grid_area(grid%grid_xt,grid%grid_yt)) !call nccheck(nf90_inq_varid(ncid, 'grid_area', varid), 'wrong in nf90_inq_varid grid_area', .false.) !call nccheck(nf90_get_var(ncid, varid, grid%grid_area), 'wrong in get data of grid_area', .false.) - write(*,'(a,i0,a,i0,a,i0,a,i0,a)')' domain dims: (1:1) --> (',grid%grid_xt,':1) --> (',grid%grid_xt,':',grid%grid_yt,') --> (1:',grid%grid_yt,')' - write(*,'(a, 2f7.2,a,2f7.2,a,2f7.2,a,2f7.2)')' T-cell:', grid%grid_lont(1,1),grid%grid_latt(1,1), '--->', & + if ( my_proc_id == 0 ) then + write(*,'(a,i0,a,i0,a,i0,a,i0,a)')' domain dims: (1:1) --> (',grid%grid_xt,':1) --> (',& + grid%grid_xt,':',grid%grid_yt,') --> (1:',grid%grid_yt,')' + write(*,'(a, 2f7.2,a,2f7.2,a,2f7.2,a,2f7.2)')' T-cell:', grid%grid_lont(1,1),grid%grid_latt(1,1), '--->', & grid%grid_lont(grid%grid_xt,1),grid%grid_latt(grid%grid_xt,1), '--->', & grid%grid_lont(grid%grid_xt,grid%grid_yt),grid%grid_latt(grid%grid_xt,grid%grid_yt), '--->', & grid%grid_lont(1,grid%grid_yt),grid%grid_latt(1,grid%grid_yt) - write(*,'(a,f7.2,a,f7.2,a,f7.2,a,f7.2)')' grid_lont :',minval(grid%grid_lont),':',maxval(grid%grid_lont),' grid_latt :',minval(grid%grid_latt),':',maxval(grid%grid_latt) - write(*,'(a,i0,a,i0,a,i0,a,i0,a)')' domain dims: (1:1) --> (',grid%grid_x ,':1) --> (',grid%grid_x ,':',grid%grid_y ,') --> (1:',grid%grid_y ,')' - write(*,'(a, 2f7.2,a,2f7.2,a,2f7.2,a,2f7.2)')' :', grid%grid_lon (1,1),grid%grid_lat (1,1), '--->', & + write(*,'(a,f7.2,a,f7.2,a,f7.2,a,f7.2)')' grid_lont :',minval(grid%grid_lont),':',maxval(grid%grid_lont),& + ' grid_latt :',minval(grid%grid_latt),':',maxval(grid%grid_latt) + write(*,'(a,i0,a,i0,a,i0,a,i0,a)')' domain dims: (1:1) --> (',grid%grid_x ,':1) --> (',& + grid%grid_x ,':',grid%grid_y ,') --> (1:',grid%grid_y ,')' + write(*,'(a, 2f7.2,a,2f7.2,a,2f7.2,a,2f7.2)')' :', grid%grid_lon (1,1),grid%grid_lat (1,1), '--->', & grid%grid_lon (grid%grid_x ,1),grid%grid_lat (grid%grid_x ,1), '--->', & grid%grid_lon (grid%grid_x ,grid%grid_y ),grid%grid_lat (grid%grid_x ,grid%grid_y ), '--->', & grid%grid_lon (1,grid%grid_y ),grid%grid_lat (1,grid%grid_y ) - write(*,'(a,f7.2,a,f7.2,a,f7.2,a,f7.2)')' grid_lon :',minval(grid%grid_lon ),':',maxval(grid%grid_lon ),' grid_lat :',minval(grid%grid_lat ),':',maxval(grid%grid_lat) + write(*,'(a,f7.2,a,f7.2,a,f7.2,a,f7.2)')' grid_lon :',minval(grid%grid_lon ),':',maxval(grid%grid_lon ),& + ' grid_lat :',minval(grid%grid_lat ),':',maxval(grid%grid_lat) + endif call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .true.) return end subroutine rd_grid_spec_data - + !======================================================================================== subroutine get_var_data (ncfile, var, ix, jx, kx, tx, data) @@ -88,17 +95,17 @@ subroutine get_var_data (ncfile, var, ix, jx, kx, tx, data) integer :: ncid, varid, dimid,xtype real*8, allocatable, dimension(:,:,:,:) :: ddata - integer, allocatable, dimension(:,:,:,:) :: idata + integer, allocatable, dimension(:,:,:,:) :: idata write(*,'(a,4i5)')'---getting '//trim(var)//' :', ix, jx, kx, tx call nccheck(nf90_open(trim(ncfile), nf90_nowrite, ncid), 'wrong in open '//trim(ncfile), .false.) call nccheck(nf90_inq_varid(ncid, trim(var), varid), 'wrong in nf90_inq_varid '//trim(var), .false.) call nccheck(nf90_inquire_variable(ncid, varid, xtype=xtype), 'wrong in nf90_inquire_variable'//trim(var), .false.) - + if ( xtype == nf90_float .or. xtype == nf90_real .or. xtype == nf90_real4 ) then call nccheck(nf90_get_var(ncid, varid, data), 'wrong in get data of '//trim(var), .false.) else if ( xtype == nf90_double .or. xtype == nf90_real8 ) then - allocate(ddata(ix, jx, kx, tx)) + allocate(ddata(ix, jx, kx, tx)) call nccheck(nf90_get_var(ncid, varid, ddata), 'wrong in get data of '//trim(var), .false.) data=real(ddata) deallocate(ddata) @@ -107,7 +114,7 @@ subroutine get_var_data (ncfile, var, ix, jx, kx, tx, data) call nccheck(nf90_get_var(ncid, varid, idata), 'wrong in get data of '//trim(var), .false.) data=real(idata) deallocate(idata) - else + else !---NF90_BYTE, NF90_CHAR, NF90_SHORT write(*,*)' !!!! please add ',xtype,' xtype data here ' stop @@ -117,6 +124,51 @@ subroutine get_var_data (ncfile, var, ix, jx, kx, tx, data) return end subroutine get_var_data +!======================================================================================== + subroutine get_var_data_par (ncfile, var, ix, jx, kx, tx, data, ixs, jxs, kxs, txs) + + use netcdf + use module_mpi + + implicit none + character(len=*), intent(in) :: ncfile + character(len=*), intent(in) :: var + integer, intent(in) :: ix, jx, kx, tx, ixs, jxs, kxs, txs + real, dimension(ix, jx, kx, tx) :: data + + integer :: ncid, varid, dimid,xtype + real*8, allocatable, dimension(:,:,:,:) :: ddata + integer, allocatable, dimension(:,:,:,:) :: idata + + write(*,'(a,3(i0,1x),i0,a,3(i0,1x),i0,a)')'---getting '//trim(var)//' : (', ixs, jxs, kxs, txs, ') --> (', ix, jx, kx, tx,')' + !call nccheck(nf90_open(trim(ncfile), nf90_nowrite, ncid), & + call nccheck(nf90_open(trim(ncfile), nf90_nowrite, ncid), 'wrong in open '//trim(ncfile), .false.) + call nccheck(nf90_inq_varid(ncid, trim(var), varid), 'wrong in nf90_inq_varid '//trim(var), .false.) + !call nccheck(nf90_var_par_access(ncid, varid, nf90_collective), 'wrong in nf90_var_par_access '//trim(var), .false.) + call nccheck(nf90_inquire_variable(ncid, varid, xtype=xtype), 'wrong in nf90_inquire_variable'//trim(var), .false.) + !call nccheck(nf90_var_par_access(ncid, varid, nf90_collective), 'wrong in nf90_var_par_access '//trim(var), .false.) + + if ( xtype == nf90_float .or. xtype == nf90_real .or. xtype == nf90_real4 ) then + call nccheck(nf90_get_var(ncid, varid, data, start = (/ixs, jxs, kxs, txs/), count = (/ix, jx, kx, tx/)), 'wrong in get data of '//trim(var), .false.) + else if ( xtype == nf90_double .or. xtype == nf90_real8 ) then + allocate(ddata(ix, jx, kx, tx)) + call nccheck(nf90_get_var(ncid, varid, ddata, start = (/ixs, jxs, kxs, txs/), count = (/ix, jx, kx, tx/)), 'wrong in get data of '//trim(var), .false.) + data=real(ddata) + deallocate(ddata) + else if ( xtype == nf90_int ) then + allocate(idata(ix, jx, kx, tx)) + call nccheck(nf90_get_var(ncid, varid, idata, start = (/ixs, jxs, kxs, txs/), count = (/ix, jx, kx, tx/)), 'wrong in get data of '//trim(var), .false.) + data=real(idata) + deallocate(idata) + else + !---NF90_BYTE, NF90_CHAR, NF90_SHORT + write(*,*)' !!!! please add ',xtype,' xtype data here ' + stop + endif + call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .false.) + + return + end subroutine get_var_data_par !======================================================================================== subroutine get_character_var(ncid, varname, dim_len, dimsize, values) @@ -156,7 +208,7 @@ end subroutine get_character_var !======================================================================================== subroutine get_var_dim(ncfile, var, ndims, dims) - + use netcdf implicit none character(len=*), intent(in) :: ncfile @@ -169,7 +221,7 @@ subroutine get_var_dim(ncfile, var, ndims, dims) call nccheck(nf90_open(trim(ncfile), nf90_nowrite, ncid), 'wrong in open '//trim(ncfile), .false.) call nccheck(nf90_inq_varid(ncid, trim(var), varid), 'wrong in nf90_inq_varid '//trim(var), .false.) - call nccheck(nf90_inquire_variable(ncid, varid, ndims=ndims, dimids=dimids), 'wrong in inquire_variable '//trim(var), .false.) + call nccheck(nf90_inquire_variable(ncid, varid, ndims=ndims, dimids=dimids), 'wrong in inquire_variable '//trim(var), .false.) dims=-999 do i = 1, ndims call nccheck(nf90_inquire_dimension(ncid,dimids(i), len=dims(i)), 'wrong in inquire '//trim(var)//' dim', .false.) @@ -190,7 +242,7 @@ subroutine update_hafs_restart(ncfile, varname, ix, jx, kx, tx, dat4) real, dimension(abs(ix), abs(jx), abs(kx), abs(tx)), intent(in) :: dat4 integer :: ncid, varid, ndims, xtype, rcode - + call nccheck(nf90_open(trim(ncfile), nf90_write, ncid), 'wrong in open '//trim(ncfile), .true.) !---check variable's type: nf90_real, nf90_double call nccheck(nf90_inq_varid(ncid, trim(varname), varid), 'wrong in inq_varid '//trim(varname), .true.) @@ -203,7 +255,364 @@ subroutine update_hafs_restart(ncfile, varname, ix, jx, kx, tx, dat4) call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .true.) return - end subroutine update_hafs_restart + end subroutine update_hafs_restart +!======================================================================================== + subroutine update_hafs_restart_par(ncfile, varname, ix, jx, kx, tx, dat4, ixs, jxs, kxs, txs) + + use netcdf + implicit none + character(len=*), intent(in) :: ncfile + character(len=*), intent(in) :: varname + integer, intent ( in) :: ix, jx, kx, tx, ixs, jxs, kxs, txs ! -1=no-this-dim + real, dimension(abs(ix), abs(jx), abs(kx), abs(tx)), intent(in) :: dat4 + + integer :: ncid, varid, ndims, xtype, rcode + + call nccheck(nf90_open(trim(ncfile), nf90_write, ncid), 'wrong in open '//trim(ncfile), .true.) + !---check variable's type: nf90_real, nf90_double + call nccheck(nf90_inq_varid(ncid, trim(varname), varid), 'wrong in inq_varid '//trim(varname), .true.) + call nccheck(nf90_inquire_variable(ncid, varid, xtype=xtype, ndims=ndims), 'wrong in inquire '//trim(varname)//' xtype', .false.) + if ( xtype == nf90_float .or. xtype == nf90_real .or. xtype == nf90_real4 ) then + call nccheck(nf90_put_var(ncid, varid, dat4, start = (/ixs, jxs, kxs, txs/), count = (/ix, jx, kx, tx/)), 'wrong in write '//trim(varname), .false.) + else if ( xtype == nf90_double .or. xtype == nf90_real8 ) then + call nccheck(nf90_put_var(ncid, varid, dble(dat4), start = (/ixs, jxs, kxs, txs/), count = (/ix, jx, kx, tx/)), 'wrong in write '//trim(varname), .false.) + endif + call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .true.) + + return + end subroutine update_hafs_restart_par + +!======================================================================================== + subroutine write_nc_dim(ncfile, dimname, nx) + + use netcdf + use module_mpi + + implicit none + character(len=*), intent(in) :: ncfile + character(len=*), intent(in) :: dimname + integer, intent ( in) :: nx + + logical :: file_exists + integer :: ncid, nxid, rcode + + !----1.0 open or creat file + inquire(file=trim(ncfile), exist=file_exists) + if ( file_exists ) then + call nccheck(nf90_open(trim(ncfile), nf90_write, ncid), 'wrong in open '//trim(ncfile), .true.) + else + call nccheck(nf90_create(trim(ncfile), nf90_hdf5, ncid), 'wrong in creat '//trim(ncfile), .true.) + endif + + !----2.0 define dimension + rcode=nf90_inq_dimid(ncid, trim(dimname), nxid) + if ( rcode /= nf90_noerr ) then !need to create the dimension + call nccheck(nf90_def_dim(ncid, trim(dimname), nx, nxid), 'wrong in def '//trim(dimname), .true.) + endif + + call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .true.) + + return + end subroutine write_nc_dim + +!======================================================================================== + subroutine write_nc_real0d(ncfile, varname, data, units, long_name) + + use netcdf + use module_mpi + + implicit none + character(len=*), intent(in) :: ncfile + character(len=*), intent(in) :: varname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long_name + real :: data + + logical :: file_exists + integer :: ncid, varid, rcode + + !----1.0 open or creat file + inquire(file=trim(ncfile), exist=file_exists) + if ( file_exists ) then + call nccheck(nf90_open(trim(ncfile), nf90_write, ncid), 'wrong in open '//trim(ncfile), .true.) + else + call nccheck(nf90_create(trim(ncfile), nf90_hdf5, ncid), 'wrong in creat '//trim(ncfile), .true.) + endif + + !----2.0 define variables + rcode=nf90_inq_varid(ncid, varname, varid) + if ( rcode /= nf90_noerr ) then ! need to create the var + call nccheck(nf90_def_var(ncid, varname, nf90_real, varid), 'wrong in def '//trim(varname), .true.) + !call nccheck(nf90_var_par_access(ncid, varid, nf90_collective), 'wrong in nf90_var_par_access '//trim(varname), .false.) + if ( len_trim(units) > 0 ) call nccheck(nf90_put_att(ncid, varid, "units", units), 'wrong in put units', .false.) + if ( len_trim(long_name) > 0 ) call nccheck(nf90_put_att(ncid, varid, "long_name",long_name), 'wrong in put long_name', .false.) + endif + + !----3.0 + call nccheck(nf90_put_var(ncid, varid, data), 'wrong in write '//trim(varname), .true.) + + call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .true.) + + return + end subroutine write_nc_real0d + +!======================================================================================== + subroutine write_nc_real(ncfile, varname, ix, jx, kx, tx, cx, cy, ck, ct, data, units, long_name) + + use netcdf + use module_mpi + + implicit none + character(len=*), intent(in) :: ncfile + character(len=*), intent(in) :: varname + integer, intent(in) :: ix, jx, kx, tx !dimensions for this varname + character(len=*), intent(in) :: cx, cy, ck, ct !dimension name + real, dimension(abs(ix), abs(jx), abs(kx), abs(tx)), intent(inout) :: data + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long_name + + logical :: file_exists + integer :: ncid, varid, rcode, ixid, jxid, kxid, txid + integer :: date_time(8) + character*10 :: date(3) + + real :: FillValue + + FillValue=9.999e+20 + !----1.0 process data _FillValue + where( data > 9.0e+8 .or. data < -300000. ) data=FillValue + + !----2.0 check file + inquire(file=trim(ncfile), exist=file_exists) + if ( file_exists ) then + call nccheck(nf90_open(trim(ncfile), nf90_write, ncid), 'wrong in open '//trim(ncfile)//' for '//trim(varname), .true.) + else + write(*,*)' !!!! please call write_nc_dim to generate the nc file of '//trim(ncfile) + stop + endif + + !----3.0 check dimensions + if ( len_trim(cx) > 0 .and. cx(1:1) /= '-' .and. cx(1:1) /= '=' .and. ix > 0 ) then !ix<0 will not generate this dimension + rcode=nf90_inq_dimid(ncid, trim(cx), ixid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, cx, ix, ixid), 'wrong in def_dim '//trim(cx), .true.) + endif + if ( len_trim(cy) > 0 .and. cy(1:1) /= '-' .and. cy(1:1) /= '=' .and. jx > 0 ) then + rcode=nf90_inq_dimid(ncid, trim(cy), jxid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, cy, jx, jxid), 'wrong in def_dim '//trim(cy), .true.) + endif + if ( len_trim(ck) > 0 .and. ck(1:1) /= '-' .and. ck(1:1) /= '=' .and. kx > 0 ) then + rcode=nf90_inq_dimid(ncid, trim(ck), kxid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, ck, kx, kxid), 'wrong in def_dim '//trim(ck), .true.) + endif + if ( len_trim(ct) > 0 .and. ct(1:1) /= '-' .and. ct(1:1) /= '=' .and. tx > 0 ) then + rcode=nf90_inq_dimid(ncid, trim(ct), txid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, ct, tx, txid), 'wrong in def_dim '//trim(ct), .true.) + endif + + !----4.0 check var + rcode=nf90_inq_varid(ncid, varname, varid) + if ( rcode /= nf90_noerr ) then ! need to define the var + if ( tx>0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid,kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid,kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/txid/), varid), 'wrong in def_var '//trim(varname), .true.) + endif + else if ( tx<=0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid,kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid,kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,varid), 'wrong in def_var '//trim(varname), .true.) + endif + endif + !--- + !if ( ix>0 .and. jx>0 ) then + ! call nccheck(nf90_def_var_chunking(ncid, varid, 1, [jx, ix]), 'wrong in nf90_def_var_chunking', .false.) + ! call nccheck(nf90_def_var_deflate(ncid, varid, 1, 1, 4), 'wrong in nf90_def_var_deflate 4', .false.) + !endif + call nccheck(nf90_enddef(ncid), 'wrong in nf90_enddef', .false.) + endif + + !----5.0 write data + !call nccheck(nf90_var_par_access(ncid, varid, nf90_collective), 'wrong in nf90_var_par_access '//trim(varname), .false.) + if ( tx>0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix,jx,kx,tx/))), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix, kx,tx/))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ jx,kx,tx/))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ kx,tx/))), 'wrong in write '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix,jx, tx/))), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix, tx/))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ jx, tx/))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ tx/))), 'wrong in write '//trim(varname), .true.) + endif + else if ( tx<=0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix,jx,kx /))), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix, kx /))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ jx,kx /))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ kx /))), 'wrong in write '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix,jx /))), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ix /))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ jx /))), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, data), 'wrong in write '//trim(varname), .true.) + endif + endif + + !----6.0 put att + if ( len_trim(units) > 0 .and. units(1:1) /= '=') call nccheck(nf90_put_att(ncid, varid, "units", units), 'wrong in put units', .false.) + if ( len_trim(long_name) > 0 .and. long_name(1:1) /= '=') call nccheck(nf90_put_att(ncid, varid, "long_name",long_name), 'wrong in put long_name', .false.) + call nccheck(nf90_put_att(ncid, nf90_global, "File-type", "HAFS VI pre-file on rot-ll grids derived from HAFS restart files"), 'wrong in put_att', .false.) + call date_and_time(date(1), date(2), date(3), date_time) + call nccheck(nf90_put_att(ncid, nf90_global, "Created_date",date(1)), 'wrong input Created_date', .false.) + + call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .true.) + + return + end subroutine write_nc_real + +!======================================================================================== + subroutine write_nc_real_par(ncfile, varname, ix, jx, kx, tx, cx, cy, ck, ct, & + is, js, ks, ts, ni, nj, nk, nt, data, units, long_name) + + use netcdf + use module_mpi + + implicit none + character(len=*), intent(in) :: ncfile + character(len=*), intent(in) :: varname + integer, intent(in) :: ix, jx, kx, tx !dimensions for this varname + character(len=*), intent(in) :: cx, cy, ck, ct !dimension name + integer, intent(in) :: is, js, ks, ts !data block starts + integer, intent(in) :: ni, nj, nk, nt !data size + real, dimension(ni, nj, nk, nt), intent(inout) :: data + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long_name + + logical :: file_exists + integer :: ncid, varid, rcode, ixid, jxid, kxid, txid + integer :: date_time(8) + character*10 :: date(3) + + real :: FillValue + + FillValue=9.999e+20 + !----1.0 process data _FillValue + where( data > 9.0e+8 .or. data < -300000. ) data=FillValue + + !----2.0 check file + inquire(file=trim(ncfile), exist=file_exists) + if ( file_exists ) then + call nccheck(nf90_open(trim(ncfile), nf90_write, ncid), 'wrong in open '//trim(ncfile)//' for '//trim(varname), .true.) + else + write(*,*)' !!!! please call write_nc_dim to generate the nc file of '//trim(ncfile) + stop + endif + + !----3.0 check dimensions + if ( len_trim(cx) > 0 .and. cx(1:1) /= '-' .and. cx(1:1) /= '=' .and. ix > 0 ) then !ix<0 will not generate this dimension + rcode=nf90_inq_dimid(ncid, trim(cx), ixid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, cx, ix, ixid), 'wrong in def_dim '//trim(cx), .true.) + endif + if ( len_trim(cy) > 0 .and. cy(1:1) /= '-' .and. cy(1:1) /= '=' .and. jx > 0 ) then + rcode=nf90_inq_dimid(ncid, trim(cy), jxid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, cy, jx, jxid), 'wrong in def_dim '//trim(cy), .true.) + endif + if ( len_trim(ck) > 0 .and. ck(1:1) /= '-' .and. ck(1:1) /= '=' .and. kx > 0 ) then + rcode=nf90_inq_dimid(ncid, trim(ck), kxid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, ck, kx, kxid), 'wrong in def_dim '//trim(ck), .true.) + endif + if ( len_trim(ct) > 0 .and. ct(1:1) /= '-' .and. ct(1:1) /= '=' .and. tx > 0 ) then + rcode=nf90_inq_dimid(ncid, trim(ct), txid) + if ( rcode /= nf90_noerr ) call nccheck(nf90_def_dim(ncid, ct, tx, txid), 'wrong in def_dim '//trim(ct), .true.) + endif + + !----4.0 check var + rcode=nf90_inq_varid(ncid, varname, varid) + if ( rcode /= nf90_noerr ) then ! need to define the var + if ( tx>0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid,kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid,kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/kxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid,txid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/txid/), varid), 'wrong in def_var '//trim(varname), .true.) + endif + else if ( tx<=0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid,kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid,kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/kxid/), varid), 'wrong in def_var '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid,jxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/ixid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,(/jxid/), varid), 'wrong in def_var '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_def_var(ncid, trim(varname), nf90_real,varid), 'wrong in def_var '//trim(varname), .true.) + endif + endif + !call nccheck(nf90_def_var_deflate(ncid, varid, 1, 1, 4), 'wrong in nf90_def_var_deflate 4', .false.) + call nccheck(nf90_enddef(ncid), 'wrong in nf90_enddef', .false.) + endif + + !----5.0 write data + !call nccheck(nf90_var_par_access(ncid, varid, nf90_collective), 'wrong in nf90_var_par_access '//trim(varname), .false.) + if ( tx>0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni,nj,nk,nt/)), start=(/is,js,ks,ts/), count=(/ni,nj,nk,nt/)), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni, nk,nt/)), start=(/is, ks,ts/), count=(/ni, nk,nt/)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ nj,nk,nt/)), start=(/ js,ks,ts/), count=(/ nj,nk,nt/)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ nk,nt/)), start=(/ ks,ts/), count=(/ nk,nt/)), 'wrong in write '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni,nj, nt/)), start=(/is,js, ts/), count=(/ni,nj, nt/)), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni, nt/)), start=(/is, ts/), count=(/ni, nt/)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ nj, nt/)), start=(/ js, ts/), count=(/ nj, nt/)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ nt/)), start=(/ ts/), count=(/ nt/)), 'wrong in write '//trim(varname), .true.) + endif + else if ( tx<=0 ) then + if ( kx >0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni,nj,nk /)), start=(/is,js,ks /), count=(/ni,nj,nk /)), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni, nk /)), start=(/is, ks /), count=(/ni, nk /)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ nj,nk /)), start=(/ js,ks /), count=(/ nj,nk /)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ nk /)), start=(/ ks /), count=(/ nk /)), 'wrong in write '//trim(varname), .true.) + else if ( kx <= 0 ) then + if ( ix>0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni,nj /)), start=(/is,js /), count=(/ni,nj /)), 'wrong in write '//trim(varname), .true.) + if ( ix>0 .and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ni /)), start=(/is /), count=(/ni /)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0 .and. jx>0 ) call nccheck(nf90_put_var(ncid, varid, reshape(data, (/ nj /)), start=(/ js /), count=(/ nj /)), 'wrong in write '//trim(varname), .true.) + if ( ix<=0.and. jx<=0 ) call nccheck(nf90_put_var(ncid, varid, data), 'wrong in write '//trim(varname), .true.) + endif + endif + + !----6.0 put att + if ( len_trim(units) > 0 .and. units(1:1) /= '=') call nccheck(nf90_put_att(ncid, varid, "units", units), 'wrong in put units', .false.) + if ( len_trim(long_name) > 0 .and. long_name(1:1) /= '=') call nccheck(nf90_put_att(ncid, varid, "long_name",long_name), 'wrong in put long_name', .false.) + call nccheck(nf90_put_att(ncid, nf90_global, "File-type", "HAFS VI pre-file on rot-ll grids derived from HAFS restart files"), 'wrong in put_att', .false.) + call date_and_time(date(1), date(2), date(3), date_time) + call nccheck(nf90_put_att(ncid, nf90_global, "Created_date",date(1)), 'wrong input Created_date', .false.) + + call nccheck(nf90_close(ncid), 'wrong in close '//trim(ncfile), .true.) + + return + end subroutine write_nc_real_par + !======================================================================================== subroutine nccheck(status, states, ifstop) @@ -214,7 +623,7 @@ subroutine nccheck(status, states, ifstop) logical, intent ( in) :: ifstop if (status /= nf90_noerr) then - write(*,*)trim(nf90_strerror(status)), ' '//trim(states) + write(*,'(a,a)')trim(nf90_strerror(status)), ' '//trim(states) if ( ifstop ) stop end if end subroutine nccheck diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tcinfo.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tcinfo.f90 index 0d35eb05d..92014ea65 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tcinfo.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tcinfo.f90 @@ -12,7 +12,7 @@ subroutine get_tc_info(vortex_position_file, tcvital_file, besttrackfile, file_d character (len=300) :: temp integer :: i, j, n real :: xtemp - + !---get info from file center = -9999999.0 if ( len_trim(vortex_position_file) > 1 ) then @@ -32,7 +32,7 @@ subroutine get_tc_info(vortex_position_file, tcvital_file, besttrackfile, file_d call rd_interp_besttrack(time, trim(tcvital_file), center) else if ( len_trim(besttrackfile) > 1 ) then call rd_interp_besttrack(time, trim(besttrackfile), center) - endif + endif endif call check_tc_lon_lat(center(1), center(2)) @@ -71,7 +71,7 @@ subroutine get_tc_info(vortex_position_file, tcvital_file, besttrackfile, file_d write(*,'(a,2f8.2,2x,a)')'---vortex replacement info: ', tc%lon, tc%lat, trim(vortexradius) return - end subroutine get_tc_info + end subroutine get_tc_info !======================================================================================= subroutine check_tc_lon_lat(lat, lon) @@ -87,19 +87,19 @@ subroutine check_tc_lon_lat(lat, lon) endif return - end subroutine check_tc_lon_lat + end subroutine check_tc_lon_lat !======================================================================================= subroutine rd_vortex_position (filename, center ) !----------------------------------------------------------------------------- -! read user-define hurricane track information, i.e., +! read user-define hurricane track information, i.e., ! -86.5 23.8 !----------------------------------------------------------------------------- implicit none character (len=*), intent(in) :: filename - real, dimension(2), intent(out) :: center !lat, lon + real, dimension(2), intent(out) :: center !lat, lon real, dimension(2) :: dat integer :: iost @@ -193,7 +193,7 @@ subroutine rd_interp_besttrack ( times, filename, center ) exit do_get_track_loop else if (diff_hour < dhour(1) ) then nrecord=nrecord+1 - if ( nrecord <= 1 ) then + if ( nrecord <= 1 ) then lat(2) = ilat/10. lon(2) = ilon/10. wsp(2) = awsp @@ -205,7 +205,7 @@ subroutine rd_interp_besttrack ( times, filename, center ) slp(3) = islp*1.0 dhour(3) = diff_hour else - lat(2) = lat(3) + lat(2) = lat(3) lon(2) = lon(3) wsp(2) = wsp(3) slp(2) = slp(3) diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tools.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tools.f90 index d50fc4622..dcaf88b83 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tools.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_tools.f90 @@ -18,7 +18,7 @@ function date2second1970 (yyyy, mm, dd, hh, minute, second) !result(second1970) end function date2second1970 !-----------------------------------------------------------------------+ - function date2second1970_str(cdate) + function date2second1970_str(cdate) implicit none character (len=*),intent(in) :: cdate @@ -27,9 +27,9 @@ function date2second1970_str(cdate) integer :: julian, julian_1970_01_01 integer :: yyyy, mm, dd, hh, minute, second julian_1970_01_01 = 2440588 - + read(cdate,'(i4,5i2)')yyyy, mm, dd, hh, minute, second - + julian = dd -32075 + 1461*(yyyy + 4800 + (mm - 14)/12)/4 + & 367*(mm - 2 - ((mm - 14)/12)*12)/12 - & 3*((yyyy + 4900 + (mm - 14)/12)/100)/4 @@ -268,7 +268,7 @@ subroutine interp_fill_nan_1d(nlen, dat, radius, value_min, value_max) if ( dat(i-j) >= value_min .and. dat(i-j) <= value_max ) then i1 = i - j exit do_search_before - endif + endif enddo do_search_before i2=0 do_search_after: do j = 1, radius @@ -433,12 +433,12 @@ subroutine cal_src_dst_grid_weight(grid_src, grid_dst) return end subroutine cal_src_dst_grid_weight !======================================================================================== -!-----------------------------------------------------------------------+ +!-----------------------------------------------------------------------+ subroutine search_nearst_grid0(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & dst_lat, dst_lon, dst_in_src_x, dst_in_src_y) implicit none - + integer, intent(in) :: src_ix, src_jx, dst_ix, dst_jx real, dimension(src_ix, src_jx), intent(in) :: src_lat, src_lon real, dimension(dst_ix, dst_jx), intent(in) :: dst_lat, dst_lon @@ -468,11 +468,11 @@ subroutine search_nearst_grid0(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, !if( abs(dst_lat(i,j)-src_lat(int(src_ix/2),j1)) > 2.0*out_ave_dy ) cycle do_search_src_grid_y !if( abs(dst_lat(i,j)-src_lat(int(src_ix/2),j1)) > 20.0*out_ave_dy .and. & ! abs(dst_lat(i,j)-src_lat(1,j1)) > 20.0*out_ave_dy .and. & - ! abs(dst_lat(i,j)-src_lat(src_ix,j1)) > 20.0*out_ave_dy ) cycle do_search_src_grid_y + ! abs(dst_lat(i,j)-src_lat(src_ix,j1)) > 20.0*out_ave_dy ) cycle do_search_src_grid_y if ( abs(dst_lat(i,j)-src_lat(int(src_ix/2),j1)) > 2.0*max_dy(j1) ) cycle do_search_src_grid_y do_search_src_grid_x: do i1 = 1, src_ix !if ( abs(dst_lon(i,j)-src_lon(i1,j1)) > 1.0*out_ave_dx ) cycle do_search_src_grid_x - if ( abs(dst_lon(i,j)-src_lon(i1,j1)) > max_dx(i1) ) cycle do_search_src_grid_x + if ( abs(dst_lon(i,j)-src_lon(i1,j1)) > max_dx(i1) ) cycle do_search_src_grid_x dis=(dst_lon(i,j)-src_lon(i1,j1))**2.0+(dst_lat(i,j)-src_lat(i1,j1))**2.0 if ( dis <= dis0 ) then dis0 = dis @@ -530,7 +530,7 @@ subroutine search_nearst_grid(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, max_lon = int((max_lon+0.5)*10)/10.0 min_lat = int(min_lat*10)/10.0 max_lat = int((max_lat+0.5)*10)/10.0 - + ll_ix = int((max_lon - min_lon)/d_ll) + 1 ll_jx = int((max_lat - min_lat)/d_ll) + 1 write(*,'(a,f,i )')'ll bin size d_ll and max_points:', d_ll, max_points @@ -544,21 +544,23 @@ subroutine search_nearst_grid(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, enddo do j = 1, ll_jx ll_lat(j) = min_lat + (j-1)*d_ll - enddo + enddo write(*,'(a,f10.3,a,f10.3,a,f10.3,a,f10.3)')'search grids: ', ll_lon(1),'-->',ll_lon(ll_ix),' : ', ll_lat(1), '-->', ll_lat(ll_jx) !---sign src grids to search bins allocate ( src_points(ll_ix,ll_jx)) allocate ( src_points_lon(ll_ix,ll_jx,max_points), src_points_lat(ll_ix,ll_jx,max_points)) src_points=0 - + !--- may need halo write(*,'(a)')'---sign src to ll grids' + !$omp parallel do & + !$omp& private(i,j) do j = 1, src_jx; do i = 1, src_ix i1 = int((src_lon(i,j) - ll_lon(1))/d_ll) + 1 j1 = int((src_lat(i,j) - ll_lat(1))/d_ll) + 1 do i2 = -1, 1; do j2 = -1, 1; !add halo - i3=i1+i2; j3=j1+j2 + i3=i1+i2; j3=j1+j2 if ( i3 >= 1 .and. i3 <= ll_ix .and. j3 >= 1 .and. j3 <= ll_jx ) then if ( src_points(i3,j3) < max_points ) then src_in_bin=.false. @@ -580,13 +582,15 @@ subroutine search_nearst_grid(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, write(*,'(a,6i6,2f10.3)') 'WARNING: src_points(i3,j3) >= max_points at i3, j3, i, j, src_lon(i,j), src_lat(i,j)', & src_points(i3,j3), max_points, i3, j3, i, j, src_lon(i,j), src_lat(i,j) endif - !---may need add halo: + !---may need add halo: endif enddo; enddo enddo; enddo !---search nearest src grid for each dst grid write(*,'(a)')'---search nearest src grid for each dst grid' + !$omp parallel do & + !$omp& private(i,j) do j = 1, dst_jx; do i = 1, dst_ix !---calculate dst grid position in search-bin i1 = int((dst_lon(i,j) - ll_lon(1))/d_ll) + 1 @@ -617,7 +621,7 @@ subroutine search_nearst_grid(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, enddo else dst_in_src_x(i,j)=-99 - dst_in_src_y(i,j)=-99 + dst_in_src_y(i,j)=-99 endif enddo; enddo @@ -626,7 +630,7 @@ subroutine search_nearst_grid(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, write(*,'(a)')'---search_nearst_grid finished' return - end subroutine search_nearst_grid + end subroutine search_nearst_grid !-----------------------------------------------------------------------+ subroutine cal_grid_weight(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & @@ -643,6 +647,8 @@ subroutine cal_grid_weight(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & integer :: i, j, k, n, i1, j1, ixs, jxs, ixi, jxi, min_ij_src, min_ij_dst real :: dst_weight, earth_dist, dis, lon180_1, lon180_2 + !$omp parallel do & + !$omp& private(i,j) do j = 1,dst_jx; do i = 1,dst_ix ixs=dst_in_src_x(i,j) !the position in src grids jxs=dst_in_src_y(i,j) @@ -660,7 +666,7 @@ subroutine cal_grid_weight(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & if ( ixi > src_ix ) ixi=src_ix-2 if ( jxi < 1 ) jxi=3 if ( jxi > src_jx ) jxi=src_jx-2 - if ( ixi >= 1 .and. ixi <= src_ix .and. jxi >= 1 .and. jxi <= src_jx ) then + if ( ixi >= 1 .and. ixi <= src_ix .and. jxi >= 1 .and. jxi <= src_jx .and. n < max_points) then n=n+1 gw(i,j)%src_x(n)=ixi gw(i,j)%src_y(n)=jxi @@ -700,7 +706,7 @@ subroutine cal_grid_weight(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & gw(i,j)%dst_points=0 dst_weight=0.0 allocate(gw(i,j)%dst_x(max_points), gw(i,j)%dst_y(max_points), gw(i,j)%dst_weight(max_points)) - + !if ( ixs > 1 .and. ixs < src_ix .and. jxs > 1 .and. jxs < src_jx ) then ! !---when the grid is inside of src-domain, no dst grid is needed ! !dst_weight=0.0 @@ -748,9 +754,9 @@ subroutine cal_grid_weight(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & dst_weight=0.0 if ( gwt%relaxzone < 0 ) gwt%relaxzone = min(30, int(min(src_ix, src_jx, dst_ix, dst_jx)/10)) !--- find relaxzone: min (i,j) or max (i,j) grids to src (1,1) and src(ix,jx) - ! ixs, jxs - min_ij_src = min(ixs, jxs, src_ix-ixs, src_jx-jxs) ! shortest distance (grid not earth-distance) from SRC domain edge - min_ij_dst = min(i, j, dst_ix-i, dst_jx-j) + ! ixs, jxs + min_ij_src = min(ixs, jxs, src_ix-ixs, src_jx-jxs) ! shortest distance (grid not earth-distance) from SRC domain edge + min_ij_dst = min(i, j, dst_ix-i, dst_jx-j) if ( min_ij_src <= gwt%relaxzone .and. min_ij_dst > 2 .and. gwt%relaxzone > 0 ) then dst_weight = real(gwt%relaxzone - min_ij_src)/real(gwt%relaxzone) if ( dst_weight < 0.0 .or. dst_weight > 1.0 ) then @@ -764,32 +770,33 @@ subroutine cal_grid_weight(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & !--- find TC vortex relax zone if ( tc%vortexrep==1 .and. tc%lat>-85. .and. tc%lat<85. .and. tc%lon>=-180. .and. tc%lon<=360. ) then - lon180_1=src_lon(ixs,jxs) - if ( lon180_1 > 180. ) lon180_1 = lon180_1 -360. - lon180_2=tc%lon - if ( lon180_2 > 180. ) lon180_2 = lon180_2 - 360. - dis = earth_dist(lon180_1,src_lat(ixs,jxs),lon180_2,tc%lat)/1000. - - if ( abs(tc%vortexreplace_r(1)-tc%vortexreplace_r(2)) < 1.0 .or. tc%vortexreplace_r(1) < 1.0 .or. tc%vortexreplace_r(2) < 1.0 ) then - tc%vortexreplace_r(1)=600. - tc%vortexreplace_r(2)=900. - endif - if ( dis < tc%vortexreplace_r(1) ) then - dst_weight=0.0 - else if ( dis > tc%vortexreplace_r(2) ) then - dst_weight=1.0 + if ( ixs>=1 .and. ixs<=src_ix .and. jxs>=1 .and. jxs<=src_jx) then + lon180_1=src_lon(ixs,jxs) + if ( lon180_1 > 180. ) lon180_1 = lon180_1 -360. + lon180_2=tc%lon + if ( lon180_2 > 180. ) lon180_2 = lon180_2 - 360. + dis = earth_dist(lon180_1,src_lat(ixs,jxs),lon180_2,tc%lat)/1000. + + if ( abs(tc%vortexreplace_r(1)-tc%vortexreplace_r(2)) < 1.0 .or. tc%vortexreplace_r(1) < 1.0 .or. tc%vortexreplace_r(2) < 1.0 ) then + tc%vortexreplace_r(1)=600. + tc%vortexreplace_r(2)=900. + endif + if ( dis < tc%vortexreplace_r(1) ) then + dst_weight=0.0 + else if ( dis > tc%vortexreplace_r(2) ) then + dst_weight=1.0 + else + dst_weight=(dis-tc%vortexreplace_r(1))/(tc%vortexreplace_r(2)-tc%vortexreplace_r(1)) + endif + !write(*,*)'----tc zone', tc%lon, tc%lat, dis, tc%vortexreplace_r(1:2), dst_weight + if ( dst_weight < 0.0 .or. dst_weight > 1.0 ) then + write(*,'(a,4i6,4f10.2)')'---vortex dst_weight:', i,j,ixs,jxs,tc%vortexreplace_r(1:2), dis, dst_weight + stop + endif else - dst_weight=(dis-tc%vortexreplace_r(1))/(tc%vortexreplace_r(2)-tc%vortexreplace_r(1)) - endif - !write(*,*)'----tc zone', tc%lon, tc%lat, dis, tc%vortexreplace_r(1:2), dst_weight - if ( dst_weight < 0.0 .or. dst_weight > 1.0 ) then - write(*,'(a,4i6,4f10.2)')'---vortex dst_weight:', i,j,ixs,jxs,tc%vortexreplace_r(1:2), dis, dst_weight - stop + dst_weight=1.0 endif - !else - ! write(*,*)'----tc zone', tc%lon, tc%lat, dis, tc%vortexreplace_r(1:2), dst_weight - ! stop - endif + endif !---combine src and dst weight if ( gw(i,j)%src_points > 0 ) then @@ -800,7 +807,7 @@ subroutine cal_grid_weight(src_ix, src_jx, src_lat, src_lon, dst_ix, dst_jx, & endif enddo; enddo - + return end subroutine cal_grid_weight @@ -821,11 +828,13 @@ subroutine combine_grids_for_remap(ixi, jxi, kxi, txi, fdat_src, ixo, jxo, kxo, integer :: i, j, k, n, i1, j1, k1, n1, ncount + !$omp parallel do & + !$omp& private(i,j,k,n) do n = 1, txo; do k = 1, kxo; do j = 1, jxo; do i = 1, ixo fdat_out(i,j,k,n)=0.0 ncount=0 if ( gw(i,j)%src_points > 0 ) then - do_src_points_loop: do n1 = 1, gw(i,j)%src_points + do_src_points_loop: do n1 = 1, gw(i,j)%src_points i1=gw(i,j)%src_x(n1) j1=gw(i,j)%src_y(n1) if ( i1 < 1 .or. i1 > ixi .or. j1 < 1 .or. j1 > jxi ) cycle do_src_points_loop @@ -852,20 +861,20 @@ subroutine combine_grids_for_remap(ixi, jxi, kxi, txi, fdat_src, ixo, jxo, kxo, !if ( (i == int(ixo/4) .or. i == int(ixo/2) .or. i == ixo-1) .and. & ! (j == int(jxo/4) .or. j == int(jxo/2) .or. j == jxo-1) .and. k==1 .and. n==1 ) then if ( i == int(ixo/2) .and.j == int(jxo/2) .and. k==1 .and. n==1 ) then - write(*,'(a, 5i10)')'--combine_grids_for_remap: ',i,j, gw(i,j)%src_points, gw(i,j)%dst_points, ncount - write(*,'(a, 90i10)')'-- src_points: ', ((gw(i,j)%src_x(n1), gw(i,j)%src_y(n1)),n1=1,gw(i,j)%src_points) - write(*,'(a,90f)') '-- src_weight: ', ((gw(i,j)%src_weight(n1)),n1=1,gw(i,j)%src_points) + if (debug_level>20) write(*,'(a, 5i10)')'--combine_grids_for_remap: ',i,j, gw(i,j)%src_points, gw(i,j)%dst_points, ncount + if (debug_level>20) write(*,'(a, 90i10)')'-- src_points: ', ((gw(i,j)%src_x(n1), gw(i,j)%src_y(n1)),n1=1,gw(i,j)%src_points) + if (debug_level>20) write(*,'(a,90f)') '-- src_weight: ', ((gw(i,j)%src_weight(n1)),n1=1,gw(i,j)%src_points) write(*,'(a,90f)') '-- src_values: ', ( fdat_src(gw(i,j)%src_x(n1),gw(i,j)%src_y(n1),k,n),n1=1,gw(i,j)%src_points) if ( gw(i,j)%dst_points > 0 ) then - write(*,'(a, 90i10)')'-- dst_points: ', ((gw(i,j)%dst_x(n1), gw(i,j)%dst_y(n1)),n1=1,gw(i,j)%dst_points) - write(*,'(a,90f10.4)')'-- dst_weight: ', ((gw(i,j)%dst_weight(n1)),n1=1,gw(i,j)%dst_points) - write(*,'(a, e)') '-- dst_values: ', ( fdat_dst(gw(i,j)%dst_x(n1),gw(i,j)%dst_y(n1),k,n),n1=1,gw(i,j)%dst_points) + if (debug_level>20) write(*,'(a, 90i13)')'-- dst_points: ', ((gw(i,j)%dst_x(n1), gw(i,j)%dst_y(n1)),n1=1,gw(i,j)%dst_points) + if (debug_level>20) write(*,'(a,90f13.4)')'-- dst_weight: ', ((gw(i,j)%dst_weight(n1)),n1=1,gw(i,j)%dst_points) + write(*,'(a,90f13.4)') '-- dst_values: ', ( fdat_dst(gw(i,j)%dst_x(n1),gw(i,j)%dst_y(n1),k,n),n1=1,gw(i,j)%dst_points) else write(*,'(a)') '-- no dst point' endif - write(*,'(a, f)') '-- remaped value: ', fdat_out(i,j,k,n) - endif - + write(*,'(a,f13.4)') '-- remaped value: ', fdat_out(i,j,k,n) + endif + enddo; enddo; enddo; enddo return @@ -888,6 +897,8 @@ subroutine combine_grids_for_merge(ixi, jxi, kxi, txi, fdat_src, ixo, jxo, kxo, integer :: i, j, k, n, i1, j1, k1, n1, ncount + !$omp parallel do & + !$omp& private(i,j,k,n) do n = 1, txo; do k = 1, kxo; do j = 1, jxo; do i = 1, ixo fdat_out(i,j,k,n)=0.0 ncount=0 @@ -941,7 +952,7 @@ subroutine combine_grids_for_merge(ixi, jxi, kxi, txi, fdat_src, ixo, jxo, kxo, return end subroutine combine_grids_for_merge -!-----------------------------------------------------------------------+ +!-----------------------------------------------------------------------+ function uppercase (cs) implicit none @@ -969,7 +980,7 @@ function uppercase (cs) endif end function uppercase -!-----------------------------------------------------------------------+ +!-----------------------------------------------------------------------+ function lowercase (cs) implicit none @@ -996,5 +1007,5 @@ function lowercase (cs) !#endif endif end function lowercase - -!-----------------------------------------------------------------------+ + +!-----------------------------------------------------------------------+ diff --git a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_wind_process.f90 b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_wind_process.f90 index 94ccbfb15..97f1faeff 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_datool/sub_wind_process.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_datool/sub_wind_process.f90 @@ -9,14 +9,14 @@ subroutine cal_uv_coeff_fv3(nx, ny, grid_lat, grid_lon, cangu, sangu, cangv, san implicit none integer, intent(in) :: nx, ny - real,dimension(nx+1,ny+1), intent(in) :: grid_lat, grid_lon ! FV3 + real,dimension(nx+1,ny+1), intent(in) :: grid_lat, grid_lon ! FV3 ! real, allocatable, dimension(:,:), intent(out) :: cangu, sangu, cangv, sangv real, dimension(nx,ny+1), intent(out) :: cangu, sangu - real, dimension(nx+1,ny), intent(out) :: cangv, sangv + real, dimension(nx+1,ny), intent(out) :: cangv, sangv real, allocatable, dimension(:,:) :: x, y, z integer :: i, j - real :: sq180, rlat, diff, rlon, xr, yr, zr, xu, yu, zu, uval, ewval, nsval, xv, yv, zv, vval + real :: sq180, rlat, diff, rlon, xr, yr, zr, xu, yu, zu, uval, ewval, nsval, xv, yv, zv, vval !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -28,6 +28,8 @@ subroutine cal_uv_coeff_fv3(nx, ny, grid_lat, grid_lon, cangu, sangu, cangv, san ! 1. compute x,y,z at cell cornor from grid_lon, grid_lat allocate( x(nx+1,ny+1), y(nx+1,ny+1), z(nx+1,ny+1) ) + !$omp parallel do & + !$omp& private(i,j) do j=1,ny+1 do i=1,nx+1 x(i,j)=cos(grid_lat(i,j)*deg2rad)*cos(grid_lon(i,j)*deg2rad) @@ -38,6 +40,8 @@ subroutine cal_uv_coeff_fv3(nx, ny, grid_lat, grid_lon, cangu, sangu, cangv, san ! 2 find angles to E-W and N-S for U edges sq180=180.**2 + !$omp parallel do & + !$omp& private(i,j,rlat,rlon,xr,yr,zr,xu,yu,zu) do j=1,ny+1 do i=1,nx ! center lat/lon of the edge @@ -66,6 +70,8 @@ subroutine cal_uv_coeff_fv3(nx, ny, grid_lat, grid_lon, cangu, sangu, cangv, san enddo ! 3 find angles to E-W and N-S for V edges + !$omp parallel do & + !$omp& private(i,j,rlat,rlon,xr,yr,zr,xu,yu,zu) do j=1,ny do i=1,nx+1 rlat=0.50*(grid_lat(i,j)+grid_lat(i,j+1)) @@ -93,7 +99,7 @@ subroutine cal_uv_coeff_fv3(nx, ny, grid_lat, grid_lon, cangu, sangu, cangv, san deallocate(x, y, z) return - end subroutine cal_uv_coeff_fv3 + end subroutine cal_uv_coeff_fv3 !======================================================================================== subroutine earthuv2fv3(nx, ny, u, v, cangu, sangu, cangv, sangv, u_out, v_out) !$$$ subprogram documentation block @@ -109,7 +115,7 @@ subroutine earthuv2fv3(nx, ny, u, v, cangu, sangu, cangv, sangv, u_out, v_out) ! input argument list: ! nx,ny - dimensions ! u,v - earth wind components at center of the cell -! cangu, sangu, cangv, sangv +! cangu, sangu, cangv, sangv ! ! output argument list: ! u_out,v_out - output fv3 winds on the cell boundaries @@ -158,12 +164,12 @@ subroutine earthuv2fv3(nx, ny, u, v, cangu, sangu, cangv, sangv, u_out, v_out) j1=min(j,ny) u_out(i,j)= u(i,j)*cangu(i,j)+v(i,j1)*sangu(i,j) enddo; enddo - + do j = 1, ny; do i = 1, nx+1 i1=min(i,nx) v_out(i,j)=u(i1,j)*cangv(i,j)+v(i,j)*sangv(i,j) enddo; enddo - + return end subroutine earthuv2fv3 !======================================================================================== diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/anl_bogus.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/anl_bogus.f90 index 0a0edfc97..68ddcf305 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/anl_bogus.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/anl_bogus.f90 @@ -8,7 +8,21 @@ ! ! DECLARE VARIABLES ! - INTEGER I,J,K,NX,NY,NZ,ICH + IMPLICIT NONE + INTEGER I,J,K,L,M,N,NX,NY,NZ,NX1,NY1,NZ1,NZ2,JX,JY,KMX,ICH + integer NST,IT,ID,JD,IR,IR1,ITIM,IUNIT,I360,IM1,JM1,JX1,IMV,JMV + integer ictr,jctr,imn1,imx1,jmn1,jmx1,KST,imax1,jmax1,iter,ics + integer id_storm,ICLAT,ICLON,Ipsfc,Ipcls,Irmax,ivobs,Ir_vobs + integer i_psm,j_psm,ix2,jx2 + real GAMMA,G,Rd,D608,Cp,COEF1,COEF2,COEF3,GRD,TV1,ZSF1,PSF1,A,DP_CT + real pi,pi_deg,pi180,rad,arad,SLP1_MEAN,SUM11,SLP_AVE,SLP_SUM,SLP_MIN + real vobs,vobs_o,VRmax,psfc_obs,psfc_cls,PRMAX,Rctp,cost,dp_obs,z0 + real delt_z1,vobs_kt,distm,distt,vt_c,vt_n,vd_c,pt_c,sum1,dist1 + real psfc_env,psfc_obs1,RMN,d_max,vmax1,vmax2,vmax_s,crtn,RMX_d + real beta,beta1,VMAX,UUT,VVT,UU11,VV11,UUM1,VVM1,QQ,FF,R_DIST,uv22 + real v_min,PS_C1,fact,TEK1,TEK2,ESRR,ps_min,T_OLD,Q_OLD,ZSFC,TSFC + real QENV1,W,W1,Q1_GFS,DTX,DTY,DDR,DDS,TENV1,XLAT,XLON + ! PARAMETER (NST=5,IR=200) ! PARAMETER (NX=158,NY=329,NZ=42,NST=5) @@ -105,16 +119,21 @@ integer Ir_v4(4) CHARACTER SN*1,EW*1,DEPTH*1 + CHARACTER*2 basin - DATA PW_S/42*1.0,0.95,0.9,0.85,0.8,0.75,0.7, & - 0.65,0.6,0.55,0.5,0.45,0.4,0.35,0.3, & - 0.25,0.2,0.15,0.1,0.05,60*0./ ! 850-700mb +!using DATA PW_S/42*1.0,0.95,0.9,0.85,0.8,0.75,0.7, & +!using 0.65,0.6,0.55,0.5,0.45,0.4,0.35,0.3, & +!using 0.25,0.2,0.15,0.1,0.05,60*0./ ! 850-700mb + PW_S(1:42)=1.0 + PW_S(43:61)=(/0.95,0.9,0.85,0.8,0.75,0.7,0.65,0.6,0.55, & + 0.5,0.45,0.4,0.35,0.3,0.25,0.2,0.15,0.1,0.05/) + +!using DATA PW_M/121*1.0/ + PW_M(1:121)=1.0 - DATA PW_M/121*1.0/ ! DATA PW_M/40*1.0,0.95,0.9,0.8,0.7, & ! 0.6,0.5,0.4,0.3,0.2,0.1,35*0./ ! 850-300mb !zhang: added basin domain shift option - CHARACTER*2 basin print*,'this is cold start' @@ -666,7 +685,7 @@ iter=0 beta=1.0 - 876 CONTINUE +! 876 CONTINUE VMAX=0. DO J=1,NY @@ -932,11 +951,12 @@ W=(ALOG(1.*PMID1(I,J,N))-ALOG(1.*PCST1(I,J,K)))/W1 T1(I,J,N)=TENV1+WRK1(K)*(1.-W)+WRK1(K+1)*W Q1(I,J,N)=QENV1+WRK2(K)*(1.-W)+WRK2(K+1)*W - GO TO 887 +! GO TO 887 + exit !shin END IF END DO END IF - 887 CONTINUE +! 887 CONTINUE T_OLD = T4(I,J,N) Q_OLD = Q4(I,J,N) @@ -1069,11 +1089,12 @@ W=(ALOG(1.*PMV1(I,J,N))-ALOG(1.*PCST2(K)))/W1 U1(I,J,N)=U1(I,J,N)+WRK1(K)*(1.-W)+WRK1(K+1)*W V1(I,J,N)=V1(I,J,N)+WRK2(K)*(1.-W)+WRK2(K+1)*W - GO TO 888 +! GO TO 888 + exit !shin END IF END DO END IF - 888 CONTINUE +! 888 CONTINUE END DO ENDDO ENDDO @@ -1196,12 +1217,18 @@ end subroutine dbend SUBROUTINE FIND_NEWCT1(IX,JX,UD,VD,GLON2,GLAT2, & CLON_NEW1,CLAT_NEW1) + IMPLICIT NONE + integer I,J,JL,IX,JX,IL,KL,IR,IT,ID,JD,NIC,NJC,ix2,jx2,i1,j1 + real DTX,DTY,DDS,TENV1,PI,RAD,ddr,pi180,cost,u1,v1,sum1,dist,dist1 + real XLAT,XLON,BLON,BLAT,WTS,DR,DD,DLON,DLAT,TLON,TLAT,UT,VT,WT,TX + real clat_new,RRX,TTX ! PARAMETER (IR=100,IT=24,IX=254,JX=254) PARAMETER (IR=30,IT=24) PARAMETER (ID=61,JD=61,DTX=0.05,DTY=0.05) ! Search x-Domain (ID-1)*DTX REAL (4) UD(IX,JX),VD(IX,JX),GLON2(IX,JX),GLAT2(IX,JX) ! DIMENSION RWM(IR+1),TWM(IR+1) - DIMENSION TNMX(ID,JD),RX(ID,JD),WTM(IR) +! DIMENSION TNMX(ID,JD),RX(ID,JD),WTM(IR) + REAL (4) TNMX(ID,JD),RX(ID,JD),WTM(IR) !shin REAL (8) CLON_NEW1,CLAT_NEW1 PI=ASIN(1.)*2. @@ -1238,9 +1265,9 @@ SUBROUTINE FIND_NEWCT1(IX,JX,UD,VD,GLON2,GLAT2, & !.. CALCULATE TANGENTIAL WIND EVERY 0.2 deg INTERVAL !.. 10*10 deg AROUND 1ST GUESS VORTEX CENTER - DO 10 JL=1,IR + do JL=1,IR ! do loop for JL WTS= 0. - DO 20 IL=1,IT + do IL=1,IT ! do loop for IL DR = JL*ddr ! DR = JL DD = (IL-1)*15*RAD @@ -1272,9 +1299,9 @@ SUBROUTINE FIND_NEWCT1(IX,JX,UD,VD,GLON2,GLAT2, & !C.. TANGENTIAL WIND WT = -SIN(DD)*UT + COS(DD)*VT WTS = WTS+WT -20 CONTINUE + enddo ! do loop for IL WTM(JL) = WTS/24. -10 CONTINUE + enddo ! do loop for JL !C Southern Hemisphere IF(CLAT_NEW.LT.0)THEN diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/convert_axi_xy.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/convert_axi_xy.f90 index a2b3461e7..05ff99cc1 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/convert_axi_xy.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/convert_axi_xy.f90 @@ -14,7 +14,13 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & ! ! All variables have the same vertical dimension (KMAX=121). ! - INTEGER I,J,K,NX,NY,NZ,ICH + IMPLICIT NONE + INTEGER I,J,K,N,NX,NY,NZ,KMAX,KMX + integer NST,IR,IR1,NHCT,II1,JJ1,iparam,icut1,icut2 + real GAMMA,G,Rd,D608,Cp,eps6,pi,pi180,arad,deg2m,cost,zmax,vobs,cost_old + real count_smth,TWMAX,twsum,RWMAX,Rmax_0,fact,fact1,fact_v,vrmax,FC1,FC2,DFC + real density,sum_vt,sum_vt2,th_m,xxx,yyy,rmw1,rmw2,dp_obs,roc1,roc2,cut_off + real aaa,bbb,ddd,RMN,RMN1,RMN2,prmax,DIF,DTX,DTY,DTR,RIJ_m,PIJ_m ! PARAMETER (NST=5) ! PARAMETER (NX=420,NY=820,NZ=42) !* E-grid dimensions @@ -36,10 +42,14 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & REAL(8) CLON_NHC,CLAT_NHC !* storm lon, lat REAL(8) delc,thac !* vortex lon, lat - DIMENSION rp(IR1),ps(IR),ps1(IR),ps2(IR),ps_1mb(IR) - DIMENSION q(KMAX),p(KMAX,IR) !* pressure on sigma-levels (q) - DIMENSION t(KMAX,IR),r(KMAX,IR),ur(KMAX,IR1),th(KMAX,IR1) - DIMENSION vrad(KMAX),vtan(KMAX) !^ bogus vortex +! DIMENSION rp(IR1),ps(IR),ps1(IR),ps2(IR),ps_1mb(IR) +! DIMENSION q(KMAX),p(KMAX,IR) !* pressure on sigma-levels (q) +! DIMENSION t(KMAX,IR),r(KMAX,IR),ur(KMAX,IR1),th(KMAX,IR1) +! DIMENSION vrad(KMAX),vtan(KMAX) !^ bogus vortex + real(4) rp(IR1),ps(IR),ps1(IR),ps2(IR),ps_1mb(IR) !shin + real(4) q(KMAX),p(KMAX,IR) !* pressure on sigma-levels (q) shin + real(4) t(KMAX,IR),r(KMAX,IR),ur(KMAX,IR1),th(KMAX,IR1) !shin + real(4) vrad(KMAX),vtan(KMAX) !^ bogus vortex shin REAL(4), ALLOCATABLE :: RIJ1(:,:),RIJ2(:,:) REAL(4), ALLOCATABLE :: W1(:,:),W2(:,:) @@ -54,7 +64,8 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & REAL(4) U_2SB(IR1,KMAX),T_2SB(IR1,KMAX),SLP_2SB(IR1) REAL(4) V_2SB(IR1,KMAX),R_2SB(IR1,KMAX) !* sigma-level - DIMENSION RF(24) +! DIMENSION RF(24) + real(4) RF(24) !shin CHARACTER DEPTH*1 CHARACTER SN*1,EW*1 @@ -147,7 +158,8 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & count_smth=0. - 999 continue !* smooth vortex for large & weak storm <--------------- +! 999 continue !* smooth vortex for large & weak storm <--------------- + do !* smooth vortex for large & weak storm MORE than 250 shin TWMAX=1.e-6 do i=1,IR @@ -206,62 +218,66 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & end do END DO count_smth=count_smth+1 - IF (count_smth.LE.250.) go to 999 !* ------------------------> +! IF (count_smth.LE.250.) go to 999 !* ------------------------> + IF (count_smth.gt.250.) exit !*---> smoothing should be less than 250 shin + ELSE ! shin + exit !if we don't satisfy the above IF (smooth) statement exit! END IF - print*,'count_smth=',count_smth !* =============================== - - go to 557 - - 556 continue !* UNUSED code for homogenizing ROCI with RMW <- - - - - - - pres_ct=dp_obs/ps(1) - do i=1,IR - ps_1mb(i)=ps(i)*pres_ct - end do - - IRAD_1=1 - do i=1,IR - if (abs(ps_1mb(i)).GT.100.) then - IRAD_1=I - end if - end do + enddo ! do loop end for smooth vortex - RAD_1=(IRAD_1+0.5)*(rp(2)-rp(1))*1.E-3 - fact_p=PRMAX/RAD_1 !* alfa=ROCI*/ROCI - -! fact_p=0.5*(fact_p+fact_v) - fact_p=fact_v - - print*,'fact,fact_p=',fact,fact_p,PRMAX,RAD_1 - - IF (fact .LT. fact_p) THEN !* smooth => fact_p = fact_v - wrk1(1)=(2.*ps(1)+ps(2))/3. - wrk1(IR)=0. - do i=2,IR-1 - wrk1(i)=(ps(i-1)+ps(i)+ps(i+1))/3. - end do - do i=1,IR - ps(i)=wrk1(i) - end do - do k=1,kmax - wrk3(1)=(2.*t(k,1)+t(k,2))/3. - wrk3(IR)=0. - wrk4(1)=(2.*r(k,1)+r(k,2))/3. - wrk4(IR)=0. - do i=2,IR-1 - wrk3(i)=(t(k,i-1)+t(k,i)+t(k,i+1))/3. - wrk4(i)=(r(k,i-1)+r(k,i)+r(k,i+1))/3. - end do - do i=1,IR - t(k,i)=wrk3(i) - r(k,i)=wrk4(i) - end do - end do - go to 556 !* - - - - - - - - - - - - - - - - - - - - - - - - -> - END IF + print*,'count_smth=',count_smth !* =============================== - 557 continue +! go to 557 +! 556 continue !* UNUSED code for homogenizing ROCI with RMW <- - - - - +! shin: UNUSED part between 557/556 continue~goto 556/557 were commented +! pres_ct=dp_obs/ps(1) +! do i=1,IR +! ps_1mb(i)=ps(i)*pres_ct +! end do +! +! IRAD_1=1 +! do i=1,IR +! if (abs(ps_1mb(i)).GT.100.) then +! IRAD_1=I +! end if +! end do +! +! RAD_1=(IRAD_1+0.5)*(rp(2)-rp(1))*1.E-3 +! fact_p=PRMAX/RAD_1 !* alfa=ROCI*/ROCI +! +!!!# fact_p=0.5*(fact_p+fact_v) +! fact_p=fact_v +! +! print*,'fact,fact_p=',fact,fact_p,PRMAX,RAD_1 +! +! IF (fact .LT. fact_p) THEN !* smooth => fact_p = fact_v +! wrk1(1)=(2.*ps(1)+ps(2))/3. +! wrk1(IR)=0. +! do i=2,IR-1 +! wrk1(i)=(ps(i-1)+ps(i)+ps(i+1))/3. +! end do +! do i=1,IR +! ps(i)=wrk1(i) +! end do +! do k=1,kmax +! wrk3(1)=(2.*t(k,1)+t(k,2))/3. +! wrk3(IR)=0. +! wrk4(1)=(2.*r(k,1)+r(k,2))/3. +! wrk4(IR)=0. +! do i=2,IR-1 +! wrk3(i)=(t(k,i-1)+t(k,i)+t(k,i+1))/3. +! wrk4(i)=(r(k,i-1)+r(k,i)+r(k,i+1))/3. +! end do +! do i=1,IR +! t(k,i)=wrk3(i) +! r(k,i)=wrk4(i) +! end do +! end do +! go to 556 !* - - - - - - - - - - - - - - - - - - - - - - - - -> +! END IF +! +! 557 continue !* 50% contraint for bogus vortex stretch !* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -413,31 +429,32 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & end if end do - go to 777 !* UNUSED cutoff beyond RMN2 - - - - - - - - - - - - do i=1,icut1-1 - ps(i)= ps(i)- ps(icut1)+ ps(IR) - ps1(i)=ps1(i)-ps1(icut1)+ps1(IR) - do k=1,kmax - ur(k,i)=ur(k,i)-ur(k,icut1)+ur(k,IR) - th(k,i)=th(k,i)-th(k,icut1)+th(k,IR) - t(k,i)=t(k,i)-t(k,icut1)+t(k,IR) - r(k,i)=max(0.,r(k,i)-r(k,icut1))+r(k,IR) - end do - end do - - do i=icut1,IR - ps(i)= ps(IR) - ps1(i)=ps1(IR) - do k=1,kmax - ur(k,i)=ur(k,IR) - th(k,i)=th(k,IR) - t(k,i)=t(k,IR) - r(k,i)=r(k,IR) - end do - end do - - 777 continue !* - - - - - - - - - - - - - - - - - - - - - - - +! go to 777 !* UNUSED cutoff beyond RMN2 - - - - - - - - - - +! shin: UNUSED part between go to 777~777 CONTINUE were commented +! +! do i=1,icut1-1 +! ps(i)= ps(i)- ps(icut1)+ ps(IR) +! ps1(i)=ps1(i)-ps1(icut1)+ps1(IR) +! do k=1,kmax +! ur(k,i)=ur(k,i)-ur(k,icut1)+ur(k,IR) +! th(k,i)=th(k,i)-th(k,icut1)+th(k,IR) +! t(k,i)=t(k,i)-t(k,icut1)+t(k,IR) +! r(k,i)=max(0.,r(k,i)-r(k,icut1))+r(k,IR) +! end do +! end do +! +! do i=icut1,IR +! ps(i)= ps(IR) +! ps1(i)=ps1(IR) +! do k=1,kmax +! ur(k,i)=ur(k,IR) +! th(k,i)=th(k,IR) +! t(k,i)=t(k,IR) +! r(k,i)=r(k,IR) +! end do +! end do +! +! 777 continue !* - - - - - - - - - - - - - - - - - - - - - - - icut2=icut1+1.5*arad/(rp1(2)-rp1(1)) !* icut2 -> RMN2+3' @@ -516,78 +533,78 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & end do SLP_2SB(IR1)=0 - go to 799 !* UNUSED p-to-sigma correction ------------------------ - - DO I=1,IR - DO N=1,KMAX - work1(N)=t(N,I)+temp_e(N) !* total temperature - END DO - DO K=1,kmax - IF (p(k,i).GE.pcst(1)) THEN - U_2SB(i,k)=th(1,i) - V_2SB(i,k)=ur(1,i) - T_2SB(i,k)=work1(1) - R_2SB(i,k)=r(1,i) - ELSEIF (p(k,i).LE.pcst(kmax)) THEN - U_2SB(i,k)=th(kmax,i) - V_2SB(i,k)=ur(kmax,i) - T_2SB(i,k)=work1(kmax) - R_2SB(i,k)=r(kmax,i) - ELSE !* p-to-sigma interpolation - DO N=1,kmax - if ( p(k,i).LE.pcst(N) .AND. p(k,i).GT.pcst(N+1) ) then - WT1=ALOG(1.*pcst(N+1))-ALOG(1.*pcst(N)) - WT2=(ALOG(1.*p(k,i))-ALOG(1.*pcst(N)))/WT1 - WT3=1.-WT2 - U_2SB(i,k)=WT3*th(N,i)+WT2*th(N+1,i) - V_2SB(i,k)=WT3*ur(N,i)+WT2*ur(N+1,i) - T_2SB(i,k)=WT3*work1(N)+WT2*work1(N+1) - R_2SB(i,k)=WT3*r(N,i)+WT2*r(N+1,i) - GOTO 870 - endif - ENDDO - 870 continue - ENDIF - END DO - END DO - - TSUM1=0. - TSUM2=0. - - DO I=1,IR - DO K=1,KMAX - TEK1=temp_e(K)+t(k,i) !* total temperature - TEK2=T_2SB(i,k) - ESRR=exp(4302.645*(TEK2-TEK1)/((TEK2-29.66)*(TEK1-29.66))) - R_2SB(i,k)=ESRR*r(k,i) - T_2SB(i,k)=T_2SB(i,k)-temp_e(K) !* perturbation temperature -! T_2SB(i,k)=0.5*(T_2SB(i,k)+t(k,i)) ! avg btw const P and const Sigma -! T_2SB(i,k)=0.5*t(k,i) ! average between const P and const Sigma - TSUM1=TSUM1+t(k,i) - TSUM2=TSUM2+T_2SB(i,k) - END DO - END DO - - print*,'TSUM1,TSUM2=',TSUM1,TSUM2 - - TSUM1=TSUM1+TSUM2 - - DO I=1,IR - DO K=1,KMAX - IF (ABS(TSUM1).GT.0.01) THEN - T_2SB(i,k)=(t(k,i)+T_2SB(i,k))*TSUM2/TSUM1 - ELSE - T_2SB(i,k)=0. - END IF - th(k,i)=U_2SB(i,k) - ur(k,i)=V_2SB(i,k) - t(k,i)=T_2SB(i,k) !* perturbation temperature - r(k,i)=R_2SB(i,k) -! print*,'T_2SB(i,k)=',i,k,T_2SB(i,k) - END DO - END DO - - 799 CONTINUE !* ------------------------------------------------------ +! go to 799 !* UNUSED p-to-sigma correction ------------------------ +! shin: UNUSED part between go to 799~799 CONTINUE were commented +! DO I=1,IR +! DO N=1,KMAX +! work1(N)=t(N,I)+temp_e(N) !* total temperature +! END DO +! DO K=1,kmax +! IF (p(k,i).GE.pcst(1)) THEN +! U_2SB(i,k)=th(1,i) +! V_2SB(i,k)=ur(1,i) +! T_2SB(i,k)=work1(1) +! R_2SB(i,k)=r(1,i) +! ELSEIF (p(k,i).LE.pcst(kmax)) THEN +! U_2SB(i,k)=th(kmax,i) +! V_2SB(i,k)=ur(kmax,i) +! T_2SB(i,k)=work1(kmax) +! R_2SB(i,k)=r(kmax,i) +! ELSE !* p-to-sigma interpolation +! DO N=1,kmax +! if ( p(k,i).LE.pcst(N) .AND. p(k,i).GT.pcst(N+1) ) then +! WT1=ALOG(1.*pcst(N+1))-ALOG(1.*pcst(N)) +! WT2=(ALOG(1.*p(k,i))-ALOG(1.*pcst(N)))/WT1 +! WT3=1.-WT2 +! U_2SB(i,k)=WT3*th(N,i)+WT2*th(N+1,i) +! V_2SB(i,k)=WT3*ur(N,i)+WT2*ur(N+1,i) +! T_2SB(i,k)=WT3*work1(N)+WT2*work1(N+1) +! R_2SB(i,k)=WT3*r(N,i)+WT2*r(N+1,i) +! GOTO 870 +! endif +! ENDDO +! 870 continue +! ENDIF +! END DO +! END DO +! +! TSUM1=0. +! TSUM2=0. +! +! DO I=1,IR +! DO K=1,KMAX +! TEK1=temp_e(K)+t(k,i) !* total temperature +! TEK2=T_2SB(i,k) +! ESRR=exp(4302.645*(TEK2-TEK1)/((TEK2-29.66)*(TEK1-29.66))) +! R_2SB(i,k)=ESRR*r(k,i) +! T_2SB(i,k)=T_2SB(i,k)-temp_e(K) !* perturbation temperature +!!!# T_2SB(i,k)=0.5*(T_2SB(i,k)+t(k,i)) ! avg btw const P and const Sigma +!!!# T_2SB(i,k)=0.5*t(k,i) ! average between const P and const Sigma +! TSUM1=TSUM1+t(k,i) +! TSUM2=TSUM2+T_2SB(i,k) +! END DO +! END DO +! +! print*,'TSUM1,TSUM2=',TSUM1,TSUM2 +! +! TSUM1=TSUM1+TSUM2 +! +! DO I=1,IR +! DO K=1,KMAX +! IF (ABS(TSUM1).GT.0.01) THEN +! T_2SB(i,k)=(t(k,i)+T_2SB(i,k))*TSUM2/TSUM1 +! ELSE +! T_2SB(i,k)=0. +! END IF +! th(k,i)=U_2SB(i,k) +! ur(k,i)=V_2SB(i,k) +! t(k,i)=T_2SB(i,k) !* perturbation temperature +! r(k,i)=R_2SB(i,k) +!!!# print*,'T_2SB(i,k)=',i,k,T_2SB(i,k) +! END DO +! END DO +! +! 799 CONTINUE !* ------------------------------------------------------ !* Using p-level instead of sigma-level DO I=1,IR @@ -634,10 +651,11 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & DIF=rp(N)-RIJ1(I,J) IF (DIF.GT.0.) THEN IDX1(I,J)=N !* Grid point inside vortex - GO TO 15 +! GO TO 15 + exit !shin ENDIF ENDDO - 15 CONTINUE +! 15 CONTINUE IF (IDX1(I,J).GE.2) THEN W1(I,J)=(RIJ1(I,J)-rp(IDX1(I,J)-1))/ & (rp(IDX1(I,J))-rp(IDX1(I,J)-1)) @@ -711,10 +729,11 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & DIF=rp(N)-RIJ2(I,J) IF (DIF.GT.0.) THEN IDX1(I,J)=N !* Grid point inside vortex - GO TO 25 +! GO TO 25 + exit !shin ENDIF ENDDO - 25 CONTINUE +! 25 CONTINUE IF (IDX1(I,J).GE.2) THEN W1(I,J)=(RIJ2(I,J)-rp(IDX1(I,J)-1))/ & (rp(IDX1(I,J))-rp(IDX1(I,J)-1)) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/correct_mat_2.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/correct_mat_2.f90 index aa91104f2..b145d8c4c 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/correct_mat_2.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/correct_mat_2.f90 @@ -11,6 +11,11 @@ SUBROUTINE CORT_MAT_2(IR1,NX,NY,NZ,KMX,U_2S, & ! input: RADIUS,CLON_NEW,CLAT_NEW,ics ! output: T_X,Q_X,SLP_X - new axisymmetric part + implicit none + integer I,J,K,M,N,NX,NY,NZ,KMX,KMX1,NXC,NYC,NM,IR,IR1,IR_1,IR_2 + integer k1,jmin,jmax3,ics + real pi,pi180,pi_deg,DST1,cost,tmax,tmin,ff0,beta,fact,force,force2 + real sum_str,str_cut,str_m_rat,adj_fun1,PS_C1,TEK1,TEK2,ESRR,DIF real(4) HLON(NX,NY),HLAT(NX,NY) real(4) VLON(NX,NY),VLAT(NX,NY) @@ -153,11 +158,12 @@ SUBROUTINE CORT_MAT_2(IR1,NX,NY,NZ,KMX,U_2S, & if(str_cut.gt.-10.)then str_m_rat=strm2(m,1)/(strm1(m,1)-1.E-20) IR_2=m - go to 57 +! go to 57 + exit !shin end if end do - 57 continue +! 57 continue fun1=0. do m=1,IR_2 @@ -256,10 +262,11 @@ SUBROUTINE CORT_MAT_2(IR1,NX,NY,NZ,KMX,U_2S, & DIF=RADIUS(N)-RIJ2(I,J) IF(DIF.GT.0.)THEN IDX1(I,J)=N - GO TO 25 +! GO TO 25 + exit !shin END IF END DO - 25 CONTINUE +! 25 CONTINUE IF(IDX1(I,J).GE.2)THEN W1(I,J)=(RIJ2(I,J)-RADIUS(IDX1(I,J)-1))/ & (RADIUS(IDX1(I,J))-RADIUS(IDX1(I,J)-1)) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/interp_coef_agrid.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/interp_coef_agrid.f90 index 1c63766c7..39772a6e1 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/interp_coef_agrid.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_bogus/interp_coef_agrid.f90 @@ -163,6 +163,7 @@ END SUBROUTINE G2T2V_BGRID subroutine rtll(tlmd,tphd,almd,aphd,tlm0d,tph0d) !------------------------------------------------------------------------------- + IMPLICIT NONE INTEGER,PARAMETER :: KIND_R8=8 real(KIND_R8), intent(in) :: tlmd, tphd @@ -262,6 +263,7 @@ end subroutine tll !! subroutine 'get_eta_level' returns the interface and !! layer-mean pressures for reference. subroutine get_eta_level(npz, p_s, pf, ph, ak, bk, pscale) + implicit none integer, intent(in) :: npz real, intent(in) :: p_s !< unit: pascal real, intent(in) :: ak(npz+1) @@ -270,9 +272,9 @@ subroutine get_eta_level(npz, p_s, pf, ph, ak, bk, pscale) real, intent(out) :: pf(npz) real, intent(out) :: ph(npz+1) - real, parameter :: RDGAS = 287.05 !< Gas constant for dry air [J/kg/deg] - real, parameter :: CP_AIR = 1004.6 !< Specific heat capacity of dry air at constant pressure [J/kg/deg] - real, parameter :: KAPPA = RDGAS/CP_AIR !< RDGAS / CP_AIR [dimensionless] + real, parameter :: RDGAS = 287.05 !< Gas constant for dry air [J/kg/deg] + real, parameter :: CP_AIR = 1004.6 !< Specific heat capacity of dry air at constant pressure [J/kg/deg] + real, parameter :: KAPPA = RDGAS/CP_AIR !< RDGAS / CP_AIR [dimensionless] integer k ph(1) = ak(1) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/anl_combine.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/anl_combine.f90 index c8403854e..976826a43 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/anl_combine.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/anl_combine.f90 @@ -16,8 +16,33 @@ ! DECLARE VARIABLES - INTEGER I,J,K,NX,NY,NZ,IFLAG,NX2 - INTEGER ITIM,IGFS_FLAG,INITOPT + implicit none + INTEGER I,J,K,L,NX,NY,NZ,IFLAG,NX2,NST,ITIM,IGFS_FLAG,INITOPT + integer IUNIT,I360,NX1,NY1,NZ1,KMX,JX,JY,I1,J1,NX_1,NY_1,N,N1 + integer ITER,ics,CURRENT_DOMAIN_ID,stat + integer ICLAT,ICLON,Ipsfc,Ipcls,Irmax,ivobs,Ir_vobs + integer NCHT,KSTM,k850,KST,IWMIN1,IWMAX1,JWMIN1,JWMAX1,KNHC,MNHC + integer IC1,JC1,MDX,MDY,NXT,NYT,NXT1,NYT1 + integer ictr,jctr,i_max,j_max,IMV,JMV,IR1,IR,K1,IR_1,id_storm + integer IDAT,IHOUR,IFH,LAT,LON,IVFT,IPFT,IV34,IMAX1,JMAX1 + integer iparam,icst,jcst,ID_INDX,JD_INDX,imn1,imx1,jmn1,jmx1 + real GAMMA,G,Rd,D608,Cp,COEF1,COEF2,COEF3,GRD,pi,pi_deg,pi180,DST1 + real vobs,vobs_o,VRmax,psfc_cls,PRMAX,R34obs,R34obsm,pct_m,ps_rat2 + real acount,deltp,deltp1,rdgas1,arad,vs_t,vmax_s + real eps1,eps2,eps3,eps4,eps5,eps6,rad2deg + real psfc_obs,cost,distm,distt,RMX_d,smax1,R05,smax2 + real beta,UU11,VV11,UUM1,VVM1,QQ,beta1,v34kt,v50kt,v64kt + real psfc_env,psfc_obs1,z0,zzz,rrr,ps_rat + real RAD_1,FACT_P,TV1,ZSF1,PSF1,A,wt,PMN06,DDX,DDY + real R34MOD,R34MODM,DEG2RAD,DEG2M,DEG2KM,FTMIN,FTMAX + real RMAX_0,ROC1,ROC2,RMW1,RMW2,RMW1_MOD,RMW2_OBS,SLP_T1 + real XXX,YYY,DDD,AAA,BBB,AAA1,BBB1,bbb_t1,bbb_t2,delt_z1,pt_c,sum1,dist1 + real FACT,FACT1,TEK1,TEK2,ESRR,DELT_P,DLMD2,DPHD2,WBD2,SBD2 + real CENTRAL_LON2,CENTRAL_LAT2,RWMAX1,PDIF1,T_OLD,Q_OLD + real VMX06,PSFC_OBS2,DPV_CT,PMN06_CT,TWMAX,RWMAX,ASYM,D_MAX + real VMAX1,VMAX2,R_MAX_W,VVMAX,VSMAX,V34SYM,RMX_E,R34DEG,RMAX_01 + real FLAG_TEST,RT_MAX,DR_VD,DR_VB,DR_VT,RVMAX5,Rmax_04,fact_v + real TENV1,QENV1,W,W1,ZSFC,TSFC,VMAX,UUT,VVT,FF,UV21,UV22,DDR ! PARAMETER (NX=215,NY=431,NZ=42,NST=5) PARAMETER (NST=5) @@ -111,7 +136,7 @@ REAL(8) CLON_NEW,CLAT_NEW,CLON_NHC,CLAT_NHC,CLON_NHC_6H,CLAT_NHC_6H REAL(8) CLON_NEW1,CLAT_NEW1 - DIMENSION TWM(101),RWM(101),TH1(200),RP(200) + REAL(4) TWM(101),RWM(101),TH1(200),RP(200) ! shin REAL(4) zmax @@ -589,8 +614,8 @@ R34modm=0. R34_mod=0. - DO I=1,100 - READ(12,65,end=104)PART1,NUM,IDAT,IHOUR,IFH,LAT,SN,LON,EW,IVFT,IPFT,IV34,IR34_mod + DO + READ(12,65,iostat=stat)PART1,NUM,IDAT,IHOUR,IFH,LAT,SN,LON,EW,IVFT,IPFT,IV34,IR34_mod IF(PART1.eq.basin.and.NUM.eq.ST_NAME(KST)(1:2))THEN IF(IFH.eq.ITIM)THEN VMX06=IVFT*0.514668039 ! 0.514668039=1./1.943 @@ -610,12 +635,11 @@ end if END IF END IF + if(stat /= 0) exit !shin END DO 65 FORMAT(A2,2x,A2,4x,I6,I2,12x,I3,2x,I3,A1,2x,I4,A1,2X,I3,2x,I4,6x,I3,5x,4(1x,I5)) - 104 CONTINUE - IF ( acount > 0.5 ) R34mod = R34mod/acount !* avg R34 [km] psfc_obs2=psfc_obs @@ -1973,7 +1997,7 @@ print*,'vobs_o,vobs,C101=',vobs_o,vobs,C101(i_max,j_max) - 876 CONTINUE +! 876 CONTINUE VMAX=0. ! DO J=1,NYT @@ -2639,13 +2663,18 @@ SUBROUTINE FIND_NEWCT1(IX,JX,UD,VD,GLON2,GLAT2, & CLON_NEW1,CLAT_NEW1) + implicit none + INTEGER I,J,IR,IT,IR1,IX,JX,IX2,JX2,IL,JL,KL + INTEGER ID,JD,I1,J1,NIC,NJC + REAL ddr,dds,WTS,DR,DD,PI,RAD,pi180,cost,u1,v1,sum1 + REAL DTX,DTY,XLAT,XLON,DIST,DIST1,UT,VT,WT,TX,RRX,TTX ! PARAMETER (IR=100,IT=24,IX=254,JX=254) PARAMETER (IR=60,IT=24) PARAMETER (ID=31,JD=31,DTX=0.1,DTY=0.1) ! Search x-Domain (ID-1)*DTX REAL (4) UD(IX,JX),VD(IX,JX),GLON2(IX,JX),GLAT2(IX,JX) ! DIMENSION RWM(IR+1),TWM(IR+1) - DIMENSION TNMX(ID,JD),RX(ID,JD),WTM(IR) - REAL (8) CLON_NEW1,CLAT_NEW1 + REAL(4) TNMX(ID,JD),RX(ID,JD),WTM(IR) ! shin + REAL (8) CLON_NEW,CLAT_NEW,CLON_NEW1,CLAT_NEW1,BLON,BLAT,DLAT,DLON,TLAT,TLON PI=ASIN(1.)*2. RAD=PI/180. @@ -2681,9 +2710,9 @@ SUBROUTINE FIND_NEWCT1(IX,JX,UD,VD,GLON2,GLAT2, & !.. CALCULATE TANGENTIAL WIND EVERY 0.2 deg INTERVAL !.. 10*10 deg AROUND 1ST GUESS VORTEX CENTER - DO 10 JL=1,IR + do JL=1,IR ! do loop for JL WTS= 0. - DO 20 IL=1,IT + do IL=1,IT ! loop for IL DR = JL*ddr ! DR = JL DD = (IL-1)*15*RAD @@ -2715,9 +2744,9 @@ SUBROUTINE FIND_NEWCT1(IX,JX,UD,VD,GLON2,GLAT2, & !.. TANGENTIAL WIND WT = -SIN(DD)*UT + COS(DD)*VT WTS = WTS+WT -20 CONTINUE + enddo ! do loop for IL WTM(JL) = WTS/24. -10 CONTINUE + enddo ! do loop for JL ! Southern Hemisphere IF (CLAT_NEW.LT.0) THEN diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/correct_mat.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/correct_mat.f90 index b50d9c8bb..ca3bf79ef 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/correct_mat.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/correct_mat.f90 @@ -12,6 +12,13 @@ SUBROUTINE CORT_MAT_1(IR1,NX,NY,NZ,KMX, & ! output: T_X,Q_X,SLP_X - new axisymmetric part ! output: CFT - correlation coef + implicit none + integer I,J,K,M,N,NX,NY,NZ,IR,IR1,IR_1,IR_2,nm,kmx,kmx1,NXC,NYC,JX,JY,JZ + integer k1,jmax3,jmin,iparam,ics,JST1 + real eps4,eps5,pi,pi180,pi_deg,DST1,cost,beta11,tmax,tmin + real ff0,beta,fact,aaa,bbb,force,force2,DIF,WT11,WT12,str_cut,str_m_rat + real TEK1,TEK2,TEK3,ESRR,ESR1 + real(4) HLON(NX,NY),HLAT(NX,NY) real(4) VLON(NX,NY),VLAT(NX,NY) @@ -214,10 +221,11 @@ SUBROUTINE CORT_MAT_1(IR1,NX,NY,NZ,KMX, & WT11=(RADIUS(J)-RADIUS1(N-1))/(RADIUS1(N)-RADIUS1(N-1)) WT12=1.-WT11 strm3(J,k)=WT11*strm2(n,k)+WT12*strm2(n-1,k) - GO TO 55 +! GO TO 55 + exit ! shin END IF END DO - 55 CONTINUE +! 55 CONTINUE END DO DO n=1,IR1 strm2(n,k)=strm3(n,k) @@ -231,10 +239,11 @@ SUBROUTINE CORT_MAT_1(IR1,NX,NY,NZ,KMX, & IF (str_cut.GT.-10.) THEN str_m_rat=strm2(m,1)/(strm1(m,1)-1.E-20) IR_2=m - go to 57 + exit ! shin +! go to 57 END IF end do - 57 continue +! 57 continue print*,'IR_1,IR_2=',IR_1,IR_2 @@ -353,10 +362,11 @@ SUBROUTINE CORT_MAT_1(IR1,NX,NY,NZ,KMX, & DIF=RADIUS(N)-RIJ2(I,J) IF (DIF.GT.0.) THEN IDX1(I,J)=N - GO TO 25 + exit ! shin +! GO TO 25 END IF END DO - 25 CONTINUE +! 25 CONTINUE IF (IDX1(I,J).GE.2) THEN W1(I,J)=(RIJ2(I,J)-RADIUS(IDX1(I,J)-1))/ & (RADIUS(IDX1(I,J))-RADIUS(IDX1(I,J)-1)) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/interp_coef_agrid.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/interp_coef_agrid.f90 index 1c63766c7..2809ba1da 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/interp_coef_agrid.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/interp_coef_agrid.f90 @@ -163,6 +163,7 @@ END SUBROUTINE G2T2V_BGRID subroutine rtll(tlmd,tphd,almd,aphd,tlm0d,tph0d) !------------------------------------------------------------------------------- + IMPLICIT NONE INTEGER,PARAMETER :: KIND_R8=8 real(KIND_R8), intent(in) :: tlmd, tphd @@ -262,6 +263,7 @@ end subroutine tll !! subroutine 'get_eta_level' returns the interface and !! layer-mean pressures for reference. subroutine get_eta_level(npz, p_s, pf, ph, ak, bk, pscale) + implicit none integer, intent(in) :: npz real, intent(in) :: p_s !< unit: pascal real, intent(in) :: ak(npz+1) @@ -270,9 +272,9 @@ subroutine get_eta_level(npz, p_s, pf, ph, ak, bk, pscale) real, intent(out) :: pf(npz) real, intent(out) :: ph(npz+1) - real, parameter :: RDGAS = 287.05 !< Gas constant for dry air [J/kg/deg] - real, parameter :: CP_AIR = 1004.6 !< Specific heat capacity of dry air at constant pressure [J/kg/deg] - real, parameter :: KAPPA = RDGAS/CP_AIR !< RDGAS / CP_AIR [dimensionless] + real, parameter :: RDGAS = 287.05 !< Gas constant for dry air [J/kg/deg] + real, parameter :: CP_AIR = 1004.6 !< Specific heat capacity of dry air at constant pressure [J/kg/deg] + real, parameter :: KAPPA = RDGAS/CP_AIR !< RDGAS / CP_AIR [dimensionless] integer k ph(1) = ak(1) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/split_sym_asy.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/split_sym_asy.f90 index 905e1fb24..d840cd223 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/split_sym_asy.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_combine/split_sym_asy.f90 @@ -5,15 +5,19 @@ SUBROUTINE Split_Sym_Asy(IX,JX,KX,UD,VD,US,VS,UA,VA,TWM,RWM, & ! IX,JX must be less than IX1,JX1 ! PARAMETER (IX1=2000,JX1=2000) + implicit none + integer I,J,K,N,IR,IT,IR1,IX1,JX1,IX,JX,KX + real pi,pi180,cost,ASYM,TWMAX,RWMAX,UTT,DTX,DTY,DTR,DDR,DIF PARAMETER (IR=100, IT=24, DDR=0.1) PARAMETER (IR1=IR+1) REAL(8) CLON_NEW,CLAT_NEW REAL(4) UD(IX,JX,KX),VD(IX,JX,KX),GLON(IX,JX),GLAT(IX,JX) REAL(4) US(IX,JX,KX),VS(IX,JX,KX),UA(IX,JX,KX),VA(IX,JX,KX) - DIMENSION RWM(IR1),TWM(IR1) + real(4) RWM(IR1),TWM(IR1) !shin +! DIMENSION RWM(IR1),TWM(IR1) real, dimension(:,:), allocatable :: RIJ,W1,W2 integer, dimension(:,:), allocatable :: IDX1 - integer :: IX1,JX1 +! integer :: IX1,JX1 ! DIMENSION RIJ(IX1,JX1),W1(IX1,JX1),W2(IX1,JX1) ! INTEGER IDX1(IX1,JX1) @@ -43,10 +47,11 @@ SUBROUTINE Split_Sym_Asy(IX,JX,KX,UD,VD,US,VS,UA,VA,TWM,RWM, & DIF=RWM(N)-RIJ(I,J) IF(DIF.GT.0.)THEN IDX1(I,J)=N - GO TO 15 +! GO TO 15 !shin + exit END IF END DO - 15 CONTINUE +! 15 CONTINUE IF(IDX1(I,J).GE.2)THEN W1(I,J)=(RIJ(I,J)-RWM(IDX1(I,J)-1))/ & (RWM(IDX1(I,J))-RWM(IDX1(I,J)-1)) @@ -104,13 +109,17 @@ SUBROUTINE Split_Sym_Asy(IX,JX,KX,UD,VD,US,VS,UA,VA,TWM,RWM, & SUBROUTINE FIND_WT1(IX,JX,UD,VD,GLON2,GLAT2,TWM,RWM,ASYM, & CLON_NEW,CLAT_NEW) + implicit none + INTEGER I,J,IR,IT,IR1,IX,JX,IX2,JX2,IL,JL,KL,KLM + REAL ddr,dds,WTS,DR,DD,PI,RAD,pi180,cost,u1,v1,sum1 + REAL dist,dist1,UT,VT,WT,TX,RRX,WSUM,WT_S,W_MAX,W_MIN,ASYM ! PARAMETER (IR=75,IT=24,ddr=0.2) PARAMETER (IR=100,IT=24,ddr=0.1) PARAMETER (IR1=IR+1) - DIMENSION UD(IX,JX),VD(IX,JX) + REAL(4) UD(IX,JX),VD(IX,JX) !shin REAL(4) GLON2(IX,JX),GLAT2(IX,JX) - DIMENSION WTM(IR),RWM(IR1),TWM(IR1),WTM2(IR,IT),WTM1(IT) - REAL(8) CLON_NEW,CLAT_NEW + REAL(4) WTM(IR),RWM(IR1),TWM(IR1),WTM2(IR,IT),WTM1(IT) !shin + REAL(8) CLON_NEW,CLAT_NEW,BLON,BLAT,DLAT,DLON,TLAT,TLON ! PI=ASIN(1.)*2. @@ -137,10 +146,10 @@ SUBROUTINE FIND_WT1(IX,JX,UD,VD,GLON2,GLAT2,TWM,RWM,ASYM, & !.. CALCULATE TANGENTIAL WIND EVERY 0.1 deg INTERVAL !.. 20*20 deg AROUND 1ST GUESS VORTEX CENTER - DO 10 JL=1,IR + do JL=1,IR ! do loop for JL WTS= 0. DR = JL*ddr - DO 20 IL=1,IT + DO IL=1,IT ! do loop for IL DD = (IL-1)*15*RAD DLON = DR*COS(DD) DLAT = DR*SIN(DD) @@ -171,10 +180,10 @@ SUBROUTINE FIND_WT1(IX,JX,UD,VD,GLON2,GLAT2,TWM,RWM,ASYM, & WT = -SIN(DD)*UT + COS(DD)*VT WTS = WTS+WT WTM2(JL,IL)=WT -20 CONTINUE + enddo ! do loop for IL WTM(JL) = WTS/24. ! print*,'JL,WTM(JL)=',JL,WTM(JL) -10 CONTINUE + enddo ! do loop for JL ! Southern Hemisphere IF(CLAT_NEW.LT.0)THEN diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/anl_enhance.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/anl_enhance.f90 index 2bb8a49fe..be40cc224 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/anl_enhance.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/anl_enhance.f90 @@ -9,7 +9,23 @@ ! ! DECLARE VARIABLES ! - INTEGER I,J,K,NX,NY,NZ,ICH + IMPLICIT NONE + INTEGER I,J,K,L,N,NX,NY,NZ,NX1,NY1,NZ1,ICH,NST,IR,IR1,IR2,NZ2 + integer IR_1,JX,JY,JZ,KMX,KMX1,KMX2,JST1 + integer ITIM,IUNIT,I360,iflag_cold,IM1,JM1,id_storm,KST + integer ICLAT,ICLON,Ipsfc,Ipcls,Irmax,ivobs,Ir_vobs,IFLAG,K850 + integer ictr,jctr,imn1,imx1,jmn1,jmx1,imax1,jmax1,iter,IMV,JMV + integer imax12,jmax12,i_psm,j_psm,k1,ics + real GAMMA,G,Rd,D608,Cp,GRD,COEF1,COEF2,COEF3,DST1,TENV1,press1 + real pi,pi_deg,arad,rad,TV1,ZSF1,PSF1,A,SUM11,vobs,vobs_o,VRmax + real SLP1_MEAN,SLP_AVE,SLP_SUM,SLP_MIN,DP_CT,psfc_obs,psfc_cls,PRMAX + real Rctp,cost,TWMAX1,RWMAX1,fact_v,dp_obs,distm,distt,delt_z1,pt_c + real sum1,dist1,psfc_env,psfc_obs1,vobs_kt,vmax1,vmax2,d_max,RMX_d + real z0,vmax_s,vmax_s_b,vobs1,RMN,W,W1,crtn,beta,VMAX,UUT,VVT,FF,R_DIST + real UU11,VV11,UUM1,VVM1,QQ1,uv22,QQ,beta1,vmax_1,ff0,ps_min,beta11 + real DIF,U_2S3,WT1,WT2,strm11,strm22,force,force2,PS_C1,PS_C2 + real fact,pt_c1,ps_rat,TEK1,TEK2,ESRR,T_OLD,Q_OLD,ZSFC,TSFC,QENV1 + ! PARAMETER (NST=5,IR=200) ! PARAMETER (NX=158,NY=329,NZ=42,NST=5) @@ -119,16 +135,26 @@ ! DATA PW_S/30*1.0,0.95,0.9,0.8,0.7, & ! 0.6,0.5,0.4,0.3,0.2,0.1,45*0./ - DATA PW_S/42*1.0,0.95,0.9,0.85,0.8,0.75,0.7, & - 0.65,0.6,0.55,0.5,0.45,0.4,0.35,0.3, & - 0.25,0.2,0.15,0.1,0.05,60*0./ +!using DATA PW_S/42*1.0,0.95,0.9,0.85,0.8,0.75,0.7, & +!using 0.65,0.6,0.55,0.5,0.45,0.4,0.35,0.3, & +!using 0.25,0.2,0.15,0.1,0.05,60*0./ + PW_S(1:42)=1.0 + PW_S(43:61)=(/0.95,0.9,0.85,0.8,0.75,0.7,0.65,0.6,0.55, & + 0.5,0.45,0.4,0.35,0.3,0.25,0.2,0.15,0.1,0.05/) + PW_S(62:121)=0.0 + ! DATA PW_S/30*1.0,0.95,0.9,0.8,0.7, & ! 0.6,0.5,0.4,0.3,0.2,0.1,45*0./ ! 850-700mb ! DATA PW_M/38*1.0,0.95,0.9,0.8,0.7, & ! 0.6,0.5,0.4,0.3,0.2,0.1,37*0./ ! 850-400mb - DATA PW_M/50*1.0,0.95,0.9,0.85,0.8,0.75,0.7, & - 0.65,0.6,0.55,0.5,0.45,0.4,0.35,0.3, & - 0.25,0.2,0.15,0.1,0.05,52*0./ +!using DATA PW_M/50*1.0,0.95,0.9,0.85,0.8,0.75,0.7, & +!using 0.65,0.6,0.55,0.5,0.45,0.4,0.35,0.3, & +!using 0.25,0.2,0.15,0.1,0.05,52*0./ + PW_M(1:50)=1.0 + PW_M(51:69)=(/0.95,0.9,0.85,0.8,0.75,0.7,0.65,0.6,0.55, & + 0.5,0.45,0.4,0.35,0.3,0.25,0.2,0.15,0.1,0.05/) + PW_M(70:121)=0.0 + COEF1=Rd/Cp COEF3=Rd*GAMMA/G @@ -683,11 +709,12 @@ W1=ALOG(1.*PCK(K+1))-ALOG(1.*PCK(K)) W=(ALOG(1.*PCSK(N))-ALOG(1.*PCK(K)))/W1 TEK42(N)=TEK(K)*(1.-W)+TEK(K+1)*W - GO TO 447 +! GO TO 447 + exit !shin END IF END DO END IF - 447 CONTINUE +! 447 CONTINUE ENDDO ! ENV. wind @@ -738,7 +765,7 @@ iter=0 beta=1.0 - 876 CONTINUE +! 876 CONTINUE VMAX=0. DO J=1,NY @@ -797,7 +824,7 @@ print*,'iter,beta=',iter,beta !zhan based in Qingfu's comment IF(iter.lt.3)go to 876 - IF(iter.lt.1)go to 876 +! IF(iter.lt.1)go to 876 shin: Don't need this because iter is already 1 beta=beta*crtn @@ -928,10 +955,11 @@ (RADIUS2(N)-RADIUS2(N-1)) WT2=1.-WT1 U_2S3=WT1*U_2SB(N,1)+WT2*U_2SB(N-1,1) - GO TO 55 + exit ! shin +! GO TO 55 END IF END DO - 55 CONTINUE +! 55 CONTINUE U_2S2(J)=U_2S1(J,1)+beta*U_2S3 END DO @@ -1152,11 +1180,12 @@ W=(ALOG(1.*PMID1(I,J,N))-ALOG(1.*PCST1(I,J,K)))/W1 T1(I,J,N)=TENV1+WRK1(K)*(1.-W)+WRK1(K+1)*W Q1(I,J,N)=QENV1+WRK2(K)*(1.-W)+WRK2(K+1)*W - GO TO 887 +! GO TO 887 + exit ! shin END IF END DO END IF - 887 CONTINUE +! 887 CONTINUE ! IF(N.EQ.1)THEN ! IF(ZMID(I,J,1).GT.10..and.SLP1(I,J).GT.PMID1(I,J,1))THEN ! PRINT*,'before T1(I,J,1)=',T(I,J,1) @@ -1295,11 +1324,12 @@ W=(ALOG(1.*PMV1(I,J,N))-ALOG(1.*PCST2(K)))/W1 U1(I,J,N)=U1(I,J,N)+WRK1(K)*(1.-W)+WRK1(K+1)*W V1(I,J,N)=V1(I,J,N)+WRK2(K)*(1.-W)+WRK2(K+1)*W - GO TO 888 +! GO TO 888 + exit ! shin END IF END DO END IF - 888 CONTINUE +! 888 CONTINUE END DO ENDDO ENDDO diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/convert_axi_xy.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/convert_axi_xy.f90 index 1acb8fe60..84a9a503b 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/convert_axi_xy.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/convert_axi_xy.f90 @@ -14,7 +14,13 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & ! ! All variables have the same vertical dimension (KMAX=121). ! - INTEGER I,J,K,NX,NY,NZ,ICH + implicit none + INTEGER I,J,K,N,NX,NY,NZ,ICH,KMAX,KMX + integer NST,IR,IR1,NHCT,II1,JJ1,iparam,icut1,icut2 + real GAMMA,G,Rd,D608,Cp,eps6,pi,pi180,arad,deg2m,cost,zmax,vobs,p_obs,cost_old + real count_smth,TWMAX,twsum,RWMAX,Rmax_0,fact,fact1,fact_v,vrmax,FC1,FC2,DFC + real density,sum_vt,sum_vt2,th_m,xxx,yyy,rmw1,rmw2,dp_obs,roc1,roc2,cut_off + real aaa,bbb,ddd,RMN,RMN1,RMN2,prmax,DIF,DTX,DTY,DTR,RIJ_m,PIJ_m ! PARAMETER (NST=5) ! PARAMETER (NX=420,NY=820,NZ=42) !* E-grid dimensions @@ -36,10 +42,14 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & REAL(8) CLON_NHC,CLAT_NHC !* storm lon, lat REAL(8) delc,thac !* vortex lon, lat - DIMENSION rp(IR1),ps(IR),ps1(IR),ps2(IR),ps_1mb(IR) - DIMENSION q(KMAX),p(KMAX,IR) !* pressure on sigma-levels (q) - DIMENSION t(KMAX,IR),r(KMAX,IR),ur(KMAX,IR1),th(KMAX,IR1) - DIMENSION vrad(KMAX),vtan(KMAX) !^ bogus vortex +! DIMENSION rp(IR1),ps(IR),ps1(IR),ps2(IR),ps_1mb(IR) +! DIMENSION q(KMAX),p(KMAX,IR) !* pressure on sigma-levels (q) +! DIMENSION t(KMAX,IR),r(KMAX,IR),ur(KMAX,IR1),th(KMAX,IR1) +! DIMENSION vrad(KMAX),vtan(KMAX) !^ bogus vortex + real(4) rp(IR1),ps(IR),ps1(IR),ps2(IR),ps_1mb(IR) !shin + real(4) q(KMAX),p(KMAX,IR) !* pressure on sigma-levels (q) shin + real(4) t(KMAX,IR),r(KMAX,IR),ur(KMAX,IR1),th(KMAX,IR1) !shin + real(4) vrad(KMAX),vtan(KMAX) !^ bogus vortex shin REAL(4), ALLOCATABLE :: RIJ1(:,:),RIJ2(:,:) REAL(4), ALLOCATABLE :: W1(:,:),W2(:,:) @@ -54,7 +64,8 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & REAL(4) U_2SB(IR1,KMAX),T_2SB(IR1,KMAX),SLP_2SB(IR1) REAL(4) V_2SB(IR1,KMAX),R_2SB(IR1,KMAX) !* sigma-level - DIMENSION RF(24) +! DIMENSION RF(24) + real(4) RF(24) !shin CHARACTER DEPTH*1,SN*1 ! CHARACTER SN*1,EW*1 @@ -146,7 +157,8 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & count_smth=0. - 999 continue !* smooth vortex for large & weak storm <--------------- +! 999 continue !* smooth vortex for large & weak storm <--------------- + do !* smooth vortex for large & weak storm MORE than 250 shin TWMAX=1.e-6 do i=1,IR @@ -205,62 +217,67 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & end do END DO count_smth=count_smth+1 - IF (count_smth.LE.250.) go to 999 !* ------------------------> +! IF (count_smth.LE.250.) go to 999 !* ------------------------> + IF (count_smth.gt.250.) exit !*---> smoothing should be less than 250 shin + ELSE ! shin + exit !if we don't satisfy the above IF (smooth) statement exit! END IF - print*,'count_smth=',count_smth !* =============================== - - go to 557 - - 556 continue !* UNUSED code for homogenizing ROCI with RMW <- - - - - - - pres_ct=dp_obs/ps(1) - do i=1,IR - ps_1mb(i)=ps(i)*pres_ct - end do - - IRAD_1=1 - do i=1,IR - if (abs(ps_1mb(i)).GT.100.) then - IRAD_1=I - end if - end do + enddo ! do loop end for smooth vortex - RAD_1=(IRAD_1+0.5)*(rp(2)-rp(1))*1.E-3 - fact_p=PRMAX/RAD_1 !* alfa=ROCI*/ROCI - -! fact_p=0.5*(fact_p+fact_v) - fact_p=fact_v - - print*,'fact,fact_p=',fact,fact_p,PRMAX,RAD_1 - - IF (fact .LT. fact_p) THEN !* smooth => fact_p = fact_v - wrk1(1)=(2.*ps(1)+ps(2))/3. - wrk1(IR)=0. - do i=2,IR-1 - wrk1(i)=(ps(i-1)+ps(i)+ps(i+1))/3. - end do - do i=1,IR - ps(i)=wrk1(i) - end do - do k=1,kmax - wrk3(1)=(2.*t(k,1)+t(k,2))/3. - wrk3(IR)=0. - wrk4(1)=(2.*r(k,1)+r(k,2))/3. - wrk4(IR)=0. - do i=2,IR-1 - wrk3(i)=(t(k,i-1)+t(k,i)+t(k,i+1))/3. - wrk4(i)=(r(k,i-1)+r(k,i)+r(k,i+1))/3. - end do - do i=1,IR - t(k,i)=wrk3(i) - r(k,i)=wrk4(i) - end do - end do - go to 556 !* - - - - - - - - - - - - - - - - - - - - - - - - -> - END IF + print*,'count_smth=',count_smth !* =============================== - 557 continue +! shin: UNUSED part between 557/556 continue~goto 556/557 were commented +! go to 557 +! 556 continue !* UNUSED code for homogenizing ROCI with RMW <- - - - - +! +! pres_ct=dp_obs/ps(1) +! do i=1,IR +! ps_1mb(i)=ps(i)*pres_ct +! end do +! +! IRAD_1=1 +! do i=1,IR +! if (abs(ps_1mb(i)).GT.100.) then +! IRAD_1=I +! end if +! end do +! +! RAD_1=(IRAD_1+0.5)*(rp(2)-rp(1))*1.E-3 +! fact_p=PRMAX/RAD_1 !* alfa=ROCI*/ROCI +! +!!##!!! fact_p=0.5*(fact_p+fact_v) +! fact_p=fact_v +! +! print*,'fact,fact_p=',fact,fact_p,PRMAX,RAD_1 +! +! IF (fact .LT. fact_p) THEN !* smooth => fact_p = fact_v +! wrk1(1)=(2.*ps(1)+ps(2))/3. +! wrk1(IR)=0. +! do i=2,IR-1 +! wrk1(i)=(ps(i-1)+ps(i)+ps(i+1))/3. +! end do +! do i=1,IR +! ps(i)=wrk1(i) +! end do +! do k=1,kmax +! wrk3(1)=(2.*t(k,1)+t(k,2))/3. +! wrk3(IR)=0. +! wrk4(1)=(2.*r(k,1)+r(k,2))/3. +! wrk4(IR)=0. +! do i=2,IR-1 +! wrk3(i)=(t(k,i-1)+t(k,i)+t(k,i+1))/3. +! wrk4(i)=(r(k,i-1)+r(k,i)+r(k,i+1))/3. +! end do +! do i=1,IR +! t(k,i)=wrk3(i) +! r(k,i)=wrk4(i) +! end do +! end do +! go to 556 !* - - - - - - - - - - - - - - - - - - - - - - - - -> +! END IF +! +! 557 continue !* 50% contraint for bogus vortex stretch !* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -413,31 +430,31 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & end if end do - go to 777 !* UNUSED cutoff beyond RMN2 - - - - - - - - - - - - do i=1,icut1-1 - ps(i)= ps(i)- ps(icut1)+ ps(IR) - ps1(i)=ps1(i)-ps1(icut1)+ps1(IR) - do k=1,kmax - ur(k,i)=ur(k,i)-ur(k,icut1)+ur(k,IR) - th(k,i)=th(k,i)-th(k,icut1)+th(k,IR) - t(k,i)=t(k,i)-t(k,icut1)+t(k,IR) - r(k,i)=max(0.,r(k,i)-r(k,icut1))+r(k,IR) - end do - end do - - do i=icut1,IR - ps(i)= ps(IR) - ps1(i)=ps1(IR) - do k=1,kmax - ur(k,i)=ur(k,IR) - th(k,i)=th(k,IR) - t(k,i)=t(k,IR) - r(k,i)=r(k,IR) - end do - end do - - 777 continue !* - - - - - - - - - - - - - - - - - - - - - - - +! go to 777 !* UNUSED cutoff beyond RMN2 - - - - - - - - - - +! shin: UNUSED part between go to 777~777 CONTINUE were commented +! do i=1,icut1-1 +! ps(i)= ps(i)- ps(icut1)+ ps(IR) +! ps1(i)=ps1(i)-ps1(icut1)+ps1(IR) +! do k=1,kmax +! ur(k,i)=ur(k,i)-ur(k,icut1)+ur(k,IR) +! th(k,i)=th(k,i)-th(k,icut1)+th(k,IR) +! t(k,i)=t(k,i)-t(k,icut1)+t(k,IR) +! r(k,i)=max(0.,r(k,i)-r(k,icut1))+r(k,IR) +! end do +! end do +! +! do i=icut1,IR +! ps(i)= ps(IR) +! ps1(i)=ps1(IR) +! do k=1,kmax +! ur(k,i)=ur(k,IR) +! th(k,i)=th(k,IR) +! t(k,i)=t(k,IR) +! r(k,i)=r(k,IR) +! end do +! end do +! +! 777 continue !* - - - - - - - - - - - - - - - - - - - - - - - icut2=icut1+1.5*arad/(rp1(2)-rp1(1)) !* icut2 -> RMN2+3' @@ -516,78 +533,78 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & end do SLP_2SB(IR1)=0 - go to 799 !* UNUSED p-to-sigma correction ------------------------ - - DO I=1,IR - DO N=1,KMAX - work1(N)=t(N,I)+temp_e(N) !* total temperature - END DO - DO K=1,kmax - IF (p(k,i).GE.pcst(1)) THEN - U_2SB(i,k)=th(1,i) - V_2SB(i,k)=ur(1,i) - T_2SB(i,k)=work1(1) - R_2SB(i,k)=r(1,i) - ELSEIF (p(k,i).LE.pcst(kmax)) THEN - U_2SB(i,k)=th(kmax,i) - V_2SB(i,k)=ur(kmax,i) - T_2SB(i,k)=work1(kmax) - R_2SB(i,k)=r(kmax,i) - ELSE !* p-to-sigma interpolation - DO N=1,kmax - if ( p(k,i).LE.pcst(N) .AND. p(k,i).GT.pcst(N+1) ) then - WT1=ALOG(1.*pcst(N+1))-ALOG(1.*pcst(N)) - WT2=(ALOG(1.*p(k,i))-ALOG(1.*pcst(N)))/WT1 - WT3=1.-WT2 - U_2SB(i,k)=WT3*th(N,i)+WT2*th(N+1,i) - V_2SB(i,k)=WT3*ur(N,i)+WT2*ur(N+1,i) - T_2SB(i,k)=WT3*work1(N)+WT2*work1(N+1) - R_2SB(i,k)=WT3*r(N,i)+WT2*r(N+1,i) - GOTO 870 - endif - ENDDO - 870 continue - ENDIF - END DO - END DO - - TSUM1=0. - TSUM2=0. - - DO I=1,IR - DO K=1,KMAX - TEK1=temp_e(K)+t(k,i) !* total temperature - TEK2=T_2SB(i,k) - ESRR=exp(4302.645*(TEK2-TEK1)/((TEK2-29.66)*(TEK1-29.66))) - R_2SB(i,k)=ESRR*r(k,i) - T_2SB(i,k)=T_2SB(i,k)-temp_e(K) !* perturbation temperature -! T_2SB(i,k)=0.5*(T_2SB(i,k)+t(k,i)) ! avg btw const P and const Sigma -! T_2SB(i,k)=0.5*t(k,i) ! average between const P and const Sigma - TSUM1=TSUM1+t(k,i) - TSUM2=TSUM2+T_2SB(i,k) - END DO - END DO - - print*,'TSUM1,TSUM2=',TSUM1,TSUM2 - - TSUM1=TSUM1+TSUM2 - - DO I=1,IR - DO K=1,KMAX - IF (ABS(TSUM1).GT.0.01) THEN - T_2SB(i,k)=(t(k,i)+T_2SB(i,k))*TSUM2/TSUM1 - ELSE - T_2SB(i,k)=0. - END IF - th(k,i)=U_2SB(i,k) - ur(k,i)=V_2SB(i,k) - t(k,i)=T_2SB(i,k) !* perturbation temperature - r(k,i)=R_2SB(i,k) -! print*,'T_2SB(i,k)=',i,k,T_2SB(i,k) - END DO - END DO - - 799 CONTINUE !* ------------------------------------------------------ +! go to 799 !* UNUSED p-to-sigma correction ------------------------ +! shin: UNUSED part between go to 799~799 CONTINUE were commented +! DO I=1,IR +! DO N=1,KMAX +! work1(N)=t(N,I)+temp_e(N) !* total temperature +! END DO +! DO K=1,kmax +! IF (p(k,i).GE.pcst(1)) THEN +! U_2SB(i,k)=th(1,i) +! V_2SB(i,k)=ur(1,i) +! T_2SB(i,k)=work1(1) +! R_2SB(i,k)=r(1,i) +! ELSEIF (p(k,i).LE.pcst(kmax)) THEN +! U_2SB(i,k)=th(kmax,i) +! V_2SB(i,k)=ur(kmax,i) +! T_2SB(i,k)=work1(kmax) +! R_2SB(i,k)=r(kmax,i) +! ELSE !* p-to-sigma interpolation +! DO N=1,kmax +! if ( p(k,i).LE.pcst(N) .AND. p(k,i).GT.pcst(N+1) ) then +! WT1=ALOG(1.*pcst(N+1))-ALOG(1.*pcst(N)) +! WT2=(ALOG(1.*p(k,i))-ALOG(1.*pcst(N)))/WT1 +! WT3=1.-WT2 +! U_2SB(i,k)=WT3*th(N,i)+WT2*th(N+1,i) +! V_2SB(i,k)=WT3*ur(N,i)+WT2*ur(N+1,i) +! T_2SB(i,k)=WT3*work1(N)+WT2*work1(N+1) +! R_2SB(i,k)=WT3*r(N,i)+WT2*r(N+1,i) +! GOTO 870 +! endif +! ENDDO +! 870 continue +! ENDIF +! END DO +! END DO +! +! TSUM1=0. +! TSUM2=0. +! +! DO I=1,IR +! DO K=1,KMAX +! TEK1=temp_e(K)+t(k,i) !* total temperature +! TEK2=T_2SB(i,k) +! ESRR=exp(4302.645*(TEK2-TEK1)/((TEK2-29.66)*(TEK1-29.66))) +! R_2SB(i,k)=ESRR*r(k,i) +! T_2SB(i,k)=T_2SB(i,k)-temp_e(K) !* perturbation temperature +!!#! T_2SB(i,k)=0.5*(T_2SB(i,k)+t(k,i)) ! avg btw const P and const Sigma +!!#! T_2SB(i,k)=0.5*t(k,i) ! average between const P and const Sigma +! TSUM1=TSUM1+t(k,i) +! TSUM2=TSUM2+T_2SB(i,k) +! END DO +! END DO +! +! print*,'TSUM1,TSUM2=',TSUM1,TSUM2 +! +! TSUM1=TSUM1+TSUM2 +! +! DO I=1,IR +! DO K=1,KMAX +! IF (ABS(TSUM1).GT.0.01) THEN +! T_2SB(i,k)=(t(k,i)+T_2SB(i,k))*TSUM2/TSUM1 +! ELSE +! T_2SB(i,k)=0. +! END IF +! th(k,i)=U_2SB(i,k) +! ur(k,i)=V_2SB(i,k) +! t(k,i)=T_2SB(i,k) !* perturbation temperature +! r(k,i)=R_2SB(i,k) +!!!# print*,'T_2SB(i,k)=',i,k,T_2SB(i,k) +! END DO +! END DO +! +! 799 CONTINUE !* ------------------------------------------------------ if(SN.eq.'S')then do k=1,kmax @@ -642,10 +659,11 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & DIF=rp(N)-RIJ1(I,J) IF (DIF.GT.0.) THEN IDX1(I,J)=N !* Grid point inside vortex - GO TO 15 +! GO TO 15 + exit !shin ENDIF ENDDO - 15 CONTINUE +! 15 CONTINUE IF (IDX1(I,J).GE.2) THEN W1(I,J)=(RIJ1(I,J)-rp(IDX1(I,J)-1))/ & (rp(IDX1(I,J))-rp(IDX1(I,J)-1)) @@ -719,10 +737,11 @@ SUBROUTINE axisym_xy_new(NX,NY,NZ,KMX, & DIF=rp(N)-RIJ2(I,J) IF (DIF.GT.0.) THEN IDX1(I,J)=N !* Grid point inside vortex - GO TO 25 +! GO TO 25 + exit ENDIF ENDDO - 25 CONTINUE +! 25 CONTINUE IF (IDX1(I,J).GE.2) THEN W1(I,J)=(RIJ2(I,J)-rp(IDX1(I,J)-1))/ & (rp(IDX1(I,J))-rp(IDX1(I,J)-1)) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/correct_mat_2.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/correct_mat_2.f90 index 7c412ca9b..bc75eaa4c 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/correct_mat_2.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/correct_mat_2.f90 @@ -11,6 +11,11 @@ SUBROUTINE CORT_MAT_2(IR1,NX,NY,NZ,KMX,U_2S, & ! input: RADIUS,CLON_NEW,CLAT_NEW,ics ! output: T_X,Q_X,SLP_X - new axisymmetric part + implicit none + integer I,J,K,M,N,NX,NY,NZ,KMX,KMX1,NXC,NYC,NM,IR,IR1,IR_1,IR_2,IR_5 + integer k1,jmin,jmax3,ics + real pi,pi180,pi_deg,DST1,cost,tmax,tmin,ff0,beta,fact,force,force2 + real sum_str,str_cut,str_m_rat,adj_fun1,PS_C1,TEK1,TEK2,ESRR,DIF real(4) HLON(NX,NY),HLAT(NX,NY) real(4) VLON(NX,NY),VLAT(NX,NY) @@ -161,10 +166,11 @@ SUBROUTINE CORT_MAT_2(IR1,NX,NY,NZ,KMX,U_2S, & if(str_cut.gt.-10.)then str_m_rat=strm2(m,1)/(strm1(m,1)-1.E-20) IR_2=m - go to 57 +! go to 57 + exit !shin end if end do - 57 continue +! 57 continue print*,'IR_2,IR_1=',IR_2,IR_1 @@ -270,10 +276,11 @@ SUBROUTINE CORT_MAT_2(IR1,NX,NY,NZ,KMX,U_2S, & DIF=RADIUS(N)-RIJ2(I,J) IF(DIF.GT.0.)THEN IDX1(I,J)=N - GO TO 25 +! GO TO 25 + exit !shin END IF END DO - 25 CONTINUE +! 25 CONTINUE IF(IDX1(I,J).GE.2)THEN W1(I,J)=(RIJ2(I,J)-RADIUS(IDX1(I,J)-1))/ & (RADIUS(IDX1(I,J))-RADIUS(IDX1(I,J)-1)) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/interp_coef_agrid.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/interp_coef_agrid.f90 index 1c63766c7..f955f1fd7 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/interp_coef_agrid.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_enhance/interp_coef_agrid.f90 @@ -163,6 +163,7 @@ END SUBROUTINE G2T2V_BGRID subroutine rtll(tlmd,tphd,almd,aphd,tlm0d,tph0d) !------------------------------------------------------------------------------- + implicit none INTEGER,PARAMETER :: KIND_R8=8 real(KIND_R8), intent(in) :: tlmd, tphd @@ -262,6 +263,7 @@ end subroutine tll !! subroutine 'get_eta_level' returns the interface and !! layer-mean pressures for reference. subroutine get_eta_level(npz, p_s, pf, ph, ak, bk, pscale) + implicit none integer, intent(in) :: npz real, intent(in) :: p_s !< unit: pascal real, intent(in) :: ak(npz+1) @@ -270,9 +272,9 @@ subroutine get_eta_level(npz, p_s, pf, ph, ak, bk, pscale) real, intent(out) :: pf(npz) real, intent(out) :: ph(npz+1) - real, parameter :: RDGAS = 287.05 !< Gas constant for dry air [J/kg/deg] - real, parameter :: CP_AIR = 1004.6 !< Specific heat capacity of dry air at constant pressure [J/kg/deg] - real, parameter :: KAPPA = RDGAS/CP_AIR !< RDGAS / CP_AIR [dimensionless] + real, parameter :: RDGAS = 287.05 !< Gas constant for dry air [J/kg/deg] + real, parameter :: CP_AIR = 1004.6 !< Specific heat capacity of dry air at constant pressure [J/kg/deg] + real, parameter :: KAPPA = RDGAS/CP_AIR !< RDGAS / CP_AIR [dimensionless] integer k ph(1) = ak(1) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/anl_pert.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/anl_pert.f90 index c0dc324d5..fae02db1e 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/anl_pert.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/anl_pert.f90 @@ -9,7 +9,28 @@ ! ! DECLARE VARIABLES ! + implicit none INTEGER I,J,K,NX,NY,NZ,IFLAG,NX2 + integer NST,INITOPT,IUNIT,I360,ITIM,NX1,NY1,NZ1,KMX,JX,JY + integer ICLAT,ICLON,Ipsfc,Ipcls,Irmax,ivobs,Ir_vobs + integer NCHT,KSTM,k850,KST,IWMIN1,IWMAX1,JWMIN1,JWMAX1 + integer ictr,jctr,ismth_01,N_smth,I_max1,J_max1,i_max,j_max,IMV,JMV + integer ICTRM1,ICTRP1,JCTRM1,JCTRP1,IR1,IR,IT1,IR0,IT2,I2,J2,KM1,M1 + integer IRAD_1,N_ITER,MAX_ITER,N,K1,IT_FLAG,IR_1 + real GAMMA,G,Rd,D608,Cp,COEF1,COEF2,COEF3,GRD,pi,pi_deg,pi180,DST1 + real vobs,vobs_o,VRmax,VRmax_deg,psfc_cls,PRMAX,R34obs,R34obsm + real acount,cmax,deltp,deltp1 + real psfc_obs,cost,distm,distt,v_max1,RMX_d,smax1,R05,smax2 + real beta,UU11,VV11,UUM1,VVM1,QQ,beta1,PRMAX2 + real v34kt,v50kt,v64kt,DR1,DA1,RCT,RCT2 + real DSTX,DSTY,RDT2,UT1,VT1,USUM,VSUM,R_WT,PRES_CT,RAD_1,FACT_P + real V_MAX,R34MOD,R34MODM,DEG2RAD,DEG2M,DEG2KM,FTMIN,FTMAX + real CTMIN,CTMAX,DMIN,ROC_ADD,RMAX_0,ROC1,ROC2,RMW1,RMW2,RMW_RAT,RMW2_LIMIT + real ROC1_T,ROC2_T,ROC_RAT,ROC_MAX,ROC_RAT1,DMAX,FF0,FORCE,FORCE2,FORCE3 + real RMW1_MOD,ROC1_MOD,RMW2_OBS,ROC2_OBS,SLP_MD,ROCX_RAT,SLP_T + real RMW2_0,ROC2_0,RMN_HWRF,XXX,YYY,DDD,AAA,BBB + real DIFF_P,DIFF_P_X,DIFF_P_N,DELT_P,RMW1_NEW,ROC1_NEW,SCALE1 + real BETA_CT,BETA11,FACT,TEK1,TEK2,ESRR ! ! PARAMETER (NX=215,NY=431,NZ=42,NST=5) PARAMETER (NST=5) @@ -122,7 +143,7 @@ REAL(8) :: CLON_NHC,CLAT_NHC REAL(8) :: CLON_NEW,CLAT_NEW - DIMENSION TWM(101),RWM(101),TH1(200),RP(200) + REAL(4) TWM(101),RWM(101),TH1(200),RP(200) ! shin REAL(4) zmax @@ -145,14 +166,22 @@ ! 0.6,0.5,0.4,0.3,0.2,0.1,37*0./ ! 850-400mb ! DATA PW_S/36*1.0,0.8,0.6,0.4,0.2, & ! 45*0./ ! 600-500mb - DATA PW_S/38*1.0,0.8,0.6,0.4,0.2, & - 43*0./ ! 600-500mb + +!using DATA PW_S/38*1.0,0.8,0.6,0.4,0.2, & +!using 43*0./ ! 600-500mb + PW_S(1:38)=1.0 + PW_S(39:42)=(/0.8,0.6,0.4,0.2/) + PW_S(43:85)=0.0 + !2 DATA PW_S/32*1.0,0.8,0.6,0.4,0.2, & !2 49*0./ ! 850-700mb !1 DATA PW_S/28*1.0,0.95,0.9,0.8,0.7, & !1 0.6,0.5,0.4,0.3,0.2,0.1,47*0./ ! 850-700mb - DATA PW_M/32*1.0,0.95,0.9,0.8,0.7, & - 0.6,0.5,0.4,0.3,0.2,0.1,43*0./ ! 850-400mb +!using DATA PW_M/32*1.0,0.95,0.9,0.8,0.7, & +!using 0.6,0.5,0.4,0.3,0.2,0.1,43*0./ ! 850-400mb + PW_M(1:32)=1.0 + PW_M(33:42)=(/0.95,0.9,0.8,0.7,0.6,0.5,0.4,0.3,0.2,0.1/) + PW_M(43:85)=0.0 COEF1=Rd/Cp COEF3=Rd*GAMMA/G @@ -532,7 +561,8 @@ ALLOCATE ( T_4(NX,NY,KMX),Q_4(NX,NY,KMX) ) N_smth=0 - 667 CONTINUE + do ! shin ================================================ +! 667 CONTINUE IF (INITOPT .EQ. 0 .and. ismth_01.EQ.1) THEN @@ -688,18 +718,27 @@ N_smth=N_smth+1 print*,'N_smth=',N_smth - IF(N_smth.lt.2)go to 667 +! IF(N_smth.lt.2)go to 667 + if(N_smth.ge.2)then ! shin IF((N_smth.lt.15.and.VRmax_deg.lt.1.5) & .and.RIJ2(I_max1,J_max1).lt.VRmax_deg)THEN print*,'N_smth,RIJ2,VRmax_deg=',N_smth,RIJ2(I_max1,J_max1),VRmax_deg - go to 667 + ELSE ! shin:If above statement is not satistifed, escapce + print*,'Exit the loop after N_smth=', N_smth + exit ! shin +! go to 667 END IF + end if ! shin + + ELSE ! shin + exit ! shin: Just exit, if the above part is not applied END IF + enddo !shin =========================================================== DEALLOCATE ( T_4,Q_4 ) - 665 continue +! 665 continue We don't need this shin RMX_d=max(2.0,3.*VRmax/DST1) ! RMX_d=max(RMX_d,3.0) @@ -1539,8 +1578,9 @@ IF(diff_p.lt.diff_p_n)THEN - 969 CONTINUE - +! 969 CONTINUE +! ==================== shin =================== + do n_iter=n_iter+1 xxx = ftmin*rmw1 ; yyy = ftmax*rmw1 !* 50% Constraint @@ -1563,7 +1603,7 @@ print*,'after aconstraint: aaa,bbb=',aaa,bbb - if(n_iter.le.max_iter)then + if(n_iter.le.max_iter)then ! if statement of n_iter RKX2=0. DO n=1,IR1 @@ -1599,7 +1639,7 @@ if(roc1_new.gt.roc2_0)then roc2=min(roc1_new,(1.+0.01*n_iter)*roc2_0) end if - go to 969 +! go to 969 else if (diff_p.lt.diff_p_n.and.it_flag.eq.2)then ! if(Rmax_0.gt.40.)then ftmin=ftmin-0.005 @@ -1614,11 +1654,15 @@ if(roc1_new.lt.roc2_0)then roc2=max(roc1_new,(1.-0.02*n_iter)*roc2_0) end if - go to 969 +! go to 969 + else + exit !If above two options aren't met escape the loop: shin end if - end if + end if ! if statement of n_iter + enddo ! end of do loop !shin +! ==================== shin =================== END IF diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/correct_mat.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/correct_mat.f90 index 84d64e092..bcdb3798a 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/correct_mat.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/correct_mat.f90 @@ -12,6 +12,12 @@ SUBROUTINE CORT_MAT(IR1,NX,NY,NZ,KMX,U_2S,T_2S,Q_2S,SLP_2S, & ! output: T_X,Q_X,SLP_X - new axisymmetric part ! output: A11,B11,C11 - correlation coef + implicit none + integer i,j,k,m,n,NX,NY,NZ,IR,IR1,IR_1,IR_2,nm,kmx,kmx1,NXC,NYC + integer jmax3,jmin,k1,KM1,KM2,IFLAG + real pi,pi180,pi_deg,DST1,cost,tmax,tmin,ff0,beta11,force,force2 + real sum_str,str_cut,str_m_rat,pms1,pms2,pms3,TEK1,TEK2,ESRR,DIF + real tmpdiff1,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6 real(4) U_2S(IR1,KMX),U_2S1(IR1,KMX) real(4) T_2S(IR1,KMX),Q_2S(IR1,KMX),SLP_2S(IR1) real(4) HLON(NX,NY),HLAT(NX,NY) @@ -166,10 +172,11 @@ SUBROUTINE CORT_MAT(IR1,NX,NY,NZ,KMX,U_2S,T_2S,Q_2S,SLP_2S, & if(str_cut.gt.-10.)then str_m_rat=strm2(n,1)/(strm1(n,1)-1.E-20) IR_2=n - go to 57 + exit ! shin +! go to 57 end if end do - 57 continue +! 57 continue CFT=0. DO n=1,IR_2 @@ -345,10 +352,11 @@ SUBROUTINE CORT_MAT(IR1,NX,NY,NZ,KMX,U_2S,T_2S,Q_2S,SLP_2S, & DIF=RADIUS(N)-RIJ2(I,J) IF(DIF.GT.0.)THEN IDX1(I,J)=N - GO TO 25 + EXIT ! shin +! GO TO 25 END IF END DO - 25 CONTINUE +! 25 CONTINUE END DO END DO DO J=1,NY diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/grads.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/grads.f90 index 56873664a..24bb32389 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/grads.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/anl_pert/grads.f90 @@ -1,5 +1,6 @@ subroutine open_grads(label,nlon,nlat,nsig,startx,starty,xinc,yinc) + implicit none character(*) label integer nlon,nlat,nsig integer i,k,ntime @@ -60,6 +61,7 @@ end subroutine open_grads subroutine load(a,ni,nj,nk,n,dum) + implicit none integer :: ni,nj,nk,n,i,j real(4) :: a(ni,nj,nk) real(4) :: dum(ni,nj) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/create_trak_guess/create_trak_guess.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/create_trak_guess/create_trak_guess.f90 index 679b126b2..aaeefa8b6 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/create_trak_guess/create_trak_guess.f90 +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/create_trak_guess/create_trak_guess.f90 @@ -1,5 +1,5 @@ !--------------------------------------------------------------------------------------------------------- -! This code is designed to replace create_trak_guess.f90 of HWRF: 2022 JungHoon Shin +! This code is designed to replace create_trak_guess.f90 of HWRF: 2022 JungHoon Shin ! Usage example: ! ./hafs_vi_create_trak_guess.x storm_id ! e.g., ./hafs_vi_create_trak_guess.x 13L @@ -52,12 +52,12 @@ program create_trak_guess read(12,65,iostat=stat) part1,num,idat,ihour,ifh,lat,ns,lon,ew if(ns.eq.'S')lat=-lat !We only need 3-,6-,9-h HAFS storm postion & Make sure part1(basin code from ATCF file)is equal to 'basin' - if(ifh.ge.3 .and. ifh.le.9 .and. part1.eq.basin .and. storm_num.eq.num)then + if(ifh.ge.3 .and. ifh.le.9 .and. part1.eq.basin .and. storm_num.eq.num)then lathr(ifh-2)=lat lonhr(ifh-2)=lon end if !If we find 9-h information or reach the end of file WITHOUT 9-h data, exit the do loop - if(stat /= 0 .or. ifh.eq.9) exit + if(stat /= 0 .or. ifh.eq.9) exit enddo ! If there are no valid lat/lon locations from fort.12, then using the lat/lon @@ -80,5 +80,5 @@ program create_trak_guess 65 format(A2,2x,A2,4x,I6,I2,12x,I3,2x,I3,A1,2x,I4,A1) ! Input fort.12 (ATCF) format 15 format('72HDAS',I6,I2,14I5,' 0 0 0 0 0 0',1x,3A) ! Output(trak.fnl.all) format -end program create_trak_guess +end program create_trak_guess diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/BOUND.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/BOUND.f deleted file mode 100644 index 6cd1ead9e..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/BOUND.f +++ /dev/null @@ -1,28 +0,0 @@ - SUBROUTINE BOUND(NMX,XR,ro) -C - PARAMETER (IMX=41 , JMX=41) -C - DIMENSION XR(NMX),ro(nmx) - COMMON /XXX/ XF(IMX,JMX),XC,YC,DX,DY - COMMON /POSIT/ XOLD,YOLD - PI = 4.*ATAN(1.0) -c fact=cos(yold*pi/180.) - fact=1.0 - DO 10 I=1,NMX - THETA= 2.*PI*FLOAT(I-1)/FLOAT(NMX) - X=RO(i)/fact*COS(THETA)+XC +1. - Y=RO(i)*SIN(THETA)+YC +1. - IX=INT(X/DX) - IY=INT(Y/DY) - IX1=IX+1 - IY1=IY+1 - P=X/DX-FLOAT(IX) - Q=Y/DY-FLOAT(IY) - XR(I)=(1.-P)*(1.-Q)*XF(IX,IY) +(1.-P)*Q*XF(IX,IY+1) - 1 + (1.-Q)*P*XF(IX+1,IY) + P*Q*XF(IX+1,IY+1) -c PRINT*,'QLIU TEST, BOUND=',XR(I),XF(IX,IY),XF(IX,IY+1), -c 2 XF(IX+1,IY),XF(IX+1,IY+1),I - -10 CONTINUE - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/BOUND.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/BOUND.f90 new file mode 100644 index 000000000..59edbe008 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/BOUND.f90 @@ -0,0 +1,26 @@ + SUBROUTINE BOUND(NMX,XR,ro) + use xxx + use posit + implicit none + integer,intent(in) :: nmx + real, dimension(nmx):: XR,ro + real:: theta,x,y,p,q,pi,fact + integer::ix,iy,ix1,iy1,i + + PI = 4.*ATAN(1.0) + fact=1.0 + DO I=1,NMX + THETA= 2.*PI*FLOAT(I-1)/FLOAT(NMX) + X=RO(i)/fact*COS(THETA)+XC +1. + Y=RO(i)*SIN(THETA)+YC +1. + IX=INT(X/DX) + IY=INT(Y/DY) + IX1=IX+1 + IY1=IY+1 + P=X/DX-FLOAT(IX) + Q=Y/DY-FLOAT(IY) + XR(I)=(1.-P)*(1.-Q)*XF(IX,IY) +(1.-P)*Q*XF(IX,IY+1)+(1.-Q)*P*XF(IX+1,IY) + P*Q*XF(IX+1,IY+1) + ENDDO + + RETURN + END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/CMakeLists.txt b/sorc/hafs_tools.fd/sorc/hafs_vi/split/CMakeLists.txt index 0f311b615..1995062ce 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/CMakeLists.txt +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/CMakeLists.txt @@ -6,11 +6,11 @@ set(fortran_srcs - modules.f split.f BOUND.f fft99.f sig_p_convt.f - SEPAR.f WNLIT.f FDUMP.f H12.f I1MACH.f J4SAVE.f XGETUA.f - WNLSM.f WNNLS.f XERABT.f XERCTL.f XERPRT.f XERROR.f XERRWV.f - XERSAV.f srotm.f srotmg.f amatrix.f rodist.f landcmsk.f - create_rel_domain.f) + modules.f90 split.f90 BOUND.f90 fft99.f90 sig_p_convt.f90 + SEPAR.f90 WNLIT.f90 FDUMP.f90 H12.f90 I1MACH.f90 J4SAVE.f90 XGETUA.f90 + WNLSM.f90 WNNLS.f90 XERABT.f90 XERCTL.f90 XERPRT.f90 XERROR.f90 XERRWV.f90 + XERSAV.f90 srotm.f90 srotmg.f90 amatrix.f90 rodist.f90 landcmsk.f90 + create_rel_domain.f90) set(exe_name hafs_vi_split.x) diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/FDUMP.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/FDUMP.f deleted file mode 100644 index 644e933fd..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/FDUMP.f +++ /dev/null @@ -1,24 +0,0 @@ - SUBROUTINE FDUMP -C***BEGIN PROLOGUE FDUMP -C***DATE WRITTEN 790801 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. Z -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Symbolic dump (should be locally written). -C***DESCRIPTION -C ***Note*** Machine Dependent Routine -C FDUMP is intended to be replaced by a locally written -C version which produces a symbolic dump. Failing this, -C it should be replaced by a version which prints the -C subprogram nesting list. Note that this dump must be -C printed on each of up to five files, as indicated by the -C XGETUA routine. See XSETUA and XGETUA for details. -C -C Written by Ron Jones, with SLATEC Common Math Library Subcommittee -C Latest revision --- 23 May 1979 -C***ROUTINES CALLED (NONE) -C***END PROLOGUE FDUMP -C***FIRST EXECUTABLE STATEMENT FDUMP - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/FDUMP.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/FDUMP.f90 new file mode 100644 index 000000000..b12c3a0c3 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/FDUMP.f90 @@ -0,0 +1,25 @@ + SUBROUTINE FDUMP +!C***BEGIN PROLOGUE FDUMP +!C***DATE WRITTEN 790801 (YYMMDD) +!C***REVISION DATE 820801 (YYMMDD) +!C***CATEGORY NO. Z +!C***KEYWORDS ERROR,XERROR PACKAGE +!C***AUTHOR JONES, R. E., (SNLA) +!C***PURPOSE Symbolic dump (should be locally written). +!C***DESCRIPTION +!C ***Note*** Machine Dependent Routine +!C FDUMP is intended to be replaced by a locally written +!C version which produces a symbolic dump. Failing this, +!C it should be replaced by a version which prints the +!C subprogram nesting list. Note that this dump must be +!C printed on each of up to five files, as indicated by the +!C XGETUA routine. See XSETUA and XGETUA for details. +!C +!C Written by Ron Jones, with SLATEC Common Math Library Subcommittee +!C Latest revision --- 23 May 1979 +!C***ROUTINES CALLED (NONE) +!C***END PROLOGUE FDUMP +!C***FIRST EXECUTABLE STATEMENT FDUMP + implicit none + RETURN + END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/H12.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/H12.f deleted file mode 100644 index 3a3323436..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/H12.f +++ /dev/null @@ -1,137 +0,0 @@ - SUBROUTINE H12(MODE,LPIVOT,L1,M,U,IUE,UP,C,ICE,ICV,NCV) -C***BEGIN PROLOGUE H12 -C***REFER TO HFTI,LSEI,WNNLS -C -C SUBROUTINE H12 (MODE,LPIVOT,L1,M,U,IUE,UP,C,ICE,ICV,NCV) -C -C C.L.Lawson and R.J.Hanson, Jet Propulsion Laboratory, 1973 Jun 12 -C to appear in 'Solving Least Squares Problems', Prentice-Hall, 1974 -C -C Modified at SANDIA LABS, May 1977, to -- -C -C 1) Remove double precision accumulation, and -C 2) Include usage of the Basic Linear Algebra Package for -C vectors longer than a particular threshold. -C -C Construction and/or application of a single -C Householder transformation.. Q = I + U*(U**T)/B -C -C MODE = 1 or 2 to select algorithm H1 or H2 . -C LPIVOT is the index of the pivot element. -C L1,M If L1 .LE. M the transformation will be constructed to -C zero elements indexed from L1 through M. If L1 GT. M -C THE SUBROUTINE DOES AN IDENTITY TRANSFORMATION. -C U(),IUE,UP On entry to H1 U() contains the pivot vector. -C IUE is the storage increment between elements. -C On exit from H1 U() and UP -C contain quantities defining the vector U of the -C Householder transformation. On entry to H2 U() -C and UP should contain quantities previously computed -C by H1. These will not be modified by H2. -C C() On entry to H1 or H2 C() contains a matrix which will be -C regarded as a set of vectors to which the Householder -C transformation is to be applied. On exit C() contains the -C set of transformed vectors. -C ICE Storage increment between elements of vectors in C(). -C ICV Storage increment between vectors in C(). -C NCV Number of vectors in C() to be transformed. If NCV .LE. 0 -C no operations will be done on C(). -C***ROUTINES CALLED SAXPY,SDOT,SSWAP -C***END PROLOGUE H12 -c - USE setparms -c - DIMENSION U(IUE,M), C(1) -C***FIRST EXECUTABLE STATEMENT H12 - ONE=1. -C - IF (0.GE.LPIVOT.OR.LPIVOT.GE.L1.OR.L1.GT.M) RETURN - CL=ABS(U(1,LPIVOT)) - IF (MODE.EQ.2) GO TO 60 -C ****** CONSTRUCT THE TRANSFORMATION. ****** - DO 10 J=L1,M - 10 CL=AMAX1(ABS(U(1,J)),CL) - IF (CL) 130,130,20 - 20 CLINV=ONE/CL - SM=(U(1,LPIVOT)*CLINV)**2 - DO 30 J=L1,M - 30 SM=SM+(U(1,J)*CLINV)**2 - CL=CL*SQRT(SM) - IF (U(1,LPIVOT)) 50,50,40 - 40 CL=-CL - 50 UP=U(1,LPIVOT)-CL - U(1,LPIVOT)=CL - GO TO 70 -C ****** APPLY THE TRANSFORMATION I+U*(U**T)/B TO C. ****** -C - 60 IF (CL) 130,130,70 - 70 IF (NCV.LE.0) RETURN - B=UP*U(1,LPIVOT) -C B MUST BE NONPOSITIVE HERE. IF B = 0., RETURN. -C - IF (B) 80,130,130 - 80 B=ONE/B - MML1P2=M-L1+2 - IF (MML1P2.GT.20) GO TO 140 - I2=1-ICV+ICE*(LPIVOT-1) - INCR=ICE*(L1-LPIVOT) - DO 120 J=1,NCV - I2=I2+ICV - I3=I2+INCR - I4=I3 - SM=C(I2)*UP - DO 90 I=L1,M - SM=SM+C(I3)*U(1,I) - 90 I3=I3+ICE - IF (SM) 100,120,100 - 100 SM=SM*B - C(I2)=C(I2)+SM*UP - DO 110 I=L1,M - C(I4)=C(I4)+SM*U(1,I) - 110 I4=I4+ICE - 120 CONTINUE - 130 RETURN - 140 CONTINUE - L1M1=L1-1 - KL1=1+(L1M1-1)*ICE - KL2=KL1 - KLP=1+(LPIVOT-1)*ICE - UL1M1=U(1,L1M1) - U(1,L1M1)=UP - IF (LPIVOT.EQ.L1M1) GO TO 150 - if (kind(C) == real_single) then - CALL SSWAP(NCV,C(KL1),ICV,C(KLP),ICV) - else if (kind(C) == real_double) then - CALL DSWAP(NCV,C(KL1),ICV,C(KLP),ICV) - endif - - 150 CONTINUE - - if (kind(U) == real_single .and. kind(C) == real_single) then - do J=1,NCV - SM=SDOT(MML1P2,U(1,L1M1),IUE,C(KL1),ICE) - SM=SM*B - CALL SAXPY (MML1P2,SM,U(1,L1M1),IUE,C(KL1),ICE) - KL1=KL1+ICV - enddo - else if (kind(U) == real_double .and. kind(C) == real_double) then - do J=1,NCV - SM=DDOT(MML1P2,U(1,L1M1),IUE,C(KL1),ICE) - SM=SM*B - CALL DAXPY (MML1P2,SM,U(1,L1M1),IUE,C(KL1),ICE) - KL1=KL1+ICV - enddo - endif - - U(1,L1M1)=UL1M1 - IF (LPIVOT.EQ.L1M1) RETURN - KL1=KL2 - - if (kind(C) == real_single) then - CALL SSWAP(NCV,C(KL1),ICV,C(KLP),ICV) - else if (kind(C) == real_double) then - CALL DSWAP(NCV,C(KL1),ICV,C(KLP),ICV) - endif - - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/H12.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/H12.f90 new file mode 100644 index 000000000..59475bfe6 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/H12.f90 @@ -0,0 +1,89 @@ + subroutine h12(mode,lpivot,l1,m,u,iue,up,c,ice,icv,ncv) + !From http://jacobwilliams.github.io/slsqp/proc/h12.html + implicit none + + integer,intent(in):: mode + !! `1` or `2` --selects algorithm ***h1*** to construct and apply a + !! householder transformation, or algorithm ***h2*** to apply a + !! previously constructed transformation. + integer,intent(in):: lpivot !! the index of the pivot element + integer,intent(in):: l1 + !! if `l1 <= m` the transformation will be constructed to + !! zero elements indexed from `l1` through `m`. + !! if `l1 > m` the subroutine does an identity transformation. + integer,intent(in):: m !! see `li`. + integer,intent(in):: iue !! see `u`. + integer,parameter:: wp=8 + real(wp),dimension(iue,*),intent(inout) :: u + !! on entry with `mode = 1`, `u` contains the pivot + !! vector. `iue` is the storage increment between elements. on exit when `mode = 1`, `u` and `up` contain quantities + !! defining the vector `u` of the householder transformation. on entry with `mode = 2`, `u` and `up` should contain quantities + !! previously computed with `mode = 1`. these will not be modified during the entry with `mode = 2`. `dimension[u(iue,m)]` + real(wp),intent(inout) :: up !! see `u`. + real(wp),dimension(*),intent(inout) :: c + !! on entry with `mode = 1 or 2`, `c` contains a matrix which + !! will be regarded as a set of vectors to which the householder transformation is + !! to be applied. on exit `c` contains the set of transformed vectors. + integer,intent(in):: ice !! storage increment between elements of vectors in `c`. + integer,intent(in):: icv !! storage increment between vectors in `c`. + integer,intent(in):: ncv + !! number of vectors in `c` to be transformed. if `ncv <= 0` + !! no operations will be done on `c`. + + integer :: i, i2, i3, i4, incr, j + real(wp) :: b, cl, clinv, sm + real :: zero, one + + zero=0. + one=1. + if ( 0>=lpivot .or. lpivot>=l1 .or. l1>m ) return + cl = abs(u(1,lpivot)) + if ( mode/=2 ) then + ! construct the transformation. + do j = l1 , m + cl = max(abs(u(1,j)),cl) + end do + if ( cl<=zero ) return + clinv = one/cl + sm = (u(1,lpivot)*clinv)**2 + do j = l1 , m + sm = sm + (u(1,j)*clinv)**2 + end do + cl = cl*sqrt(sm) + if ( u(1,lpivot)>zero ) cl = -cl + up = u(1,lpivot) - cl + u(1,lpivot) = cl + else if ( cl<=zero ) then + return + end if + + if ( ncv>0 ) then + ! apply the transformation i+u*(u**t)/b to c. + b = up*u(1,lpivot) + ! b must be nonpositive here. + if ( bzero ) then + sm = sm*b + c(i2) = c(i2) + sm*up + do i = l1 , m + c(i4) = c(i4) + sm*u(1,i) + i4 = i4 + ice + end do + end if + end do + end if + end if + + end subroutine h12 diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/I1MACH.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/I1MACH.f deleted file mode 100644 index 09dd15ae6..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/I1MACH.f +++ /dev/null @@ -1,108 +0,0 @@ - INTEGER FUNCTION I1MACH(I) -C***BEGIN PROLOGUE I1MACH -C***DATE WRITTEN 750101 (YYMMDD) -C***REVISION DATE 910131 (YYMMDD) -C***CATEGORY NO. R1 -C***KEYWORDS MACHINE CONSTANTS -C***AUTHOR FOX, P. A., (BELL LABS) -C HALL, A. D., (BELL LABS) -C SCHRYER, N. L., (BELL LABS) -C***PURPOSE Returns integer machine dependent constants -C***DESCRIPTION -C -C This is the CMLIB version of I1MACH, the integer machine -C constants subroutine originally developed for the PORT library. -C -C I1MACH can be used to obtain machine-dependent parameters -C for the local machine environment. It is a function -C subroutine with one (input) argument, and can be called -C as follows, for example -C -C K = I1MACH(I) -C -C where I=1,...,16. The (output) value of K above is -C determined by the (input) value of I. The results for -C various values of I are discussed below. -C -C I/O unit numbers. -C I1MACH( 1) = the standard input unit. -C I1MACH( 2) = the standard output unit. -C I1MACH( 3) = the standard punch unit. -C I1MACH( 4) = the standard error message unit. -C -C Words. -C I1MACH( 5) = the number of bits per integer storage unit. -C I1MACH( 6) = the number of characters per integer storage unit. -C -C Integers. -C assume integers are represented in the S-digit, base-A form -C -C sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) -C -C where 0 .LE. X(I) .LT. A for I=0,...,S-1. -C I1MACH( 7) = A, the base. -C I1MACH( 8) = S, the number of base-A digits. -C I1MACH( 9) = A**S - 1, the largest magnitude. -C -C Floating-Point Numbers. -C Assume floating-point numbers are represented in the T-digit, -C base-B form -C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) -C -C where 0 .LE. X(I) .LT. B for I=1,...,T, -C 0 .LT. X(1), and EMIN .LE. E .LE. EMAX. -C I1MACH(10) = B, the base. -C -C Single-Precision -C I1MACH(11) = T, the number of base-B digits. -C I1MACH(12) = EMIN, the smallest exponent E. -C I1MACH(13) = EMAX, the largest exponent E. -C -C Double-Precision -C I1MACH(14) = T, the number of base-B digits. -C I1MACH(15) = EMIN, the smallest exponent E. -C I1MACH(16) = EMAX, the largest exponent E. -C -C To alter this function for a particular environment, -C the desired set of DATA statements should be activated by -C removing the C from column 1. Also, the values of -C I1MACH(1) - I1MACH(4) should be checked for consistency -C with the local operating system. -C***REFERENCES FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A -C PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL -C SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188. -C***ROUTINES CALLED (NONE) -C***END PROLOGUE I1MACH -C - INTEGER IMACH(16),OUTPUT - EQUIVALENCE (IMACH(4),OUTPUT) -C -C MACHINE CONSTANTS FOR THE IBM RS 6000 -C USING THE 32 BIT INTEGER COMPILER OPTION -C -C === MACHINE = 1 .32-BIT-INTEGER - DATA IMACH( 1) / 5 / - DATA IMACH( 2) / 6 / - DATA IMACH( 3) / 6 / - DATA IMACH( 4) / 0 / - DATA IMACH( 5) / 32 / - DATA IMACH( 6) / 4 / - DATA IMACH( 7) / 2 / - DATA IMACH( 8) / 31 / - DATA IMACH( 9) / 2147483647 / - DATA IMACH(10) / 2 / - DATA IMACH(11) / 24 / - DATA IMACH(12) / -125 / - DATA IMACH(13) / 128 / - DATA IMACH(14) / 53 / - DATA IMACH(15) / -1021 / - DATA IMACH(16) / 1024 / -c -C***FIRST EXECUTABLE STATEMENT I1MACH - IF (I .LT. 1 .OR. I .GT. 16) - 1 CALL XERROR ( 'I1MACH -- I OUT OF BOUNDS',25,1,2) -C - I1MACH=IMACH(I) - RETURN -C - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/I1MACH.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/I1MACH.f90 new file mode 100644 index 000000000..701072fe0 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/I1MACH.f90 @@ -0,0 +1,112 @@ + INTEGER FUNCTION I1MACH(I) + implicit none +!subroutine I1MACH(I) +!integer:: I, I1MACH +!***BEGIN PROLOGUE I1MACH +!***DATE WRITTEN 750101 (YYMMDD) +!***REVISION DATE 910131 (YYMMDD) +!***CATEGORY NO. R1 +!***KEYWORDS MACHINE CONSTANTS +!***AUTHOR FOX, P. A., (BELL LABS) +! HALL, A. D., (BELL LABS) +! SCHRYER, N. L., (BELL LABS) +!***PURPOSE Returns integer machine dependent constants +!***DESCRIPTION +! +! This is the CMLIB version of I1MACH, the integer machine +! constants subroutine originally developed for the PORT library. +! +! I1MACH can be used to obtain machine-dependent parameters +! for the local machine environment. It is a function +! subroutine with one (input) argument, and can be called +! as follows, for example +! +! K = I1MACH(I) +! +! where I=1,...,16. The (output) value of K above is +! determined by the (input) value of I. The results for +! various values of I are discussed below. +! +! I/O unit numbers. +! I1MACH( 1) = the standard input unit. +! I1MACH( 2) = the standard output unit. +! I1MACH( 3) = the standard punch unit. +! I1MACH( 4) = the standard error message unit. +! +! Words. +! I1MACH( 5) = the number of bits per integer storage unit. +! I1MACH( 6) = the number of characters per integer storage unit. +! +! Integers. +! assume integers are represented in the S-digit, base-A form +! +! sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) +! +! where 0 .LE. X(I) .LT. A for I=0,...,S-1. +! I1MACH( 7) = A, the base. +! I1MACH( 8) = S, the number of base-A digits. +! I1MACH( 9) = A**S - 1, the largest magnitude. +! +! Floating-Point Numbers. +! Assume floating-point numbers are represented in the T-digit, +! base-B form +! sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +! +! where 0 .LE. X(I) .LT. B for I=1,...,T, +! 0 .LT. X(1), and EMIN .LE. E .LE. EMAX. +! I1MACH(10) = B, the base. +! +! Single-Precision +! I1MACH(11) = T, the number of base-B digits. +! I1MACH(12) = EMIN, the smallest exponent E. +! I1MACH(13) = EMAX, the largest exponent E. +! +! Double-Precision +! I1MACH(14) = T, the number of base-B digits. +! I1MACH(15) = EMIN, the smallest exponent E. +! I1MACH(16) = EMAX, the largest exponent E. +! +! To alter this function for a particular environment, +! the desired set of DATA statements should be activated by +! removing the C from column 1. Also, the values of +! I1MACH(1) - I1MACH(4) should be checked for consistency +! with the local operating system. +!***REFERENCES FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A +! PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL +! SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188. +!ROUTINES CALLED (NONE) +!***END PROLOGUE I1MACH +! +!INTEGER:: I1MACH, I + integer:: i + INTEGER:: IMACH(16),OUTPUT + EQUIVALENCE (IMACH(4),OUTPUT) +! +! MACHINE CONSTANTS FOR THE IBM RS 6000 +! USING THE 32 BIT INTEGER COMPILER OPTION +! +! === MACHINE = 1 .32-BIT-INTEGER + DATA IMACH( 1) / 5 / + DATA IMACH( 2) / 6 / + DATA IMACH( 3) / 6 / + DATA IMACH( 4) / 0 / + DATA IMACH( 5) / 32 / + DATA IMACH( 6) / 4 / + DATA IMACH( 7) / 2 / + DATA IMACH( 8) / 31 / + DATA IMACH( 9) / 2147483647 / + DATA IMACH(10) / 2 / + DATA IMACH(11) / 24 / + DATA IMACH(12) / -125 / + DATA IMACH(13) / 128 / + DATA IMACH(14) / 53 / + DATA IMACH(15) /-1021 / + DATA IMACH(16) / 1024 / +! +!***FIRST EXECUTABLE STATEMENT I1MACH + IF (I .LT. 1 .OR. I .GT. 16) THEN + CALL XERROR ( 'I1MACH -- I OUT OF BOUNDS',25,1,2) + I1MACH=IMACH(I) + ENDIF + RETURN + END function I1MACH diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/J4SAVE.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/J4SAVE.f deleted file mode 100644 index 630238cda..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/J4SAVE.f +++ /dev/null @@ -1,51 +0,0 @@ - FUNCTION J4SAVE(IWHICH,IVALUE,ISET) -C***BEGIN PROLOGUE J4SAVE -C***REFER TO XERROR -C Abstract -C J4SAVE saves and recalls several global variables needed -C by the library error handling routines. -C -C Description of Parameters -C --Input-- -C IWHICH - Index of item desired. -C = 1 Refers to current error number. -C = 2 Refers to current error control flag. -C = 3 Refers to current unit number to which error -C messages are to be sent. (0 means use standard.) -C = 4 Refers to the maximum number of times any -C message is to be printed (as set by XERMAX). -C = 5 Refers to the total number of units to which -C each error message is to be written. -C = 6 Refers to the 2nd unit for error messages -C = 7 Refers to the 3rd unit for error messages -C = 8 Refers to the 4th unit for error messages -C = 9 Refers to the 5th unit for error messages -C IVALUE - The value to be set for the IWHICH-th parameter, -C if ISET is .TRUE. . -C ISET - If ISET=.TRUE., the IWHICH-th parameter will BE -C given the value, IVALUE. If ISET=.FALSE., the -C IWHICH-th parameter will be unchanged, and IVALUE -C is a dummy parameter. -C --Output-- -C The (old) value of the IWHICH-th parameter will be returned -C in the function value, J4SAVE. -C -C Written by Ron Jones, with SLATEC Common Math Library Subcommittee -C Adapted from Bell Laboratories PORT Library Error Handler -C Latest revision --- 23 MAY 1979 -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED (NONE) -C***END PROLOGUE J4SAVE - LOGICAL ISET - INTEGER IPARAM(9) - SAVE IPARAM - DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/ - DATA IPARAM(5)/1/ - DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/ -C***FIRST EXECUTABLE STATEMENT J4SAVE - J4SAVE = IPARAM(IWHICH) - IF (ISET) IPARAM(IWHICH) = IVALUE - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/J4SAVE.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/J4SAVE.f90 new file mode 100644 index 000000000..49d428a33 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/J4SAVE.f90 @@ -0,0 +1,59 @@ + FUNCTION J4SAVE(IWHICH,IVALUE,ISET) +!***BEGIN PROLOGUE J4SAVE +!***REFER TO XERROR +! Abstract +! J4SAVE saves and recalls several global variables needed +! by the library error handling routines. +! +! Description of Parameters +!--Input-- +! IWHICH - Index of item desired. +! = 1 Refers to current error number. +! = 2 Refers to current error control flag. +! = 3 Refers to current unit number to which error +! messages are to be sent. (0 means use standard.) +! = 4 Refers to the maximum number of times any +! message is to be printed (as set by XERMAX). +! = 5 Refers to the total number of units to which +! each error message is to be written. +! = 6 Refers to the 2nd unit for error messages +! = 7 Refers to the 3rd unit for error messages +! = 8 Refers to the 4th unit for error messages +! = 9 Refers to the 5th unit for error messages +! IVALUE - The value to be set for the IWHICH-th parameter, +! if ISET is .TRUE. . +! ISET - If ISET=.TRUE., the IWHICH-th parameter will BE +! given the value, IVALUE. If ISET=.FALSE., the +! IWHICH-th parameter will be unchanged, and IVALUE +! is a dummy parameter. +!--Output-- +! The (old) value of the IWHICH-th parameter will be returned +! in the function value, J4SAVE. +! +! Written by Ron Jones, with SLATEC Common Math Library Subcommittee +! Adapted from Bell Laboratories PORT Library Error Handler +! Latest revision --- 23 MAY 1979 +!***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" +! HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," +! 1982. +!***ROUTINES CALLED (NONE) +!***END PROLOGUE J4SAVE + implicit none + + integer IPARAM(9) + logical iset + integer ivalue + integer iwhich + integer j4save + + SAVE IPARAM + DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/ + DATA IPARAM(5)/1/ + DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/ + !***FIRST EXECUTABLE STATEMENT J4SAVE + J4SAVE = IPARAM(IWHICH) + IF (ISET) THEN + IPARAM(IWHICH) = IVALUE + ENDIF + RETURN + END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/Makefile b/sorc/hafs_tools.fd/sorc/hafs_vi/split/Makefile index aa40f5fea..48aebc302 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/Makefile +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/Makefile @@ -1,11 +1,11 @@ include ../configure.vi include ../pure-openmp.inc -SRCS = modules.f split.f BOUND.f fft99.f sig_p_convt.f \ - SEPAR.f WNLIT.f FDUMP.f H12.f I1MACH.f J4SAVE.f XGETUA.f \ - WNLSM.f WNNLS.f XERABT.f XERCTL.f XERPRT.f XERROR.f XERRWV.f \ - XERSAV.f srotm.f srotmg.f amatrix.f rodist.f landcmsk.f \ - create_rel_domain.f +SRCS = modules.f90 split.f90 BOUND.f90 fft99.f90 sig_p_convt.f90 \ + SEPAR.f90 WNLIT.f90 FDUMP.f90 H12.f90 I1MACH.f90 J4SAVE.f90 XGETUA.f90 \ + WNLSM.f90 WNNLS.f90 XERABT.f90 XERCTL.f90 XERPRT.f90 XERROR.f XERRWV.f90 \ + XERSAV.f90 srotm.f90 srotmg.f90 amatrix.f90 rodist.f90 landcmsk.f90 \ + create_rel_domain.f90 OBJS = modules.o split.o BOUND.o fft99.o sig_p_convt.o \ SEPAR.o WNLIT.o FDUMP.o H12.o I1MACH.o J4SAVE.o XGETUA.o \ diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/SEPAR.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/SEPAR.f deleted file mode 100644 index c3fa9b219..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/SEPAR.f +++ /dev/null @@ -1,146 +0,0 @@ - SUBROUTINE SEPAR(XD,XM) -C -C SEPERATES A FIELD INTO HURRICANE COMPONENT AND REMAINDER -C - - PARAMETER( NMX=24,nmx1=nmx+1,nmx2=nmx*2,nmx6=nmx*6) - PARAMETER (IMX=41 , JMX=41) - DIMENSION XR(NMX),XD(IMX,JMX) -CC - COMMON /POSIT/ XOLD,YOLD,XCORN,YCORN - COMMON /XXX/ XF(IMX,JMX),XC,YC,DX,DY - dimension XM(IMX,JMX) -C -c new arrays - dimension b(nmx),w(nmx),ab(nmx,nmx1),ipvt(nmx) - 1 ,wrk(nmx6),iwrk(nmx2) - common /matrix/ a(nmx,nmx),capd2 - common /vect/rovect(nmx),xvect(nmx),yvect(nmx) -c - DATA XR/24*0./ -C -C XC,YC ARE HURRICANE COORDINATES -C RO IS RADIUS AT WHICH HURRICANE COMPONENT OF FIELD GOES TO ZERO -C XR ARRAY CONTAINS THE FIELD VALUES OF 12 EQUALLY SPACED POINTS -C ON CIRCLE OF RADIUS RO CENTERED AT XC,YC -C -c set ro to be max value of rovect -c - ro=0. - do 22 i=1,nmx - ro=amax1(ro,rovect(i)) -22 continue - PI = 4.*ATAN(1.0) - PI180 = 4.*ATAN(1.0)/180. -c qliu FACT = COS(YOLD*PI180) - FACT = 1.0 -c DDEL=1.0*PI180 -c DTHA=1.0*PI180 -CC -CC XC IS THE I POSITION OF THE CENTER OF THE OLD VORTEX -CC YC IS THE J POSITION OF THE CENTER OF THE OLD VORTEX -CC DDEL IS THE LONG. IN RADIANS OF THE OUTER NEST -CC DTHA IS THE LAT. IN RADIANS OF THE OUTER NEST -CC -c no fact here -c DX=FACT*DDEL/PI180 -c -c dx=ddel/pi180 -c DY=DTHA/PI180 - dx=1.0 - DY=1.0 -cc - XC = (XOLD-XCORN)*DX - YC = (YOLD-YCORN)*DY - IS=INT((XC-RO/fact)/DX) +1. - IE=INT((XC+RO/fact)/DX + 1.) - JS=INT((YC-RO)/DY) +1. - JE=INT((YC+RO)/DY + 1.) -C - DO 1 J = 1 , JMX - DO 1 I = 1 , IMX - XF(I,J) = XD(I,J) -1 CONTINUE -C -C SUBROUTINE BOUND COMPUTES FIELD VALUES OF ARRAY XR USING -C BILINEAR INTERPOLATION -C -c - CALL BOUND(NMX,XR,rovect) - -C -c xrop(nmx) are the interpolated values of the disturbance -c field at the rovect pts -c -c romax is the maximum value in rovect(nmx). Within the loop a local -c ro is computed for use in the separation. At the start of the loop -c ro is again set to romax to define the domain. -c -c -c - w=0. - romax=ro -C - DO 10 IX=IS,IE - DO 11 JY=JS,JE - ro=romax -c X=XC-RO +DX*(IX-IS) -c Y=YC-RO +DY*(JY-JS) - X= DX*float(IX) -1. - Y= DY*float(JY) -1. - delx=(x-xc)*fact - dely=(y-yc) - DR=SQRT((delx)**2 +(dely)**2) - IF(DR.GT.RO)GOTO11 - IF(delx.ne.0.) THETA=ATAN((dely)/(delx)) - if(delx.eq.0..and.dely.lt.0.)theta=270.*pi180 - if(delx.eq.0..and.dely.gt.0.)theta=90. *pi180 - IF(delx.LT.0.)THETA=THETA+PI - IF(THETA.LT.0.)THETA=2.*PI+THETA - N1=INT(THETA*NMX/(2.*PI)) - IF(N1.GT.nmx)PRINT*,N1,THETA*57.296 - IF(N1.LT.0)PRINT*,N1,THETA*57.296 - N2=N1+2 - IF(N2.GT.NMX)N2=N2-NMX - DELTH=THETA- 2.*PI*FLOAT(N1)/FLOAT(NMX) -c - ro=delth*float(nmx)/(2.*pi)*(rovect(n2)-rovect(n1+1)) - 1 +rovect(n1+1) - IF(DR.GT.ro)GOTO11 - XRO=DELTH*FLOAT(NMX)/(2.*PI)*(XR(N2)-XR(N1+1)) +XR(N1+1) -CC -c Now add new code to compute distance from each gridpt. to rovect pts -c - do 12 ip=1,nmx - dpij= (fact*(x-xvect(ip)))**2 +(y-yvect(ip))**2 - b(ip)=exp(-dpij/capd2) -12 continue -c -c - do 44 ip=1,nmx - do 43 jp=1,nmx -43 ab(ip,jp)=a(ip,jp) - ab(ip,nmx1)=b(ip) -44 continue -c -c solve system using constrained least squares method -c - call wnnls(ab,nmx,0,nmx,nmx,0,1.,w,rnm,md,iwrk,wrk) -c - temp=0. - do 20 ip=1,nmx - temp=temp +w(ip)*xr(ip) -20 continue -c xh(ix,jy)=xf(ix,jy)-temp -c qliu xd(ix,jy)=temp - xm(ix,jy)=temp -11 CONTINUE -10 CONTINUE -c print*,'qliu test2' - do j=1,jmx - do i=1,imx -c print*,xf(i,j),xd(i,j),xf(i,j)-xd(i,j),i,j - end do - end do - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/SEPAR.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/SEPAR.f90 new file mode 100644 index 000000000..8b43310ae --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/SEPAR.f90 @@ -0,0 +1,154 @@ + SUBROUTINE SEPAR(XD,XM) +!C +!C SEPERATES A FIELD INTO HURRICANE COMPONENT AND REMAINDER +!C + use matrix, only: a, capd2 + use vect + use posit + use xxx + + implicit none + integer, parameter :: nmx1=nmx+1,nmx2=nmx*2,nmx6=nmx*6 + real XR(NMX),XD(IMX,JMX) + real:: ro,x,y,romax,delx,dely,dr,temp,theta,delth,xro,dpij,rnm + integer::ip,jp,jy,i,j,is,ie,js,je,n1,n2,ix,md + real pi,pi180,fact + +!CC + real XM(IMX,JMX) +!C +!c new arrays + real b(nmx),w(nmx),ab(nmx,nmx1),ipvt(nmx) + real wrk(nmx6),iwrk(nmx2) + + DATA XR/24*0./ +!C +!C XC,YC ARE HURRICANE COORDINATES +!C RO IS RADIUS AT WHICH HURRICANE COMPONENT OF FIELD GOES TO ZERO +!C XR ARRAY CONTAINS THE FIELD VALUES OF 12 EQUALLY SPACED POINTS +!C ON CIRCLE OF RADIUS RO CENTERED AT XC,YC +!C +!c set ro to be max value of rovect +!c + ro=0. + do i=1,nmx + ro=amax1(ro,rovect(i)) + enddo + PI = 4.*ATAN(1.0) + PI180 = 4.*ATAN(1.0)/180. +!c qliu FACT = COS(YOLD*PI180) + FACT = 1.0 +!c DDEL=1.0*PI180 +!c DTHA=1.0*PI180 +!CC +!CC XC IS THE I POSITION OF THE CENTER OF THE OLD VORTEX +!CC YC IS THE J POSITION OF THE CENTER OF THE OLD VORTEX +!CC DDEL IS THE LONG. IN RADIANS OF THE OUTER NEST +!CC DTHA IS THE LAT. IN RADIANS OF THE OUTER NEST +!CC +!c no fact here +!c DX=FACT*DDEL/PI180 +!c +!c dx=ddel/pi180 +!c DY=DTHA/PI180 + dx=1.0 + DY=1.0 +!cc + XC = (XOLD-XCORN)*DX + YC = (YOLD-YCORN)*DY + IS=INT((XC-RO/fact)/DX) +1. + IE=INT((XC+RO/fact)/DX + 1.) + JS=INT((YC-RO)/DY) +1. + JE=INT((YC+RO)/DY + 1.) +!C + DO J = 1 , JMX + DO I = 1 , IMX + XF(I,J) = XD(I,J) + enddo + enddo +!1 CONTINUE +!C +!C SUBROUTINE BOUND COMPUTES FIELD VALUES OF ARRAY XR USING +!C BILINEAR INTERPOLATION +!C +!c + CALL BOUND(NMX,XR,rovect) + +!C +!c xrop(nmx) are the interpolated values of the disturbance +!c field at the rovect pts +!c +!c romax is the maximum value in rovect(nmx). Within the loop a local +!c ro is computed for use in the separation. At the start of the loop +!c ro is again set to romax to define the domain. +!c +!c +!c + w=0. + romax=ro +!C + ixloop: DO IX=IS,IE + jyloop: DO JY=JS,JE + ro=romax +!c X=XC-RO +DX*(IX-IS) +!c Y=YC-RO +DY*(JY-JS) + X= DX*float(IX) -1. + Y= DY*float(JY) -1. + delx=(x-xc)*fact + dely=(y-yc) + DR=SQRT((delx)**2 +(dely)**2) + IF(DR.GT.RO) cycle jyloop + IF(delx.ne.0.) THETA=ATAN((dely)/(delx)) + if(delx.eq.0..and.dely.lt.0.)theta=270.*pi180 + if(delx.eq.0..and.dely.gt.0.)theta=90. *pi180 + IF(delx.LT.0.)THETA=THETA+PI + IF(THETA.LT.0.)THETA=2.*PI+THETA + N1=INT(THETA*NMX/(2.*PI)) + IF(N1.GT.nmx)PRINT*,N1,THETA*57.296 + IF(N1.LT.0)PRINT*,N1,THETA*57.296 + N2=N1+2 + IF(N2.GT.NMX)N2=N2-NMX + DELTH=THETA- 2.*PI*FLOAT(N1)/FLOAT(NMX) +!c + ro=delth*float(nmx)/(2.*pi)*(rovect(n2)-rovect(n1+1)) & + +rovect(n1+1) + IF(DR.GT.ro) cycle jyloop + XRO=DELTH*FLOAT(NMX)/(2.*PI)*(XR(N2)-XR(N1+1)) +XR(N1+1) +!CC +!c Now add new code to compute distance from each gridpt. to rovect pts + do ip=1,nmx + dpij= (fact*(x-xvect(ip)))**2 +(y-yvect(ip))**2 + b(ip)=exp(-dpij/capd2) + enddo +!c +!c + do ip=1,nmx + do jp=1,nmx +!43 ab(ip,jp)=a(ip,jp) + ab(ip,jp)=a(ip,jp) + enddo + ab(ip,nmx1)=b(ip) + enddo +!c +!c solve system using constrained least squares method +!c + call wnnls(ab,nmx,0,nmx,nmx,0,1.,w,rnm,md,iwrk,wrk) +!c + temp=0. + do ip=1,nmx + temp=temp +w(ip)*xr(ip) + enddo +!c xh(ix,jy)=xf(ix,jy)-temp +!c qliu xd(ix,jy)=temp + xm(ix,jy)=temp + enddo jyloop !11 + enddo ixloop !10 + +!c print*,'qliu test2' +! do j=1,jmx +! do i=1,imx +!c print*,xf(i,j),xd(i,j),xf(i,j)-xd(i,j),i,j +! end do +! end do + RETURN + END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLIT.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLIT.f deleted file mode 100644 index 16c218215..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLIT.f +++ /dev/null @@ -1,437 +0,0 @@ - SUBROUTINE WNLIT(W,MDW,M,N,L,IPIVOT,ITYPE,H,SCALE,RNORM,IDOPE, - 1 DOPE,DONE) -C***BEGIN PROLOGUE WNLIT -C***REFER TO WNNLS -C -C This is a companion subprogram to WNNLS( ). -C The documentation for WNNLS( ) has more complete -C usage instructions. -C -C Note The M by (N+1) matrix W( , ) contains the rt. hand side -C B as the (N+1)st col. -C -C Triangularize L1 by L1 subsystem, where L1=MIN(M,L), with -C col interchanges. -C Revised March 4, 1982. -C***ROUTINES CALLED H12,ISAMAX,SCOPY,SROTM,SROTMG,SSCAL,SSWAP -C***END PROLOGUE WNLIT -C -C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO -C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. -C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. -C (BEGIN CHANGES AT LINE WITH C++ IN COLS. 1-3.) -C /REAL (12 BLANKS)/DOUBLE PRECISION/,/SCOPY/DCOPY/,/SROTM/DROTM/, -C /SSCAL/DSCAL/, -C /SSWAP/DSWAP/,/AMAX1/DMAX1/,/ISAMAX/IDAMAX/,/.E-/.D-/,/E0/D0/ -C -C++ - USE setparms -c - REAL W(MDW,1), H(1), SCALE(1), DOPE(4), SPARAM(5) - REAL ALSQ, AMAX, EANORM, FAC, FACTOR, HBAR, ONE, RN - REAL RNORM, SN, T, TAU, TENM3, ZERO - REAL AMAX1 - INTEGER ITYPE(1), IPIVOT(1), IDOPE(8) - integer(kind = int_single) ISAMAX,IDAMAX - LOGICAL INDEP, DONE, RECALC - DATA TENM3 /1.E-3/, ZERO /0.E0/, ONE /1.E0/ -C -C***FIRST EXECUTABLE STATEMENT WNLIT - ME = IDOPE(1) - MEP1 = IDOPE(2) - KRANK = IDOPE(3) - KRP1 = IDOPE(4) - NSOLN = IDOPE(5) - NIV = IDOPE(6) - NIV1 = IDOPE(7) - L1 = IDOPE(8) -C - ALSQ = DOPE(1) - EANORM = DOPE(2) - FAC = DOPE(3) - TAU = DOPE(4) - NP1 = N + 1 - LB = MIN0(M-1,L) - RECALC = .TRUE. - RNORM = ZERO - KRANK = 0 -C WE SET FACTOR=1.E0 SO THAT THE HEAVY WEIGHT ALAMDA WILL BE -C INCLUDED IN THE TEST FOR COL INDEPENDENCE. - FACTOR = 1.E0 - I = 1 - IP1 = 2 - LEND = L - 10 IF (.NOT.(I.LE.LB)) GO TO 150 -C -C SET IR TO POINT TO THE I-TH ROW. - IR = I - MEND = M - ASSIGN 20 TO IGO996 - GO TO 460 -C -C UPDATE-COL-SS-AND-FIND-PIVOT-COL - 20 ASSIGN 30 TO IGO993 - GO TO 560 -C -C PERFORM-COL-INTERCHANGE -C -C SET IC TO POINT TO I-TH COL. - 30 IC = I - ASSIGN 40 TO IGO990 - GO TO 520 -C -C TEST-INDEP-OF-INCOMING-COL - 40 IF (.NOT.(INDEP)) GO TO 110 -C -C ELIMINATE I-TH COL BELOW DIAG. USING MOD. GIVENS TRANSFORMATIONS -C APPLIED TO (A B). - J = M - DO 100 JJ=IP1,M - JM1 = J - 1 - JP = JM1 -C WHEN OPERATING NEAR THE ME LINE, USE THE LARGEST ELT. -C ABOVE IT AS THE PIVOT. - IF (.NOT.(J.EQ.MEP1)) GO TO 80 - IMAX = ME - AMAX = SCALE(ME)*W(ME,I)**2 - 50 IF (.NOT.(JP.GE.I)) GO TO 70 - T = SCALE(JP)*W(JP,I)**2 - IF (.NOT.(T.GT.AMAX)) GO TO 60 - IMAX = JP - AMAX = T - 60 JP = JP - 1 - GO TO 50 - 70 JP = IMAX - 80 IF (.NOT.(W(J,I).NE.ZERO)) GO TO 90 - CALL SROTMG(SCALE(JP), SCALE(J), W(JP,I), W(J,I), SPARAM) - W(J,I) = ZERO - CALL SROTM(NP1-I, W(JP,IP1), MDW, W(J,IP1), MDW, SPARAM) - 90 J = JM1 - 100 CONTINUE - GO TO 140 - 110 CONTINUE - IF (.NOT.(LEND.GT.I)) GO TO 130 -C -C COL I IS DEPENDENT. SWAP WITH COL LEND. - MAX = LEND -C -C PERFORM-COL-INTERCHANGE - ASSIGN 120 TO IGO993 - GO TO 560 - 120 CONTINUE - LEND = LEND - 1 -C -C FIND COL IN REMAINING SET WITH LARGEST SS. - if (kind(H) == real_single) then - MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1 - else if (kind(H) == real_double) then - MAX = IDAMAX(LEND-I+1,H(I),1) + I - 1 - endif - HBAR = H(MAX) - GO TO 30 - 130 CONTINUE - KRANK = I - 1 - GO TO 160 - 140 I = IP1 - IP1 = IP1 + 1 - GO TO 10 - 150 KRANK = L1 - 160 CONTINUE - KRP1 = KRANK + 1 - IF (.NOT.(KRANK.LT.ME)) GO TO 290 - FACTOR = ALSQ - DO 170 I=KRP1,ME - IF (L.GT.0) W(I,1) = ZERO - if (kind(W) == real_single) then - CALL SCOPY(L, W(I,1), 0, W(I,1), MDW) - else if (kind(W) == real_double) then - CALL DCOPY(L, W(I,1), 0, W(I,1), MDW) - endif - 170 CONTINUE -C -C DETERMINE THE RANK OF THE REMAINING EQUALITY CONSTRAINT -C EQUATIONS BY ELIMINATING WITHIN THE BLOCK OF CONSTRAINED -C VARIABLES. REMOVE ANY REDUNDANT CONSTRAINTS. - LP1 = L + 1 - RECALC = .TRUE. - LB = MIN0(L+ME-KRANK,N) - I = LP1 - IP1 = I + 1 - 180 IF (.NOT.(I.LE.LB)) GO TO 280 - IR = KRANK + I - L - LEND = N - MEND = ME - ASSIGN 190 TO IGO996 - GO TO 460 -C -C UPDATE-COL-SS-AND-FIND-PIVOT-COL - 190 ASSIGN 200 TO IGO993 - GO TO 560 -C -C PERFORM-COL-INTERCHANGE -C -C ELIMINATE ELEMENTS IN THE I-TH COL. - 200 J = ME - 210 IF (.NOT.(J.GT.IR)) GO TO 230 - JM1 = J - 1 - IF (.NOT.(W(J,I).NE.ZERO)) GO TO 220 - CALL SROTMG(SCALE(JM1), SCALE(J), W(JM1,I), W(J,I), SPARAM) - W(J,I) = ZERO - CALL SROTM(NP1-I, W(JM1,IP1), MDW, W(J,IP1), MDW, SPARAM) - 220 J = JM1 - GO TO 210 -C -C SET IC=I=COL BEING ELIMINATED - 230 IC = I - ASSIGN 240 TO IGO990 - GO TO 520 -C -C TEST-INDEP-OF-INCOMING-COL - 240 IF (INDEP) GO TO 270 -C -C REMOVE ANY REDUNDANT OR DEPENDENT EQUALITY CONSTRAINTS. - JJ = IR - 250 IF (.NOT.(IR.LE.ME)) GO TO 260 - W(IR,1) = ZERO - - if (kind(W) == real_single) then - CALL SCOPY(N, W(IR,1), 0, W(IR,1), MDW) - else if (kind(W) == real_double) then - CALL DCOPY(N, W(IR,1), 0, W(IR,1), MDW) - endif - - RNORM = RNORM + (SCALE(IR)*W(IR,NP1)/ALSQ)*W(IR,NP1) - W(IR,NP1) = ZERO - SCALE(IR) = ONE -C RECLASSIFY THE ZEROED ROW AS A LEAST SQUARES EQUATION. - ITYPE(IR) = 1 - IR = IR + 1 - GO TO 250 -C -C REDUCE ME TO REFLECT ANY DISCOVERED DEPENDENT EQUALITY -C CONSTRAINTS. - 260 CONTINUE - ME = JJ - 1 - MEP1 = ME + 1 - GO TO 300 - 270 I = IP1 - IP1 = IP1 + 1 - GO TO 180 - 280 CONTINUE - 290 CONTINUE - 300 CONTINUE - IF (.NOT.(KRANK.LT.L1)) GO TO 420 -C -C TRY TO DETERMINE THE VARIABLES KRANK+1 THROUGH L1 FROM THE -C LEAST SQUARES EQUATIONS. CONTINUE THE TRIANGULARIZATION WITH -C PIVOT ELEMENT W(MEP1,I). -C - RECALC = .TRUE. -C -C SET FACTOR=ALSQ TO REMOVE EFFECT OF HEAVY WEIGHT FROM -C TEST FOR COL INDEPENDENCE. - FACTOR = ALSQ - KK = KRP1 - I = KK - IP1 = I + 1 - 310 IF (.NOT.(I.LE.L1)) GO TO 410 -C -C SET IR TO POINT TO THE MEP1-ST ROW. - IR = MEP1 - LEND = L - MEND = M - ASSIGN 320 TO IGO996 - GO TO 460 -C -C UPDATE-COL-SS-AND-FIND-PIVOT-COL - 320 ASSIGN 330 TO IGO993 - GO TO 560 -C -C PERFORM-COL-INTERCHANGE -C -C ELIMINATE I-TH COL BELOW THE IR-TH ELEMENT. - 330 IRP1 = IR + 1 - J = M - DO 350 JJ=IRP1,M - JM1 = J - 1 - IF (.NOT.(W(J,I).NE.ZERO)) GO TO 340 - CALL SROTMG(SCALE(JM1), SCALE(J), W(JM1,I), W(J,I), SPARAM) - W(J,I) = ZERO - CALL SROTM(NP1-I, W(JM1,IP1), MDW, W(J,IP1), MDW, SPARAM) - 340 J = JM1 - 350 CONTINUE -C -C TEST IF NEW PIVOT ELEMENT IS NEAR ZERO. IF SO, THE COL IS -C DEPENDENT. - T = SCALE(IR)*W(IR,I)**2 - INDEP = T.GT.TAU**2*EANORM**2 - IF (.NOT.INDEP) GO TO 380 -C -C COL TEST PASSED. NOW MUST PASS ROW NORM TEST TO BE CLASSIFIED -C AS INDEPENDENT. - RN = ZERO - DO 370 I1=IR,M - DO 360 J1=IP1,N - RN = AMAX1(RN,SCALE(I1)*W(I1,J1)**2) - 360 CONTINUE - 370 CONTINUE - INDEP = T.GT.TAU**2*RN -C -C IF INDEPENDENT, SWAP THE IR-TH AND KRP1-ST ROWS TO MAINTAIN THE -C TRIANGULAR FORM. UPDATE THE RANK INDICATOR KRANK AND THE -C EQUALITY CONSTRAINT POINTER ME. - 380 IF (.NOT.(INDEP)) GO TO 390 - if (kind(W) == real_single) then - CALL SSWAP(NP1, W(KRP1,1), MDW, W(IR,1), MDW) - else if (kind(W) == real_double) then - CALL DSWAP(NP1, W(KRP1,1), MDW, W(IR,1), MDW) - endif - if (kind(SCALE) == real_single) then - CALL SSWAP(1, SCALE(KRP1), 1, SCALE(IR), 1) - else if (kind(SCALE) == real_double) then - CALL DSWAP(1, SCALE(KRP1), 1, SCALE(IR), 1) - endif -C RECLASSIFY THE LEAST SQ. EQUATION AS AN EQUALITY CONSTRAINT AND -C RESCALE IT. - ITYPE(IR) = 0 - T = SQRT(SCALE(KRP1)) - - if (kind(W) == real_single) then - CALL SSCAL(NP1, T, W(KRP1,1), MDW) - else if (kind(W) == real_double) then - CALL DSCAL(NP1, T, W(KRP1,1), MDW) - endif - - SCALE(KRP1) = ALSQ - ME = MEP1 - MEP1 = ME + 1 - KRANK = KRP1 - KRP1 = KRANK + 1 - GO TO 400 - 390 GO TO 430 - 400 I = IP1 - IP1 = IP1 + 1 - GO TO 310 - 410 CONTINUE - 420 CONTINUE - 430 CONTINUE -C -C IF PSEUDORANK IS LESS THAN L, APPLY HOUSEHOLDER TRANS. -C FROM RIGHT. - IF (.NOT.(KRANK.LT.L)) GO TO 450 - DO 440 I=1,KRANK - J = KRP1 - I - CALL H12(1, J, KRP1, L, W(J,1), MDW, H(J), W, MDW, 1, J-1) - 440 CONTINUE - 450 NIV = KRANK + NSOLN - L - NIV1 = NIV + 1 - IF (L.EQ.N) DONE = .TRUE. -C -C END OF INITIAL TRIANGULARIZATION. - IDOPE(1) = ME - IDOPE(2) = MEP1 - IDOPE(3) = KRANK - IDOPE(4) = KRP1 - IDOPE(5) = NSOLN - IDOPE(6) = NIV - IDOPE(7) = NIV1 - IDOPE(8) = L1 - RETURN - 460 CONTINUE -C -C TO UPDATE-COL-SS-AND-FIND-PIVOT-COL -C -C THE COL SS VECTOR WILL BE UPDATED AT EACH STEP. WHEN -C NUMERICALLY NECESSARY, THESE VALUES WILL BE RECOMPUTED. -C - IF (.NOT.(IR.NE.1 .AND. (.NOT.RECALC))) GO TO 480 -C UPDATE COL SS =SUM OF SQUARES. - DO 470 J=I,LEND - H(J) = H(J) - SCALE(IR-1)*W(IR-1,J)**2 - 470 CONTINUE -C -C TEST FOR NUMERICAL ACCURACY. - if (kind(H) == real_single) then - MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1 - else if (kind(H) == real_double) then - MAX = IDAMAX(LEND-I+1,H(I),1) + I - 1 - endif - RECALC = HBAR + TENM3*H(MAX).EQ.HBAR -C -C IF REQUIRED, RECALCULATE COL SS, USING ROWS IR THROUGH MEND. - 480 IF (.NOT.(RECALC)) GO TO 510 - DO 500 J=I,LEND - H(J) = ZERO - DO 490 K=IR,MEND - H(J) = H(J) + SCALE(K)*W(K,J)**2 - 490 CONTINUE - 500 CONTINUE -C -C FIND COL WITH LARGEST SS. - if (kind(H) == real_single) then - MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1 - else if (kind(H) == real_double) then - MAX = IDAMAX(LEND-I+1,H(I),1) + I - 1 - endif - - HBAR = H(MAX) - 510 GO TO 600 - 520 CONTINUE -C -C TO TEST-INDEP-OF-INCOMING-COL -C -C TEST THE COL IC TO DETERMINE IF IT IS LINEARLY INDEPENDENT -C OF THE COLS ALREADY IN THE BASIS. IN THE INIT TRI -C STEP, WE USUALLY WANT THE HEAVY WEIGHT ALAMDA TO -C BE INCLUDED IN THE TEST FOR INDEPENDENCE. IN THIS CASE THE -C VALUE OF FACTOR WILL HAVE BEEN SET TO 1.E0 BEFORE THIS -C PROCEDURE IS INVOKED. IN THE POTENTIALLY RANK DEFICIENT -C PROBLEM, THE VALUE OF FACTOR WILL HAVE BEEN -C SET TO ALSQ=ALAMDA**2 TO REMOVE THE EFFECT OF THE HEAVY WEIGHT -C FROM THE TEST FOR INDEPENDENCE. -C -C WRITE NEW COL AS PARTITIONED VECTOR -C (A1) NUMBER OF COMPONENTS IN SOLN SO FAR = NIV -C (A2) M-NIV COMPONENTS -C AND COMPUTE SN = INVERSE WEIGHTED LENGTH OF A1 -C RN = INVERSE WEIGHTED LENGTH OF A2 -C CALL THE COL INDEPENDENT WHEN RN .GT. TAU*SN - SN = ZERO - RN = ZERO - DO 550 J=1,MEND - T = SCALE(J) - IF (J.LE.ME) T = T/FACTOR - T = T*W(J,IC)**2 - IF (.NOT.(J.LT.IR)) GO TO 530 - SN = SN + T - GO TO 540 - 530 RN = RN + T - 540 CONTINUE - 550 CONTINUE - INDEP = RN.GT.TAU**2*SN - GO TO 590 - 560 CONTINUE -C -C TO PERFORM-COL-INTERCHANGE -C - IF (.NOT.(MAX.NE.I)) GO TO 570 -C EXCHANGE ELEMENTS OF PERMUTED INDEX VECTOR AND PERFORM COL -C INTERCHANGES. - ITEMP = IPIVOT(I) - IPIVOT(I) = IPIVOT(MAX) - IPIVOT(MAX) = ITEMP - - if (kind(W) == real_single) then - CALL SSWAP(M, W(1,MAX), 1, W(1,I), 1) - else if (kind(W) == real_double) then - CALL DSWAP(M, W(1,MAX), 1, W(1,I), 1) - endif - - T = H(MAX) - H(MAX) = H(I) - H(I) = T - 570 GO TO 580 - 580 GO TO IGO993, (30, 200, 330, 120) - 590 GO TO IGO990, (40, 240) - 600 GO TO IGO996, (20, 190, 320) - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLIT.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLIT.f90 new file mode 100644 index 000000000..038e84475 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLIT.f90 @@ -0,0 +1,491 @@ + SUBROUTINE WNLIT(W,MDW,M,N,L,IPIVOT,ITYPE,H,SCALE,RNORM,IDOPE, & + DOPE,DONE) +!C***BEGIN PROLOGUE WNLIT +!C***REFER TO WNNLS +!C +!C This is a companion subprogram to WNNLS( ). +!C The documentation for WNNLS( ) has more complete +!C usage instructions. +!C +!C Note The M by (N+1) matrix W( , ) contains the rt. hand side +!C B as the (N+1)st col. +!C +!C Triangularize L1 by L1 subsystem, where L1=MIN(M,L), with +!C col interchanges. +!C Revised March 4, 1982. +!C***ROUTINES CALLED H12,ISAMAX,SCOPY,SROTM,SROTMG,SSCAL,SSWAP +!C***END PROLOGUE WNLIT +!C +!C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO +!C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. +!C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. +!C (BEGIN CHANGES AT LINE WITH C++ IN COLS. 1-3.) +!C /REAL (12 BLANKS)/DOUBLE PRECISION/,/SCOPY/DCOPY/,/SROTM/DROTM/, +!C /SSCAL/DSCAL/, +!C /SSWAP/DSWAP/,/AMAX1/DMAX1/,/ISAMAX/IDAMAX/,/.E-/.D-/,/E0/D0/ +!C +!C++ + USE setparms + implicit none + integer LP, I, J, JJ, JP , JM1, ind, IC, I1, J1 + integer ME, MEP1, KRANK, KRP1, NSOLN, NIV, NIV1, L1 , N, M, L + integer IR, KK, IP1, MEND, IRP1, LP1, LEND, IMAX, MAX, MDW + real NP1, LB +!c + REAL W(MDW,1), H(1), SCALE(1), DOPE(4), SPARAM(5) + REAL ALSQ, AMAX, EANORM, FAC, FACTOR, HBAR, ONE, RN + REAL RNORM, SN, T, TAU, TENM3, ZERO + REAL AMAX1 + INTEGER ITYPE(1), IPIVOT(1), IDOPE(8) + integer(kind = int_single) ISAMAX,IDAMAX + LOGICAL INDEP, DONE, RECALC + DATA TENM3 /1.E-3/, ZERO /0.E0/, ONE /1.E0/ +!C +!C***FIRST EXECUTABLE STATEMENT WNLIT + ME = IDOPE(1) + MEP1 = IDOPE(2) + KRANK = IDOPE(3) + KRP1 = IDOPE(4) + NSOLN = IDOPE(5) + NIV = IDOPE(6) + NIV1 = IDOPE(7) + L1 = IDOPE(8) +!C + ALSQ = DOPE(1) + EANORM = DOPE(2) + FAC = DOPE(3) + TAU = DOPE(4) + NP1 = N + 1 + LB = MIN0(M-1,L) + RECALC = .TRUE. + RNORM = ZERO + KRANK = 0 +!C WE SET FACTOR=1.E0 SO THAT THE HEAVY WEIGHT ALAMDA WILL BE +!C INCLUDED IN THE TEST FOR COL INDEPENDENCE. + FACTOR = 1.E0 + I = 1 + IP1 = 2 + LEND = L + do + IF (.NOT.(I.LE.LB)) exit +!C +!C SET IR TO POINT TO THE I-TH ROW. + IR = I + MEND = M + call sub996 (I, LEND, MEND, IR, MDW, RECALC, IMAX, HBAR, H, & + SCALE, W) +!C +!C UPDATE-COL-SS-AND-FIND-PIVOT-COL + call sub993 (I, IMAX, M, MDW, IPIVOT, H, W) +!C +!C PERFORM-COL-INTERCHANGE +!C +!C SET IC TO POINT TO I-TH COL. + do + IC = I + call sub990(ME, MEND, IR, FACTOR, TAU, SCALE, W) + +!C +!C TEST-INDEP-OF-INCOMING-COL + IF ((INDEP)) then +!C +!C ELIMINATE I-TH COL BELOW DIAG. USING MOD. GIVENS TRANSFORMATIONS +!C APPLIED TO (A B). + J = M + DO JJ=IP1,M + JM1 = J - 1 + JP = JM1 +!C WHEN OPERATING NEAR THE ME LINE, USE THE LARGEST ELT. +!C ABOVE IT AS THE PIVOT. + IF ((J.EQ.MEP1)) then + IMAX = ME + AMAX = SCALE(ME)*W(ME,I)**2 + do + IF (.NOT.(JP.GE.I)) exit + T = SCALE(JP)*W(JP,I)**2 + IF (.NOT.(T.GT.AMAX)) then + IMAX = JP + AMAX = T + endif + JP = JP - 1 + enddo + JP = IMAX + endif + IF ((W(J,I).NE.ZERO)) then + CALL SROTMG(SCALE(JP), SCALE(J), W(JP,I), W(J,I), SPARAM) + W(J,I) = ZERO + CALL SROTM(NP1-I, W(JP,IP1), MDW, W(J,IP1), MDW, SPARAM) + endif + J = JM1 + enddo + ind=0 + exit + endif + + IF (.NOT.(LEND.GT.I)) exit +!C +!C COL I IS DEPENDENT. SWAP WITH COL LEND. + MAX = LEND +!C +!C PERFORM-COL-INTERCHANGE + call sub993 (I, IMAX, M, MDW, IPIVOT, H, W) + LEND = LEND - 1 +!C +!C FIND COL IN REMAINING SET WITH LARGEST SS. + if (kind(H) == real_single) then + MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1 + else if (kind(H) == real_double) then + MAX = IDAMAX(LEND-I+1,H(I),1) + I - 1 + endif + HBAR = H(MAX) + enddo + + if (ind.ne.0) then + KRANK = I - 1 + exit + else + I = IP1 + IP1 = IP1 + 1 + cycle + endif + enddo + KRANK = L1 + + KRP1 = KRANK + 1 + IF ((KRANK.LT.ME)) then + FACTOR = ALSQ + DO I=KRP1,ME + IF (L.GT.0) W(I,1) = ZERO + if (kind(W) == real_single) then + CALL SCOPY(L, W(I,1), 0, W(I,1), MDW) + else if (kind(W) == real_double) then + CALL DCOPY(L, W(I,1), 0, W(I,1), MDW) + endif + enddo +!C +!C DETERMINE THE RANK OF THE REMAINING EQUALITY CONSTRAINT +!C EQUATIONS BY ELIMINATING WITHIN THE BLOCK OF CONSTRAINED +!C VARIABLES. REMOVE ANY REDUNDANT CONSTRAINTS. + LP1 = L + 1 + RECALC = .TRUE. + LB = MIN0(L+ME-KRANK,N) + I = LP1 + IP1 = I + 1 + + do + IF (.NOT.(I.LE.LB)) exit + IR = KRANK + I - L + LEND = N + MEND = ME + call sub996 (I, LEND, MEND, IR, MDW, RECALC, IMAX, HBAR, H, & + SCALE, W) +!C +!C UPDATE-COL-SS-AND-FIND-PIVOT-COL + call sub993 (I, IMAX, M, MDW, IPIVOT, H, W) +!C +!C PERFORM-COL-INTERCHANGE +!C +!C ELIMINATE ELEMENTS IN THE I-TH COL. + J = ME + do + IF (.NOT.(J.GT.IR)) exit + JM1 = J - 1 + IF ((W(J,I).NE.ZERO)) then + CALL SROTMG(SCALE(JM1), SCALE(J), W(JM1,I), W(J,I), SPARAM) + W(J,I) = ZERO + CALL SROTM(NP1-I, W(JM1,IP1), MDW, W(J,IP1), MDW, SPARAM) + endif + J = JM1 + enddo +!C +!C SET IC=I=COL BEING ELIMINATED + IC = I + call sub990(ME, MEND, IR, FACTOR, TAU, SCALE, W) +!C +!C TEST-INDEP-OF-INCOMING-COL + IF (.NOT.INDEP) then +!C +!C REMOVE ANY REDUNDANT OR DEPENDENT EQUALITY CONSTRAINTS. + JJ = IR + do + IF (.NOT.(IR.LE.ME)) exit + W(IR,1) = ZERO + + if (kind(W) == real_single) then + CALL SCOPY(N, W(IR,1), 0, W(IR,1), MDW) + else if (kind(W) == real_double) then + CALL DCOPY(N, W(IR,1), 0, W(IR,1), MDW) + endif + + RNORM = RNORM + (SCALE(IR)*W(IR,NP1)/ALSQ)*W(IR,NP1) + W(IR,NP1) = ZERO + SCALE(IR) = ONE +!C RECLASSIFY THE ZEROED ROW AS A LEAST SQUARES EQUATION. + ITYPE(IR) = 1 + IR = IR + 1 + enddo +!C +!C REDUCE ME TO REFLECT ANY DISCOVERED DEPENDENT EQUALITY +!C CONSTRAINTS. + ME = JJ - 1 + MEP1 = ME + 1 + exit + else + I = IP1 + IP1 = IP1 + 1 + cycle + endif + enddo + endif + IF ((KRANK.LT.L1)) then +!C +!C TRY TO DETERMINE THE VARIABLES KRANK+1 THROUGH L1 FROM THE +!C LEAST SQUARES EQUATIONS. CONTINUE THE TRIANGULARIZATION WITH +!C PIVOT ELEMENT W(MEP1,I). +!C + RECALC = .TRUE. +!C +!C SET FACTOR=ALSQ TO REMOVE EFFECT OF HEAVY WEIGHT FROM +!C TEST FOR COL INDEPENDENCE. + FACTOR = ALSQ + KK = KRP1 + I = KK + IP1 = I + 1 + do + IF (.NOT.(I.LE.L1)) exit +!C +!C SET IR TO POINT TO THE MEP1-ST ROW. + IR = MEP1 + LEND = L + MEND = M + call sub996 (I, LEND, MEND, IR, MDW, RECALC, IMAX, HBAR, H, & + SCALE, W) +!C +!C UPDATE-COL-SS-AND-FIND-PIVOT-COL + call sub993 (I, IMAX, M, MDW, IPIVOT, H, W) +!C +!C PERFORM-COL-INTERCHANGE +!C +!C ELIMINATE I-TH COL BELOW THE IR-TH ELEMENT. + IRP1 = IR + 1 + J = M + DO JJ=IRP1,M + JM1 = J - 1 + IF (.NOT.(W(J,I).NE.ZERO)) then + J = JM1 + cycle + endif + CALL SROTMG(SCALE(JM1), SCALE(J), W(JM1,I), W(J,I), SPARAM) + W(J,I) = ZERO + CALL SROTM(NP1-I, W(JM1,IP1), MDW, W(J,IP1), MDW, SPARAM) + J = JM1 + enddo +!C +!C TEST IF NEW PIVOT ELEMENT IS NEAR ZERO. IF SO, THE COL IS +!C DEPENDENT. + T = SCALE(IR)*W(IR,I)**2 + INDEP = T.GT.TAU**2*EANORM**2 + IF (INDEP) then +!C +!C COL TEST PASSED. NOW MUST PASS ROW NORM TEST TO BE CLASSIFIED +!C AS INDEPENDENT. + RN = ZERO + DO I1=IR,M + DO J1=IP1,N + RN = AMAX1(RN,SCALE(I1)*W(I1,J1)**2) + enddo + enddo + INDEP = T.GT.TAU**2*RN + endif +!C +!C IF INDEPENDENT, SWAP THE IR-TH AND KRP1-ST ROWS TO MAINTAIN THE +!C TRIANGULAR FORM. UPDATE THE RANK INDICATOR KRANK AND THE +!C EQUALITY CONSTRAINT POINTER ME. + IF (.NOT.(INDEP)) exit + if (kind(W) == real_single) then + CALL SSWAP(NP1, W(KRP1,1), MDW, W(IR,1), MDW) + else if (kind(W) == real_double) then + CALL DSWAP(NP1, W(KRP1,1), MDW, W(IR,1), MDW) + endif + if (kind(SCALE) == real_single) then + CALL SSWAP(1, SCALE(KRP1), 1, SCALE(IR), 1) + else if (kind(SCALE) == real_double) then + CALL DSWAP(1, SCALE(KRP1), 1, SCALE(IR), 1) + endif +!C RECLASSIFY THE LEAST SQ. EQUATION AS AN EQUALITY CONSTRAINT AND +!C RESCALE IT. + ITYPE(IR) = 0 + T = SQRT(SCALE(KRP1)) + + if (kind(W) == real_single) then + CALL SSCAL(NP1, T, W(KRP1,1), MDW) + else if (kind(W) == real_double) then + CALL DSCAL(NP1, T, W(KRP1,1), MDW) + endif + + SCALE(KRP1) = ALSQ + ME = MEP1 + MEP1 = ME + 1 + KRANK = KRP1 + KRP1 = KRANK + 1 + I = IP1 + IP1 = IP1 + 1 + enddo + + endif +!C +!C IF PSEUDORANK IS LESS THAN L, APPLY HOUSEHOLDER TRANS. +!C FROM RIGHT. + IF ((KRANK.LT.L)) then + DO I=1,KRANK + J = KRP1 - I + CALL H12(1, J, KRP1, L, W(J,1), MDW, H(J), W, MDW, 1, J-1) + enddo + endif + NIV = KRANK + NSOLN - L + NIV1 = NIV + 1 + IF (L.EQ.N) DONE = .TRUE. +!C +!C END OF INITIAL TRIANGULARIZATION. + IDOPE(1) = ME + IDOPE(2) = MEP1 + IDOPE(3) = KRANK + IDOPE(4) = KRP1 + IDOPE(5) = NSOLN + IDOPE(6) = NIV + IDOPE(7) = NIV1 + IDOPE(8) = L1 + RETURN + END subroutine WNLIT + + subroutine sub993 (I, IMAX, M, MDW, IPIVOT, H, W) + use setparms + implicit none + integer MAX !, real_single, real_double + INTEGER I, IMAX, IPIVOT(*), M, MDW + REAL H(*), W(MDW,*) + EXTERNAL SSWAP + REAL T + INTEGER ITEMP +! +!C +!C TO PERFORM-COL-INTERCHANGE +!C + IF ((MAX.NE.I)) then +!C EXCHANGE ELEMENTS OF PERMUTED INDEX VECTOR AND PERFORM COL +!C INTERCHANGES. + ITEMP = IPIVOT(I) + IPIVOT(I) = IPIVOT(MAX) + IPIVOT(MAX) = ITEMP + + if (kind(W) == real_single) then + CALL SSWAP(M, W(1,MAX), 1, W(1,I), 1) + else if (kind(W) == real_double) then + CALL DSWAP(M, W(1,MAX), 1, W(1,I), 1) + endif + + T = H(MAX) + H(MAX) = H(I) + H(I) = T + endif + return + end subroutine sub993 + + subroutine sub990(ME, MEND, IR, FACTOR, TAU, SCALE, W) + implicit none + logical indep + REAL FACTOR, SCALE(*), TAU, W(*) + INTEGER IR, ME, MEND + REAL RN, SN, T + INTEGER J +!C +!C TO TEST-INDEP-OF-INCOMING-COL +!C +!C TEST THE COL IC TO DETERMINE IF IT IS LINEARLY INDEPENDENT +!C OF THE COLS ALREADY IN THE BASIS. IN THE INIT TRI +!C STEP, WE USUALLY WANT THE HEAVY WEIGHT ALAMDA TO +!C BE INCLUDED IN THE TEST FOR INDEPENDENCE. IN THIS CASE THE +!C VALUE OF FACTOR WILL HAVE BEEN SET TO 1.E0 BEFORE THIS +!C PROCEDURE IS INVOKED. IN THE POTENTIALLY RANK DEFICIENT +!C PROBLEM, THE VALUE OF FACTOR WILL HAVE BEEN +!C SET TO ALSQ=ALAMDA**2 TO REMOVE THE EFFECT OF THE HEAVY WEIGHT +!C FROM THE TEST FOR INDEPENDENCE. +!C +!C WRITE NEW COL AS PARTITIONED VECTOR +!C (A1) NUMBER OF COMPONENTS IN SOLN SO FAR = NIV +!C (A2) M-NIV COMPONENTS +!C AND COMPUTE SN = INVERSE WEIGHTED LENGTH OF A1 +!C RN = INVERSE WEIGHTED LENGTH OF A2 +!C CALL THE COL INDEPENDENT WHEN RN .GT. TAU*SN + SN = 0. + RN = 0. + do j=1,mend + T = SCALE(J) + IF (J.LE.ME) T = T/FACTOR + T = T*W(J)**2 +! T = T*W(J,IC)**2 + IF (.NOT.(J.LT.IR)) then + RN = RN + T + else + SN = SN + T + endif + enddo + INDEP = RN.GT.TAU**2*SN + + return + end subroutine sub990 + + + subroutine sub996 (I, LEND, MEND, IR, MDW, RECALC, IMAX, HBAR, H, & + SCALE, W) + use setparms + implicit none + integer max !, real_single, real_double + real tenm3 + INTEGER I, IMAX, IR, LEND, MDW, MEND + REAL H(*), HBAR, SCALE(*), W(MDW,*) + LOGICAL RECALC, INDEP + EXTERNAL ISAMAX, IDAMAX + INTEGER ISAMAX, IDAMAX + INTEGER J, K +!C +!C TO UPDATE-COL-SS-AND-FIND-PIVOT-COL +!C +!C THE COL SS VECTOR WILL BE UPDATED AT EACH STEP. WHEN +!C NUMERICALLY NECESSARY, THESE VALUES WILL BE RECOMPUTED. +!C + IF ((IR.NE.1 .AND. (.NOT.RECALC))) then +!C UPDATE COL SS =SUM OF SQUARES. + do J=i,lend + H(J) = H(J) - SCALE(IR-1)*W(IR-1,J)**2 + enddo +!C +!C TEST FOR NUMERICAL ACCURACY. + if (kind(H) == real_single) then + MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1 + else if (kind(H) == real_double) then + MAX = IDAMAX(LEND-I+1,H(I),1) + I - 1 + endif + RECALC = HBAR + TENM3*H(MAX).EQ.HBAR + endif +!C +!C IF REQUIRED, RECALCULATE COL SS, USING ROWS IR THROUGH MEND. + IF ((RECALC)) then + do j=1,lend + H(J) = 0. + do k=ir,mend + H(J) = H(J) + SCALE(K)*W(K,J)**2 + enddo + enddo +!C +!C FIND COL WITH LARGEST SS. + if (kind(H) == real_single) then + MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1 + else if (kind(H) == real_double) then + MAX = IDAMAX(LEND-I+1,H(I),1) + I - 1 + endif + + HBAR = H(MAX) + endif + return + end subroutine sub996 diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLSM.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLSM.f deleted file mode 100644 index b5bce80f6..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLSM.f +++ /dev/null @@ -1,822 +0,0 @@ - SUBROUTINE WNLSM(W,MDW,MME,MA,N,L,PRGOPT,X,RNORM,MODE,IPIVOT, - 1 ITYPE,WD,H,SCALE,Z,TEMP,D) -C***BEGIN PROLOGUE WNLSM -C***REFER TO WNNLS -C -C This is a companion subprogram to WNNLS( ). -C The documentation for WNNLS( ) has more complete -C usage instructions. -C -C Written by Karen H. Haskell, Sandia Laboratories, -C with the help of R.J. Hanson, Sandia Laboratories, -C December 1976 - January 1978. -C Revised March 4, 1982. -C -C In addition to the parameters discussed in the prologue to -C subroutine WNNLS, the following work arrays are used in -C subroutine WNLSM (they are passed through the calling -C sequence from WNNLS for purposes of variable dimensioning). -C Their contents will in general be of no interest to the user. -C -C IPIVOT(*) -C An array of length N. Upon completion it contains the -C pivoting information for the cols of W(*,*). -C -C ITYPE(*) -C An array of length M which is used to keep track -C of the classification of the equations. ITYPE(I)=0 -C denotes equation I as an equality constraint. -C ITYPE(I)=1 denotes equation I as a least squares -C equation. -C -C WD(*) -C An array of length N. Upon completion it contains the -C dual solution vector. -C -C H(*) -C An array of length N. Upon completion it contains the -C pivot scalars of the Householder transformations performed -C in the case KRANK.LT.L. -C -C SCALE(*) -C An array of length M which is used by the subroutine -C to store the diagonal matrix of weights. -C These are used to apply the modified Givens -C transformations. -C -C Z(*),TEMP(*) -C Working arrays of length N. -C -C D(*) -C An array of length N that contains the -C column scaling for the matrix (E). -C (A) -C***ROUTINES CALLED H12,ISAMAX,SASUM,SAXPY,SCOPY,SNRM2,SROTM,SROTMG, -C SSCAL,SSWAP,WNLIT,XERROR -C***END PROLOGUE WNLSM -C -C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO -C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. -C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. -C (BEGIN CHANGES AT LINE WITH C++ IN COLS. 1-3.) -C /REAL (12 BLANKS)/DOUBLE PRECISION/,/SASUM/DASUM/,/SROTMG/DROTMG/, -C /SNRM2/DNRM2/,/ SQRT/ DSQRT/,/SROTM/DROTM/,/AMAX1/DMAX1/, -C /SCOPY/DCOPY/,/SSCAL/DSCAL/,/SAXPY/DAXPY/,/E0/D0/,/SSWAP/DSWAP/, -C /ISAMAX/IDAMAX/,/SRELPR/DRELPR/ -C -C SUBROUTINE WNLSM (W,MDW,MME,MA,N,L,PRGOPT,X,RNORM,MODE, -C 1 IPIVOT,ITYPE,WD,H,SCALE,Z,TEMP,D) -C++ - USE setparms -c - REAL W(MDW,1), X(1), WD(1), H(1), SCALE(1), DOPE(4) - REAL Z(1), TEMP(1), PRGOPT(1), D(1), SPARAM(5) - REAL ALAMDA, ALPHA, ALSQ, AMAX, BNORM, EANORM - REAL SRELPR, FAC, ONE, BLOWUP - REAL RNORM, SM, T, TAU, TWO, WMAX, ZERO, ZZ, Z2 - REAL AMAX1, SQRT, SNRM2, SASUM, DNRM2, DASUM - - INTEGER IPIVOT(1), ITYPE(1), IDOPE(8) - integer(kind = int_single) ISAMAX,IDAMAX - LOGICAL HITCON, FEASBL, DONE, POS - DATA ZERO /0.E0/, ONE /1.E0/, TWO /2.E0/, SRELPR /0.E0/ -C -C INITIALIZE-VARIABLES -C***FIRST EXECUTABLE STATEMENT WNLSM - ASSIGN 10 TO IGO998 - GO TO 180 -C -C PERFORM INITIAL TRIANGULARIZATION IN THE SUBMATRIX -C CORRESPONDING TO THE UNCONSTRAINED VARIABLES USING -C THE PROCEDURE INITIALLY-TRIANGULARIZE. - 10 ASSIGN 20 TO IGO995 - GO TO 280 -C -C PERFORM WNNLS ALGORITHM USING THE FOLLOWING STEPS. -C -C UNTIL(DONE) -C -C COMPUTE-SEARCH-DIRECTION-AND-FEASIBLE-POINT -C -C WHEN (HITCON) ADD-CONSTRAINTS -C -C ELSE PERFORM-MULTIPLIER-TEST-AND-DROP-A-CONSTRAINT -C -C FIN -C -C COMPUTE-FINAL-SOLUTION -C - 20 IF (DONE) GO TO 80 -C - ASSIGN 30 TO IGO991 - GO TO 300 -C -C COMPUTE-SEARCH-DIRECTION-AND-FEASIBLE-POINT -C - 30 IF (.NOT.(HITCON)) GO TO 50 - ASSIGN 40 TO IGO986 - GO TO 370 - 40 GO TO 70 -C -C WHEN (HITCON) ADD-CONSTRAINTS -C - 50 ASSIGN 60 TO IGO983 - GO TO 640 - 60 CONTINUE -C -C ELSE PERFORM-MULTIPLIER-TEST-AND-DROP-A-CONSTRAINT -C - 70 GO TO 20 -C - 80 ASSIGN 90 TO IGO980 - GO TO 1000 -C -C COMPUTE-FINAL-SOLUTION -C - 90 RETURN - 100 CONTINUE -C -C TO PROCESS-OPTION-VECTOR - FAC = 1.E-4 -C -C THE NOMINAL TOLERANCE USED IN THE CODE, - TAU = SQRT(SRELPR) -C -C THE NOMINAL BLOW-UP FACTOR USED IN THE CODE. - BLOWUP = TAU -C -C THE NOMINAL COLUMN SCALING USED IN THE CODE IS -C THE IDENTITY SCALING. - D(1) = ONE - if (kind(D) == real_single) then - CALL SCOPY(N, D, 0, D, 1) - else if (kind(D) == real_double) then - CALL DCOPY(N, D, 0, D, 1) - endif -C -C DEFINE BOUND FOR NUMBER OF OPTIONS TO CHANGE. - NOPT = 1000 -C -C DEFINE BOUND FOR POSITIVE VALUE OF LINK. - NLINK = 100000 - NTIMES = 0 - LAST = 1 - LINK = PRGOPT(1) - IF (.NOT.(LINK.LE.0 .OR. LINK.GT.NLINK)) GO TO 110 - NERR = 3 - IOPT = 1 - CALL XERROR( 'WNNLS( ) THE OPTION VECTOR IS UNDEFINED', 39, NERR, - 1 IOPT) - MODE = 2 - RETURN - 110 IF (.NOT.(LINK.GT.1)) GO TO 160 - NTIMES = NTIMES + 1 - IF (.NOT.(NTIMES.GT.NOPT)) GO TO 120 - NERR = 3 - IOPT = 1 - CALL XERROR( 'WNNLS( ). THE LINKS IN THE OPTION VECTOR ARE CYCLING - 1.', 53, NERR, IOPT) - MODE = 2 - RETURN - 120 KEY = PRGOPT(LAST+1) - IF (.NOT.(KEY.EQ.6 .AND. PRGOPT(LAST+2).NE.ZERO)) GO TO 140 - - if (kind(W) == real_single) then - do J=1,N - T = SNRM2(M,W(1,J),1) - IF (T.NE.ZERO) T = ONE/T - D(J) = T - enddo - else if (kind(W) == real_double) then - do J=1,N - T = DNRM2(M,W(1,J),1) - IF (T.NE.ZERO) T = ONE/T - D(J) = T - enddo - endif - - 140 IF (KEY.EQ.7) then - if (kind(PRGOPT) == real_single) then - CALL SCOPY(N, PRGOPT(LAST+2), 1, D, 1) - else if (kind(PRGOPT) == real_double) then - CALL DCOPY(N, PRGOPT(LAST+2), 1, D, 1) - endif - endif - IF (KEY.EQ.8) TAU = AMAX1(SRELPR,PRGOPT(LAST+2)) - IF (KEY.EQ.9) BLOWUP = AMAX1(SRELPR,PRGOPT(LAST+2)) - NEXT = PRGOPT(LINK) - IF (.NOT.(NEXT.LE.0 .OR. NEXT.GT.NLINK)) GO TO 150 - NERR = 3 - IOPT = 1 - CALL XERROR( 'WNNLS( ) THE OPTION VECTOR IS UNDEFINED', 39, NERR, - 1 IOPT) - MODE = 2 - RETURN - 150 LAST = LINK - LINK = NEXT - GO TO 110 - - 160 if (kind(W) == real_single) then - do J=1,N - CALL SSCAL(M, D(J), W(1,J), 1) - enddo - else if (kind(W) == real_double) then - do J=1,N - CALL DSCAL(M, D(J), W(1,J), 1) - enddo - endif - - GO TO 1260 - 180 CONTINUE -C -C TO INITIALIZE-VARIABLES -C -C SRELPR IS THE PRECISION FOR THE PARTICULAR MACHINE -C BEING USED. THIS LOGIC AVOIDS RECOMPUTING IT EVERY ENTRY. - IF (.NOT.(SRELPR.EQ.ZERO)) GO TO 210 -c*** changed back by BROSS -c*** changed by RF Boisvert, 19-Feb-92 (fails on HP 9000 Series 300) -cross srelpr = r1mach(4) - SRELPR = ONE - 190 IF (ONE+SRELPR.EQ.ONE) GO TO 200 - SRELPR = SRELPR/TWO - GO TO 190 - 200 SRELPR = SRELPR*TWO -cross - 210 M = MA + MME - ME = MME - MEP1 = ME + 1 - ASSIGN 220 TO IGO977 - GO TO 100 -C -C PROCESS-OPTION-VECTOR - 220 DONE = .FALSE. - ITER = 0 - ITMAX = 3*(N-L) - MODE = 0 - LP1 = L + 1 - NSOLN = L - NSP1 = NSOLN + 1 - NP1 = N + 1 - NM1 = N - 1 - L1 = MIN0(M,L) -C -C COMPUTE SCALE FACTOR TO APPLY TO EQUAL. CONSTRAINT EQUAS. - - if (kind(W) == real_single) then - do J=1,N - WD(J) = SASUM(M,W(1,J),1) - enddo - IMAX = ISAMAX(N,WD,1) - EANORM = WD(IMAX) - BNORM = SASUM(M,W(1,NP1),1) - else if (kind(W) == real_double) then - do J=1,N - WD(J) = DASUM(M,W(1,J),1) - enddo - IMAX = IDAMAX(N,WD,1) - EANORM = WD(IMAX) - BNORM = DASUM(M,W(1,NP1),1) - endif - - ALAMDA = EANORM/(SRELPR*FAC) -C -C DEFINE SCALING DIAG MATRIX FOR MOD GIVENS USAGE AND -C CLASSIFY EQUATION TYPES. - ALSQ = ALAMDA**2 - DO 260 I=1,M -C -C WHEN EQU I IS HEAVILY WEIGHTED ITYPE(I)=0, ELSE ITYPE(I)=1. - IF (.NOT.(I.LE.ME)) GO TO 240 - T = ALSQ - ITEMP = 0 - GO TO 250 - 240 T = ONE - ITEMP = 1 - 250 SCALE(I) = T - ITYPE(I) = ITEMP - 260 CONTINUE -C -C SET THE SOLN VECTOR X(*) TO ZERO AND THE COL INTERCHANGE -C MATRIX TO THE IDENTITY. - X(1) = ZERO - if (kind(X) == real_single) then - CALL SCOPY(N, X, 0, X, 1) - else if (kind(X) == real_double) then - CALL DCOPY(N, X, 0, X, 1) - endif - DO 270 I=1,N - IPIVOT(I) = I - 270 CONTINUE - GO TO 1230 - 280 CONTINUE -C -C TO INITIALLY-TRIANGULARIZE -C -C SET FIRST L COMPS. OF DUAL VECTOR TO ZERO BECAUSE -C THESE CORRESPOND TO THE UNCONSTRAINED VARIABLES. - IF (.NOT.(L.GT.0)) GO TO 290 - WD(1) = ZERO - if (kind(WD) == real_single) then - CALL SCOPY(L, WD, 0, WD, 1) - else if (kind(WD) == real_double) then - CALL DCOPY(L, WD, 0, WD, 1) - endif -C -C THE ARRAYS IDOPE(*) AND DOPE(*) ARE USED TO PASS -C INFORMATION TO WNLIT(). THIS WAS DONE TO AVOID -C A LONG CALLING SEQUENCE OR THE USE OF COMMON. - 290 IDOPE(1) = ME - IDOPE(2) = MEP1 - IDOPE(3) = 0 - IDOPE(4) = 1 - IDOPE(5) = NSOLN - IDOPE(6) = 0 - IDOPE(7) = 1 - IDOPE(8) = L1 -C - DOPE(1) = ALSQ - DOPE(2) = EANORM - DOPE(3) = FAC - DOPE(4) = TAU - CALL WNLIT(W, MDW, M, N, L, IPIVOT, ITYPE, H, SCALE, RNORM, - 1 IDOPE, DOPE, DONE) - ME = IDOPE(1) - MEP1 = IDOPE(2) - KRANK = IDOPE(3) - KRP1 = IDOPE(4) - NSOLN = IDOPE(5) - NIV = IDOPE(6) - NIV1 = IDOPE(7) - L1 = IDOPE(8) - GO TO 1240 - 300 CONTINUE -C -C TO COMPUTE-SEARCH-DIRECTION-AND-FEASIBLE-POINT -C -C SOLVE THE TRIANGULAR SYSTEM OF CURRENTLY NON-ACTIVE -C VARIABLES AND STORE THE SOLUTION IN Z(*). -C -C SOLVE-SYSTEM - ASSIGN 310 TO IGO958 - GO TO 1110 -C -C INCREMENT ITERATION COUNTER AND CHECK AGAINST MAX. NUMBER -C OF ITERATIONS. - 310 ITER = ITER + 1 - IF (.NOT.(ITER.GT.ITMAX)) GO TO 320 - MODE = 1 - DONE = .TRUE. -C -C CHECK TO SEE IF ANY CONSTRAINTS HAVE BECOME ACTIVE. -C IF SO, CALCULATE AN INTERPOLATION FACTOR SO THAT ALL -C ACTIVE CONSTRAINTS ARE REMOVED FROM THE BASIS. - 320 ALPHA = TWO - HITCON = .FALSE. - IF (.NOT.(L.LT.NSOLN)) GO TO 360 - DO 350 J=LP1,NSOLN - ZZ = Z(J) - IF (.NOT.(ZZ.LE.ZERO)) GO TO 340 - T = X(J)/(X(J)-ZZ) - IF (.NOT.(T.LT.ALPHA)) GO TO 330 - ALPHA = T - JCON = J - 330 HITCON = .TRUE. - 340 CONTINUE - 350 CONTINUE - 360 GO TO 1220 - 370 CONTINUE -C -C TO ADD-CONSTRAINTS -C -C USE COMPUTED ALPHA TO INTERPOLATE BETWEEN LAST -C FEASIBLE SOLUTION X(*) AND CURRENT UNCONSTRAINED -C (AND INFEASIBLE) SOLUTION Z(*). - IF (.NOT.(LP1.LE.NSOLN)) GO TO 390 - DO 380 J=LP1,NSOLN - X(J) = X(J) + ALPHA*(Z(J)-X(J)) - 380 CONTINUE - 390 FEASBL = .FALSE. - GO TO 410 - 400 IF (FEASBL) GO TO 610 -C -C REMOVE COL JCON AND SHIFT COLS JCON+1 THROUGH N TO THE -C LEFT. SWAP COL JCON INTO THE N-TH POSITION. THIS ACHIEVES -C UPPER HESSENBERG FORM FOR THE NONACTIVE CONSTRAINTS AND -C LEAVES AN UPPER HESSENBERG MATRIX TO RETRIANGULARIZE. - 410 DO 420 I=1,M - T = W(I,JCON) -! if (kind(W) == real_single) then -! CALL SCOPY(N-JCON, W(I,JCON+1), MDW, W(I,JCON), MDW) -! else if (kind(W) == real_double) then -! CALL DCOPY(N-JCON, W(I,JCON+1), MDW, W(I,JCON), MDW) -! endif - do j=jcon,n-1 - w(i,j)=w(i,j+1) - end do - W(I,N) = T - 420 CONTINUE -C -C UPDATE PERMUTED INDEX VECTOR TO REFLECT THIS SHIFT AND SWAP. - ITEMP = IPIVOT(JCON) - IF (.NOT.(JCON.LT.N)) GO TO 440 - DO 430 I=JCON,NM1 - IPIVOT(I) = IPIVOT(I+1) - 430 CONTINUE - 440 IPIVOT(N) = ITEMP -C -C SIMILARLY REPERMUTE X(*) VECTOR. -! if (kind(X) == real_single) then -! CALL SCOPY(N-JCON, X(JCON+1), 1, X(JCON), 1) -! else if (kind(X) == real_double) then -! CALL DCOPY(N-JCON, X(JCON+1), 1, X(JCON), 1) -! endif - do j=jcon,n-1 - X(j)=X(J+1) - end do - - X(N) = ZERO - NSP1 = NSOLN - NSOLN = NSOLN - 1 - NIV1 = NIV - NIV = NIV - 1 -C -C RETRIANGULARIZE UPPER HESSENBERG MATRIX AFTER ADDING CONSTRAINTS. - J = JCON - I = KRANK + JCON - L - 450 IF (.NOT.(J.LE.NSOLN)) GO TO 570 - IF (.NOT.(ITYPE(I).EQ.0 .AND. ITYPE(I+1).EQ.0)) GO TO 470 - ASSIGN 460 TO IGO938 - GO TO 620 -C -C (ITYPE(I).EQ.0 .AND. ITYPE(I+1).EQ.0) ZERO-IP1-TO-I-IN-COL-J - 460 GO TO 560 - 470 IF (.NOT.(ITYPE(I).EQ.1 .AND. ITYPE(I+1).EQ.1)) GO TO 490 - ASSIGN 480 TO IGO938 - GO TO 620 -C -C (ITYPE(I).EQ.1 .AND. ITYPE(I+1).EQ.1) ZERO-IP1-TO-I-IN-COL-J - 480 GO TO 560 - 490 IF (.NOT.(ITYPE(I).EQ.1 .AND. ITYPE(I+1).EQ.0)) GO TO 510 - if (kind(W) == real_single) then - CALL SSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) - else if (kind(W) == real_double) then - CALL DSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) - endif - if (kind(SCALE) == real_single) then - CALL SSWAP(1, SCALE(I), 1, SCALE(I+1), 1) - else if (kind(SCALE) == real_double) then - CALL DSWAP(1, SCALE(I), 1, SCALE(I+1), 1) - endif - ITEMP = ITYPE(I+1) - ITYPE(I+1) = ITYPE(I) - ITYPE(I) = ITEMP -C -C SWAPPED ROW WAS FORMERLY A PIVOT ELT., SO IT WILL -C BE LARGE ENOUGH TO PERFORM ELIM. - ASSIGN 500 TO IGO938 - GO TO 620 -C -C ZERO-IP1-TO-I-IN-COL-J - 500 GO TO 560 - 510 IF (.NOT.(ITYPE(I).EQ.0 .AND. ITYPE(I+1).EQ.1)) GO TO 550 - T = SCALE(I)*W(I,J)**2/ALSQ - IF (.NOT.(T.GT.TAU**2*EANORM**2)) GO TO 530 - ASSIGN 520 TO IGO938 - GO TO 620 - 520 GO TO 540 - 530 if (kind(W) == real_single) then - CALL SSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) - else if (kind(W) == real_double) then - CALL DSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) - endif - if (kind(SCALE) == real_single) then - CALL SSWAP(1, SCALE(I), 1, SCALE(I+1), 1) - else if (kind(SCALE) == real_double) then - CALL DSWAP(1, SCALE(I), 1, SCALE(I+1), 1) - endif - - ITEMP = ITYPE(I+1) - ITYPE(I+1) = ITYPE(I) - ITYPE(I) = ITEMP - W(I+1,J) = ZERO - 540 CONTINUE - 550 CONTINUE - 560 I = I + 1 - J = J + 1 - GO TO 450 -C -C SEE IF THE REMAINING COEFFS IN THE SOLN SET ARE FEASIBLE. THEY -C SHOULD BE BECAUSE OF THE WAY ALPHA WAS DETERMINED. IF ANY ARE -C INFEASIBLE IT IS DUE TO ROUNDOFF ERROR. ANY THAT ARE NON- -C POSITIVE WILL BE SET TO ZERO AND REMOVED FROM THE SOLN SET. - 570 IF (.NOT.(LP1.LE.NSOLN)) GO TO 590 - DO 580 JCON=LP1,NSOLN - IF (X(JCON).LE.ZERO) GO TO 600 - 580 CONTINUE - 590 FEASBL = .TRUE. - 600 CONTINUE - GO TO 400 - 610 GO TO 1200 - 620 CONTINUE -C -C TO ZERO-IP1-TO-I-IN-COL-J - IF (.NOT.(W(I+1,J).NE.ZERO)) GO TO 630 - CALL SROTMG(SCALE(I), SCALE(I+1), W(I,J), W(I+1,J), SPARAM) - W(I+1,J) = ZERO - CALL SROTM(NP1-J, W(I,J+1), MDW, W(I+1,J+1), MDW, SPARAM) - 630 GO TO 1290 - 640 CONTINUE -C -C TO PERFORM-MULTIPLIER-TEST-AND-DROP-A-CONSTRAINT - if (kind(Z) == real_single) then - CALL SCOPY(NSOLN, Z, 1, X, 1) - else if (kind(Z) == real_double) then - CALL DCOPY(NSOLN, Z, 1, X, 1) - endif - - IF (.NOT.(NSOLN.LT.N)) GO TO 650 - X(NSP1) = ZERO - if (kind(X) == real_single) then - CALL SCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) - else if (kind(X) == real_double) then - CALL DCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) - endif - - 650 I = NIV1 - 660 IF (.NOT.(I.LE.ME)) GO TO 690 -C -C RECLASSIFY LEAST SQUARES EQATIONS AS EQUALITIES AS -C NECESSARY. - IF (.NOT.(ITYPE(I).EQ.0)) GO TO 670 - I = I + 1 - GO TO 680 - 670 if (kind(W) == real_single) then - CALL SSWAP(NP1, W(I,1), MDW, W(ME,1), MDW) - else if (kind(W) == real_double) then - CALL DSWAP(NP1, W(I,1), MDW, W(ME,1), MDW) - endif - if (kind(SCALE) == real_single) then - CALL SSWAP(1, SCALE(I), 1, SCALE(ME), 1) - else if (kind(SCALE) == real_double) then - CALL DSWAP(1, SCALE(I), 1, SCALE(ME), 1) - endif - - ITEMP = ITYPE(I) - ITYPE(I) = ITYPE(ME) - ITYPE(ME) = ITEMP - MEP1 = ME - ME = ME - 1 - 680 GO TO 660 -C -C FORM INNER PRODUCT VECTOR WD(*) OF DUAL COEFFS. - 690 IF (.NOT.(NSP1.LE.N)) GO TO 730 - DO 720 J=NSP1,N - SM = ZERO - IF (.NOT.(NSOLN.LT.M)) GO TO 710 - DO 700 I=NSP1,M - SM = SM + SCALE(I)*W(I,J)*W(I,NP1) - 700 CONTINUE - 710 WD(J) = SM - 720 CONTINUE - 730 GO TO 750 - 740 IF (POS .OR. DONE) GO TO 970 -C -C FIND J SUCH THAT WD(J)=WMAX IS MAXIMUM. THIS DETERMINES -C THAT THE INCOMING COL J WILL REDUCE THE RESIDUAL VECTOR -C AND BE POSITIVE. - 750 WMAX = ZERO - IWMAX = NSP1 - IF (.NOT.(NSP1.LE.N)) GO TO 780 - DO 770 J=NSP1,N - IF (.NOT.(WD(J).GT.WMAX)) GO TO 760 - WMAX = WD(J) - IWMAX = J - 760 CONTINUE - 770 CONTINUE - 780 IF (.NOT.(WMAX.LE.ZERO)) GO TO 790 - DONE = .TRUE. - GO TO 960 -C -C SET DUAL COEFF TO ZERO FOR INCOMING COL. - 790 WD(IWMAX) = ZERO -C -C WMAX .GT. ZERO, SO OKAY TO MOVE COL IWMAX TO SOLN SET. -C PERFORM TRANSFORMATION TO RETRIANGULARIZE, AND TEST -C FOR NEAR LINEAR DEPENDENCE. -C SWAP COL IWMAX INTO NSOLN-TH POSITION TO MAINTAIN UPPER -C HESSENBERG FORM OF ADJACENT COLS, AND ADD NEW COL TO -C TRIANGULAR DECOMPOSITION. - NSOLN = NSP1 - NSP1 = NSOLN + 1 - NIV = NIV1 - NIV1 = NIV + 1 - IF (.NOT.(NSOLN.NE.IWMAX)) GO TO 800 - if (kind(W) == real_single) then - CALL SSWAP(M, W(1,NSOLN), 1, W(1,IWMAX), 1) - else if (kind(W) == real_double) then - CALL DSWAP(M, W(1,NSOLN), 1, W(1,IWMAX), 1) - endif - WD(IWMAX) = WD(NSOLN) - WD(NSOLN) = ZERO - ITEMP = IPIVOT(NSOLN) - IPIVOT(NSOLN) = IPIVOT(IWMAX) - IPIVOT(IWMAX) = ITEMP -C -C REDUCE COL NSOLN SO THAT THE MATRIX OF NONACTIVE -C CONSTRAINTS VARIABLES IS TRIANGULAR. - 800 J = M - 810 IF (.NOT.(J.GT.NIV)) GO TO 870 - JM1 = J - 1 - JP = JM1 -C -C WHEN OPERATING NEAR THE ME LINE, TEST TO SEE IF THE PIVOT ELT. -C IS NEAR ZERO. IF SO, USE THE LARGEST ELT. ABOVE IT AS THE PIVOT. -C THIS IS TO MAINTAIN THE SHARP INTERFACE BETWEEN WEIGHTED AND -C NON-WEIGHTED ROWS IN ALL CASES. - IF (.NOT.(J.EQ.MEP1)) GO TO 850 - IMAX = ME - AMAX = SCALE(ME)*W(ME,NSOLN)**2 - 820 IF (.NOT.(JP.GE.NIV)) GO TO 840 - T = SCALE(JP)*W(JP,NSOLN)**2 - IF (.NOT.(T.GT.AMAX)) GO TO 830 - IMAX = JP - AMAX = T - 830 JP = JP - 1 - GO TO 820 - 840 JP = IMAX - 850 IF (.NOT.(W(J,NSOLN).NE.ZERO)) GO TO 860 - CALL SROTMG(SCALE(JP), SCALE(J), W(JP,NSOLN), W(J,NSOLN), SPARAM) - W(J,NSOLN) = ZERO - CALL SROTM(NP1-NSOLN, W(JP,NSP1), MDW, W(J,NSP1), MDW, SPARAM) - 860 J = JM1 - GO TO 810 -C -C SOLVE FOR Z(NSOLN)=PROPOSED NEW VALUE FOR X(NSOLN). -C TEST IF THIS IS NONPOSITIVE OR TOO LARGE. -C IF THIS WAS TRUE OR IF THE PIVOT TERM WAS ZERO REJECT -C THE COL AS DEPENDENT. - 870 IF (.NOT.(W(NIV,NSOLN).NE.ZERO)) GO TO 890 - ISOL = NIV - ASSIGN 880 TO IGO897 - GO TO 980 -C -C TEST-PROPOSED-NEW-COMPONENT - 880 GO TO 940 - 890 IF (.NOT.(NIV.LE.ME .AND. W(MEP1,NSOLN).NE.ZERO)) GO TO 920 -C -C TRY TO ADD ROW MEP1 AS AN ADDITIONAL EQUALITY CONSTRAINT. -C CHECK SIZE OF PROPOSED NEW SOLN COMPONENT. -C REJECT IT IF IT IS TOO LARGE. - ISOL = MEP1 - ASSIGN 900 TO IGO897 - GO TO 980 -C -C TEST-PROPOSED-NEW-COMPONENT - 900 IF (.NOT.(POS)) GO TO 910 -C -C SWAP ROWS MEP1 AND NIV, AND SCALE FACTORS FOR THESE ROWS. - - if (kind(W) == real_single) then - CALL SSWAP(NP1, W(MEP1,1), MDW, W(NIV,1), MDW) - else if (kind(W) == real_double) then - CALL DSWAP(NP1, W(MEP1,1), MDW, W(NIV,1), MDW) - endif - if (kind(SCALE) == real_single) then - CALL SSWAP(1, SCALE(MEP1), 1, SCALE(NIV), 1) - else if (kind(SCALE) == real_double) then - CALL DSWAP(1, SCALE(MEP1), 1, SCALE(NIV), 1) - endif - - ITEMP = ITYPE(MEP1) - ITYPE(MEP1) = ITYPE(NIV) - ITYPE(NIV) = ITEMP - ME = MEP1 - MEP1 = ME + 1 - 910 GO TO 930 - 920 POS = .FALSE. - 930 CONTINUE - 940 IF (POS) GO TO 950 - NSP1 = NSOLN - NSOLN = NSOLN - 1 - NIV1 = NIV - NIV = NIV - 1 - 950 CONTINUE - 960 GO TO 740 - 970 GO TO 1250 - 980 CONTINUE -C -C TO TEST-PROPOSED-NEW-COMPONENT - Z2 = W(ISOL,NP1)/W(ISOL,NSOLN) - Z(NSOLN) = Z2 - POS = Z2.GT.ZERO - IF (.NOT.(Z2*EANORM.GE.BNORM .AND. POS)) GO TO 990 - POS = .NOT.(BLOWUP*Z2*EANORM.GE.BNORM) - 990 GO TO 1280 - 1000 CONTINUE -C TO COMPUTE-FINAL-SOLUTION -C -C SOLVE SYSTEM, STORE RESULTS IN X(*). -C - ASSIGN 1010 TO IGO958 - GO TO 1110 -C SOLVE-SYSTEM - 1010 if (kind(Z) == real_single) then - CALL SCOPY(NSOLN, Z, 1, X, 1) - else if (kind(Z) == real_double) then - CALL DCOPY(NSOLN, Z, 1, X, 1) - endif -C -C APPLY HOUSEHOLDER TRANSFORMATIONS TO X(*) IF KRANK.LT.L - IF (.NOT.(0.LT.KRANK .AND. KRANK.LT.L)) GO TO 1030 - DO 1020 I=1,KRANK - CALL H12(2, I, KRP1, L, W(I,1), MDW, H(I), X, 1, 1, 1) - 1020 CONTINUE -C -C FILL IN TRAILING ZEROES FOR CONSTRAINED VARIABLES NOT IN SOLN. - 1030 IF (.NOT.(NSOLN.LT.N)) GO TO 1040 - X(NSP1) = ZERO - if (kind(X) == real_single) then - CALL SCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) - else if (kind(X) == real_double) then - CALL DCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) - endif -C -C REPERMUTE SOLN VECTOR TO NATURAL ORDER. - 1040 DO 1070 I=1,N - J = I - 1050 IF (IPIVOT(J).EQ.I) GO TO 1060 - J = J + 1 - GO TO 1050 - 1060 IPIVOT(J) = IPIVOT(I) - IPIVOT(I) = J - if (kind(X) == real_single) then - CALL SSWAP(1, X(J), 1, X(I), 1) - else if (kind(X) == real_double) then - CALL DSWAP(1, X(J), 1, X(I), 1) - endif - 1070 CONTINUE -C -C RESCALE THE SOLN USING THE COL SCALING. - DO 1080 J=1,N - X(J) = X(J)*D(J) - 1080 CONTINUE - IF (.NOT.(NSOLN.LT.M)) GO TO 1100 - DO 1090 I=NSP1,M - T = W(I,NP1) - IF (I.LE.ME) T = T/ALAMDA - T = (SCALE(I)*T)*T - RNORM = RNORM + T - 1090 CONTINUE - 1100 RNORM = SQRT(RNORM) - GO TO 1210 -C -C TO SOLVE-SYSTEM -C - 1110 CONTINUE - IF (.NOT.(DONE)) GO TO 1120 - ISOL = 1 - GO TO 1130 - 1120 ISOL = LP1 - 1130 IF (.NOT.(NSOLN.GE.ISOL)) GO TO 1190 -C -C COPY RT. HAND SIDE INTO TEMP VECTOR TO USE OVERWRITING METHOD. - if (kind(W) == real_single) then - CALL SCOPY(NIV, W(1,NP1), 1, TEMP, 1) - else if (kind(W) == real_double) then - CALL DCOPY(NIV, W(1,NP1), 1, TEMP, 1) - endif - - DO 1180 JJ=ISOL,NSOLN - J = NSOLN - JJ + ISOL - IF (.NOT.(J.GT.KRANK)) GO TO 1140 - I = NIV - JJ + ISOL - GO TO 1150 - 1140 I = J - 1150 IF (.NOT.(J.GT.KRANK .AND. J.LE.L)) GO TO 1160 - Z(J) = ZERO - GO TO 1170 - 1160 Z(J) = TEMP(I)/W(I,J) - - if (kind(W) == real_single .and. kind(TEMP) == real_single) - & then - CALL SAXPY(I-1, -Z(J), W(1,J), 1, TEMP, 1) - else if (kind(W) == real_double .and. kind(TEMP) == real_double) - & then - CALL DAXPY(I-1, -Z(J), W(1,J), 1, TEMP, 1) - endif - - 1170 CONTINUE - 1180 CONTINUE - 1190 GO TO 1270 - 1200 GO TO IGO986, (40) - 1210 GO TO IGO980, (90) - 1220 GO TO IGO991, (30) - 1230 GO TO IGO998, (10) - 1240 GO TO IGO995, (20) - 1250 GO TO IGO983, (60) - 1260 GO TO IGO977, (220) - 1270 GO TO IGO958, (310, 1010) - 1280 GO TO IGO897, (880, 900) - 1290 GO TO IGO938, (460, 480, 500, 520) - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLSM.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLSM.f90 new file mode 100644 index 000000000..65b3d8430 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNLSM.f90 @@ -0,0 +1,951 @@ + SUBROUTINE WNLSM(W,MDW,MME,MA,N,L,PRGOPT,X,RNORM,MODE,IPIVOT, & + ITYPE,WD,H,SCALE,Z,TEMP,D) +!C***BEGIN PROLOGUE WNLSM +!C***REFER TO WNNLS +!C +!C This is a companion subprogram to WNNLS( ). +!C The documentation for WNNLS( ) has more complete +!C usage instructions. +!C +!C Written by Karen H. Haskell, Sandia Laboratories, +!C with the help of R.J. Hanson, Sandia Laboratories, +!C December 1976 - January 1978. +!C Revised March 4, 1982. +!C +!C In addition to the parameters discussed in the prologue to +!C subroutine WNNLS, the following work arrays are used in +!C subroutine WNLSM (they are passed through the calling +!C sequence from WNNLS for purposes of variable dimensioning). +!C Their contents will in general be of no interest to the user. +!C +!C IPIVOT(*) +!C An array of length N. Upon completion it contains the +!C pivoting information for the cols of W(*,*). +!C +!C ITYPE(*) +!C An array of length M which is used to keep track +!C of the classification of the equations. ITYPE(I)=0 +!C denotes equation I as an equality constraint. +!C ITYPE(I)=1 denotes equation I as a least squares +!C equation. +!C +!C WD(*) +!C An array of length N. Upon completion it contains the +!C dual solution vector. +!C +!C H(*) +!C An array of length N. Upon completion it contains the +!C pivot scalars of the Householder transformations performed +!C in the case KRANK.LT.L. +!C +!C SCALE(*) +!C An array of length M which is used by the subroutine +!C to store the diagonal matrix of weights. +!C These are used to apply the modified Givens +!C transformations. +!C +!C Z(*),TEMP(*) +!C Working arrays of length N. +!C +!C D(*) +!C An array of length N that contains the +!C column scaling for the matrix (E). +!C (A) +!C***ROUTINES CALLED H12,ISAMAX,SASUM,SAXPY,SCOPY,SNRM2,SROTM,SROTMG, +!C SSCAL,SSWAP,WNLIT,XERROR +!C***END PROLOGUE WNLSM +!C +!C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO +!C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. +!C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. +!C (BEGIN CHANGES AT LINE WITH C++ IN COLS. 1-3.) +!C /REAL (12 BLANKS)/DOUBLE PRECISION/,/SASUM/DASUM/,/SROTMG/DROTMG/, +!C /SNRM2/DNRM2/,/ SQRT/ DSQRT/,/SROTM/DROTM/,/AMAX1/DMAX1/, +!C /SCOPY/DCOPY/,/SSCAL/DSCAL/,/SAXPY/DAXPY/,/E0/D0/,/SSWAP/DSWAP/, +!C /ISAMAX/IDAMAX/,/SRELPR/DRELPR/ +!C +!C SUBROUTINE WNLSM (W,MDW,MME,MA,N,L,PRGOPT,X,RNORM,MODE, +!C 1 IPIVOT,ITYPE,WD,H,SCALE,Z,TEMP,D) +!C++ + USE setparms + implicit none + REAL W(MDW,1), X(1), WD(1), H(1), SCALE(1), DOPE(4) + REAL Z(1), TEMP(1), PRGOPT(1), D(1), SPARAM(5) + REAL ALAMDA, ALPHA, ALSQ, AMAX, BNORM, EANORM + REAL SRELPR, FAC, ONE, BLOWUP + REAL RNORM, SM, T, TAU, TWO, WMAX, ZERO, ZZ, Z2 + REAL AMAX1, SQRT, SNRM2, SASUM, DNRM2, DASUM + + INTEGER IPIVOT(1), ITYPE(1), IDOPE(8) + integer(kind = int_single) ISAMAX,IDAMAX + LOGICAL HITCON, FEASBL, DONE, POS + DATA ZERO /0.E0/, ONE /1.E0/, TWO /2.E0/, SRELPR /0.E0/ + + integer KEY, NEXT + integer ISOL, NP1, NSOLN, NIV, NIV1, KRP1, KRANK + integer I,J,JJ,LP1, NSP1, JP, JM1, JCON, IWMAX + integer ITEMP, ITMAX, IMAX, NM1, MODE, IOPT, NERR , LINK, LAST + integer NLINK, NTIMES, ITER, NOPT + integer MA, MME, ME, MEP1, M, MDW, L1, N, L + + integer ind59,ind91 + +!C +!C INITIALIZE-VARIABLES +!C***FIRST EXECUTABLE STATEMENT WNLSM + !yonghui call sub998(SRELPR, M, MA, MME,MEP1) + call sub998(SRELPR, M, MA, MME, ME, MEP1) +!C +!C TO PROCESS-OPTION-VECTOR + FAC = 1.E-4 +!C +!C THE NOMINAL TOLERANCE USED IN THE CODE, + TAU = SQRT(SRELPR) +!C +!C THE NOMINAL BLOW-UP FACTOR USED IN THE CODE. + BLOWUP = TAU +!C +!C THE NOMINAL COLUMN SCALING USED IN THE CODE IS +!C THE IDENTITY SCALING. + D(1) = ONE + if (kind(D) == real_single) then + CALL SCOPY(N, D, 0, D, 1) + else if (kind(D) == real_double) then + CALL DCOPY(N, D, 0, D, 1) + endif +!C +!C DEFINE BOUND FOR NUMBER OF OPTIONS TO CHANGE. + NOPT = 1000 +!C +!C DEFINE BOUND FOR POSITIVE VALUE OF LINK. + NLINK = 100000 + NTIMES = 0 + LAST = 1 + LINK = PRGOPT(1) + IF ((LINK.LE.0 .OR. LINK.GT.NLINK)) then + NERR = 3 + IOPT = 1 + CALL XERROR( 'WNNLS( ) THE OPTION VECTOR IS UNDEFINED', 39, & + NERR, IOPT) + MODE = 2 + RETURN + + endif + do + IF (.NOT.(LINK.GT.1)) exit + NTIMES = NTIMES + 1 + IF ((NTIMES.GT.NOPT)) then + NERR = 3 + IOPT = 1 + CALL XERROR( 'WNNLS( ). THE LINKS IN THE OPTION VECTOR ARE & + CYCLING.', 53, NERR, IOPT) + MODE = 2 + RETURN + endif + KEY = PRGOPT(LAST+1) + IF ((KEY.EQ.6 .AND. PRGOPT(LAST+2).NE.ZERO)) then + if (kind(W) == real_single) then + do J=1,N + T = SNRM2(M,W(1,J),1) + IF (T.NE.ZERO) T = ONE/T + D(J) = T + enddo + else if (kind(W) == real_double) then + do J=1,N + T = DNRM2(M,W(1,J),1) + IF (T.NE.ZERO) T = ONE/T + D(J) = T + enddo + endif + endif + + IF (KEY.EQ.7) then + if (kind(PRGOPT) == real_single) then + CALL SCOPY(N, PRGOPT(LAST+2), 1, D, 1) + else if (kind(PRGOPT) == real_double) then + CALL DCOPY(N, PRGOPT(LAST+2), 1, D, 1) + endif + endif + IF (KEY.EQ.8) TAU = AMAX1(SRELPR,PRGOPT(LAST+2)) + IF (KEY.EQ.9) BLOWUP = AMAX1(SRELPR,PRGOPT(LAST+2)) + NEXT = PRGOPT(LINK) + IF ((NEXT.LE.0 .OR. NEXT.GT.NLINK)) then + NERR = 3 + IOPT = 1 + CALL XERROR( 'WNNLS( ) THE OPTION VECTOR IS UNDEFINED', & + 39, NERR, IOPT) + MODE = 2 + RETURN + endif + LAST = LINK + LINK = NEXT + enddo !110 + + if (kind(W) == real_single) then + do J=1,N + CALL SSCAL(M, D(J), W(1,J), 1) + enddo + else if (kind(W) == real_double) then + do J=1,N + CALL DSCAL(M, D(J), W(1,J), 1) + enddo + endif +!C +!C PROCESS-OPTION-VECTOR + DONE = .FALSE. + ITER = 0 + ITMAX = 3*(N-L) + MODE = 0 + LP1 = L + 1 + NSOLN = L + NSP1 = NSOLN + 1 + NP1 = N + 1 + NM1 = N - 1 + L1 = MIN0(M,L) +!C +!C COMPUTE SCALE FACTOR TO APPLY TO EQUAL. CONSTRAINT EQUAS. + + if (kind(W) == real_single) then + do J=1,N + WD(J) = SASUM(M,W(1,J),1) + enddo + IMAX = ISAMAX(N,WD,1) + EANORM = WD(IMAX) + BNORM = SASUM(M,W(1,NP1),1) + else if (kind(W) == real_double) then + do J=1,N + WD(J) = DASUM(M,W(1,J),1) + enddo + IMAX = IDAMAX(N,WD,1) + EANORM = WD(IMAX) + BNORM = DASUM(M,W(1,NP1),1) + endif + + ALAMDA = EANORM/(SRELPR*FAC) +!C +!C DEFINE SCALING DIAG MATRIX FOR MOD GIVENS USAGE AND +!C CLASSIFY EQUATION TYPES. + ALSQ = ALAMDA**2 + DO I=1,M !260 +!C +!C WHEN EQU I IS HEAVILY WEIGHTED ITYPE(I)=0, ELSE ITYPE(I)=1. + IF ((I.LE.ME)) then + T = ALSQ + ITEMP = 0 + SCALE(I) = T + ITYPE(I) = ITEMP + cycle + endif + T = ONE + ITEMP = 1 + SCALE(I) = T + ITYPE(I) = ITEMP + enddo !260 +!C +!C SET THE SOLN VECTOR X(*) TO ZERO AND THE COL INTERCHANGE +!C MATRIX TO THE IDENTITY. + X(1) = ZERO + if (kind(X) == real_single) then + CALL SCOPY(N, X, 0, X, 1) + else if (kind(X) == real_double) then + CALL DCOPY(N, X, 0, X, 1) + endif + DO I=1,N !270 + IPIVOT(I) = I + enddo !270 +!C +!C PERFORM INITIAL TRIANGULARIZATION IN THE SUBMATRIX +!C CORRESPONDING TO THE UNCONSTRAINED VARIABLES USING +!C THE PROCEDURE INITIALLY-TRIANGULARIZE. + !yonghui call sub995(L, ITYPE, N, MDW, W, WD, ME, MEP1, NSOLN, L1, & + call sub995(L, ITYPE, N, MDW, W, WD, ME, MEP1, M, NSOLN, L1, & + ALSQ, EANORM, FAC, TAU, KRANK, KRP1, NIV, NIV1, SCALE) +!C +!C PERFORM WNNLS ALGORITHM USING THE FOLLOWING STEPS. +!C +!C UNTIL(DONE) +!C +!C COMPUTE-SEARCH-DIRECTION-AND-FEASIBLE-POINT +!C +!C WHEN (HITCON) ADD-CONSTRAINTS +!C +!C ELSE PERFORM-MULTIPLIER-TEST-AND-DROP-A-CONSTRAINT +!C +!C FIN +!C +!C COMPUTE-FINAL-SOLUTION +!C + do + IF (DONE) exit +!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!C +!C TO COMPUTE-SEARCH-DIRECTION-AND-FEASIBLE-POINT +!C +!C SOLVE THE TRIANGULAR SYSTEM OF CURRENTLY NON-ACTIVE +!C VARIABLES AND STORE THE SOLUTION IN Z(*). +!C +!C SOLVE-SYSTEM + + call sub958(DONE,LP1,NSOLN,MDW,NP1,W,TEMP,NIV,KRANK,Z,L) +!C +!C INCREMENT ITERATION COUNTER AND CHECK AGAINST MAX. NUMBER +!C OF ITERATIONS. + ITER = ITER + 1 + IF ((ITER.GT.ITMAX)) then + MODE = 1 + DONE = .TRUE. + endif +!C +!C CHECK TO SEE IF ANY CONSTRAINTS HAVE BECOME ACTIVE. +!C IF SO, CALCULATE AN INTERPOLATION FACTOR SO THAT ALL +!C ACTIVE CONSTRAINTS ARE REMOVED FROM THE BASIS. + ALPHA = TWO + HITCON = .FALSE. + IF ((L.LT.NSOLN)) then + DO J=LP1,NSOLN !350 + ZZ = Z(J) + IF (.NOT.(ZZ.LE.ZERO)) cycle + T = X(J)/(X(J)-ZZ) + IF ((T.LT.ALPHA)) then + ALPHA = T + JCON = J + endif + HITCON = .TRUE. + enddo !350 + endif +!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!C +!C COMPUTE-SEARCH-DIRECTION-AND-FEASIBLE-POINT +!C + IF ((HITCON)) then +!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ind59=0 +!C +!C TO ADD-CONSTRAINTS +!C +!C USE COMPUTED ALPHA TO INTERPOLATE BETWEEN LAST +!C FEASIBLE SOLUTION X(*) AND CURRENT UNCONSTRAINED +!C (AND INFEASIBLE) SOLUTION Z(*). + IF ((LP1.LE.NSOLN)) then + DO J=LP1,NSOLN !380 + X(J) = X(J) + ALPHA*(Z(J)-X(J)) + enddo !380 + endif + FEASBL = .FALSE. + + + do +!C +!C REMOVE COL JCON AND SHIFT COLS JCON+1 THROUGH N TO THE +!C LEFT. SWAP COL JCON INTO THE N-TH POSITION. THIS ACHIEVES +!C UPPER HESSENBERG FORM FOR THE NONACTIVE CONSTRAINTS AND +!C LEAVES AN UPPER HESSENBERG MATRIX TO RETRIANGULARIZE. + DO I=1,M !420 + T = W(I,JCON) +! if (kind(W) == real_single) then +! CALL SCOPY(N-JCON, W(I,JCON+1), MDW, W(I,JCON), MDW) +! else if (kind(W) == real_double) then +! CALL DCOPY(N-JCON, W(I,JCON+1), MDW, W(I,JCON), MDW) +! endif + do j=jcon,n-1 + w(i,j)=w(i,j+1) + end do + W(I,N) = T + enddo !420 +!C +!C UPDATE PERMUTED INDEX VECTOR TO REFLECT THIS SHIFT AND SWAP. + ITEMP = IPIVOT(JCON) + IF ((JCON.LT.N)) then + DO I=JCON,NM1 !430 + IPIVOT(I) = IPIVOT(I+1) + enddo !430 + endif + IPIVOT(N) = ITEMP +!C +!C SIMILARLY REPERMUTE X(*) VECTOR. +! if (kind(X) == real_single) then +! CALL SCOPY(N-JCON, X(JCON+1), 1, X(JCON), 1) +! else if (kind(X) == real_double) then +! CALL DCOPY(N-JCON, X(JCON+1), 1, X(JCON), 1) +! endif + do j=jcon,n-1 + X(j)=X(J+1) + end do + + X(N) = ZERO + NSP1 = NSOLN + NSOLN = NSOLN - 1 + NIV1 = NIV + NIV = NIV - 1 +!C +!C RETRIANGULARIZE UPPER HESSENBERG MATRIX AFTER ADDING CONSTRAINTS. + J = JCON + I = KRANK + JCON - L + do + IF (.NOT.(J.LE.NSOLN)) exit + IF ((ITYPE(I).EQ.0 .AND. ITYPE(I+1).EQ.0)) then + call sub938(SPARAM, SCALE, W, MDW, I, J, NP1) +!C +!C (ITYPE(I).EQ.0 .AND. ITYPE(I+1).EQ.0) ZERO-IP1-TO-I-IN-COL-J + I = I + 1 + J = J + 1 + cycle + endif + IF ((ITYPE(I).EQ.1 .AND. ITYPE(I+1).EQ.1)) then + call sub938(SPARAM, SCALE, W, MDW, I, J, NP1) +!C +!C (ITYPE(I).EQ.1 .AND. ITYPE(I+1).EQ.1) ZERO-IP1-TO-I-IN-COL-J + I = I + 1 + J = J + 1 + cycle + endif + IF ((ITYPE(I).EQ.1 .AND. ITYPE(I+1).EQ.0)) then + if (kind(W) == real_single) then + CALL SSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) + else if (kind(W) == real_double) then + CALL DSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) + endif + if (kind(SCALE) == real_single) then + CALL SSWAP(1, SCALE(I), 1, SCALE(I+1), 1) + else if (kind(SCALE) == real_double) then + CALL DSWAP(1, SCALE(I), 1, SCALE(I+1), 1) + endif + ITEMP = ITYPE(I+1) + ITYPE(I+1) = ITYPE(I) + ITYPE(I) = ITEMP +!C +!C SWAPPED ROW WAS FORMERLY A PIVOT ELT., SO IT WILL +!C BE LARGE ENOUGH TO PERFORM ELIM. + call sub938(SPARAM, SCALE, W, MDW, I, J, NP1) +!C +!C ZERO-IP1-TO-I-IN-COL-J + I = I + 1 + J = J + 1 + cycle + endif + IF (.NOT.(ITYPE(I).EQ.0 .AND. ITYPE(I+1).EQ.1)) then + I = I + 1 + J = J + 1 + cycle + endif + T = SCALE(I)*W(I,J)**2/ALSQ + IF ((T.GT.TAU**2*EANORM**2)) then + call sub938(SPARAM, SCALE, W, MDW, I, J, NP1) + I = I + 1 + J = J + 1 + cycle + endif + if (kind(W) == real_single) then + CALL SSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) + else if (kind(W) == real_double) then + CALL DSWAP(NP1, W(I,1), MDW, W(I+1,1), MDW) + endif + if (kind(SCALE) == real_single) then + CALL SSWAP(1, SCALE(I), 1, SCALE(I+1), 1) + else if (kind(SCALE) == real_double) then + CALL DSWAP(1, SCALE(I), 1, SCALE(I+1), 1) + endif + + ITEMP = ITYPE(I+1) + ITYPE(I+1) = ITYPE(I) + ITYPE(I) = ITEMP + W(I+1,J) = ZERO + I = I + 1 + J = J + 1 + enddo +!C +!C SEE IF THE REMAINING COEFFS IN THE SOLN SET ARE FEASIBLE. THEY +!C SHOULD BE BECAUSE OF THE WAY ALPHA WAS DETERMINED. IF ANY ARE +!C INFEASIBLE IT IS DUE TO ROUNDOFF ERROR. ANY THAT ARE NON- +!C POSITIVE WILL BE SET TO ZERO AND REMOVED FROM THE SOLN SET. + IF ((LP1.LE.NSOLN)) then + DO JCON=LP1,NSOLN !580 + IF (X(JCON).LE.ZERO) then + ind59=1 + exit + endif + enddo !580 + endif + if (ind59.ne.1) then + FEASBL = .TRUE. + endif + IF (FEASBL) exit + enddo +!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + cycle + endif +!C +!C WHEN (HITCON) ADD-CONSTRAINTS +!C +!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ind91=0 + +!C +!C TO PERFORM-MULTIPLIER-TEST-AND-DROP-A-CONSTRAINT + if (kind(Z) == real_single) then + CALL SCOPY(NSOLN, Z, 1, X, 1) + else if (kind(Z) == real_double) then + CALL DCOPY(NSOLN, Z, 1, X, 1) + endif + + IF ((NSOLN.LT.N)) then + X(NSP1) = ZERO + if (kind(X) == real_single) then + CALL SCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) + else if (kind(X) == real_double) then + CALL DCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) + endif + endif + I = NIV1 + do + IF (.NOT.(I.LE.ME)) exit +!C +!C RECLASSIFY LEAST SQUARES EQATIONS AS EQUALITIES AS +!C NECESSARY. + IF ((ITYPE(I).EQ.0)) then + I = I + 1 + cycle + endif + if (kind(W) == real_single) then + CALL SSWAP(NP1, W(I,1), MDW, W(ME,1), MDW) + else if (kind(W) == real_double) then + CALL DSWAP(NP1, W(I,1), MDW, W(ME,1), MDW) + endif + if (kind(SCALE) == real_single) then + CALL SSWAP(1, SCALE(I), 1, SCALE(ME), 1) + else if (kind(SCALE) == real_double) then + CALL DSWAP(1, SCALE(I), 1, SCALE(ME), 1) + endif + + ITEMP = ITYPE(I) + ITYPE(I) = ITYPE(ME) + ITYPE(ME) = ITEMP + MEP1 = ME + ME = ME - 1 + enddo +!C +!C FORM INNER PRODUCT VECTOR WD(*) OF DUAL COEFFS. + IF ((NSP1.LE.N)) then + DO J=NSP1,N !720 + SM = ZERO + IF ((NSOLN.LT.M)) then + DO I=NSP1,M !700 + SM = SM + SCALE(I)*W(I,J)*W(I,NP1) + enddo !700 + endif + WD(J) = SM + enddo !720 + endif + + do +!C +!C FIND J SUCH THAT WD(J)=WMAX IS MAXIMUM. THIS DETERMINES +!C THAT THE INCOMING COL J WILL REDUCE THE RESIDUAL VECTOR +!C AND BE POSITIVE. + WMAX = ZERO + IWMAX = NSP1 + IF ((NSP1.LE.N)) then + DO J=NSP1,N !770 + IF ((WD(J).GT.WMAX)) then + WMAX = WD(J) + IWMAX = J + endif + enddo !770 + endif + IF ((WMAX.LE.ZERO)) then + DONE = .TRUE. + exit + endif +!C +!C SET DUAL COEFF TO ZERO FOR INCOMING COL. + WD(IWMAX) = ZERO +! +!C WMAX .GT. ZERO, SO OKAY TO MOVE COL IWMAX TO SOLN SET. +!C PERFORM TRANSFORMATION TO RETRIANGULARIZE, AND TEST +!C FOR NEAR LINEAR DEPENDENCE. +!C SWAP COL IWMAX INTO NSOLN-TH POSITION TO MAINTAIN UPPER +!C HESSENBERG FORM OF ADJACENT COLS, AND ADD NEW COL TO +!C TRIANGULAR DECOMPOSITION. + NSOLN = NSP1 + NSP1 = NSOLN + 1 + NIV = NIV1 + NIV1 = NIV + 1 + IF ((NSOLN.NE.IWMAX)) then + if (kind(W) == real_single) then + CALL SSWAP(M, W(1,NSOLN), 1, W(1,IWMAX), 1) + else if (kind(W) == real_double) then + CALL DSWAP(M, W(1,NSOLN), 1, W(1,IWMAX), 1) + endif + WD(IWMAX) = WD(NSOLN) + WD(NSOLN) = ZERO + ITEMP = IPIVOT(NSOLN) + IPIVOT(NSOLN) = IPIVOT(IWMAX) + IPIVOT(IWMAX) = ITEMP + endif +!C +!C REDUCE COL NSOLN SO THAT THE MATRIX OF NONACTIVE +!C CONSTRAINTS VARIABLES IS TRIANGULAR. + J = M + do !810 + IF (.NOT.(J.GT.NIV)) exit + JM1 = J - 1 + JP = JM1 +!C +!C WHEN OPERATING NEAR THE ME LINE, TEST TO SEE IF THE PIVOT ELT. +!C IS NEAR ZERO. IF SO, USE THE LARGEST ELT. ABOVE IT AS THE PIVOT. +!C THIS IS TO MAINTAIN THE SHARP INTERFACE BETWEEN WEIGHTED AND +!C NON-WEIGHTED ROWS IN ALL CASES. + IF ((J.EQ.MEP1)) then + IMAX = ME + AMAX = SCALE(ME)*W(ME,NSOLN)**2 + do !820 + IF (.NOT.(JP.GE.NIV)) exit + T = SCALE(JP)*W(JP,NSOLN)**2 + IF ((T.GT.AMAX)) then + IMAX = JP + AMAX = T + endif + JP = JP - 1 + enddo !820 + JP = IMAX + endif + IF ((W(J,NSOLN).NE.ZERO)) then + CALL SROTMG(SCALE(JP), SCALE(J), W(JP,NSOLN), & + W(J,NSOLN), SPARAM) + W(J,NSOLN) = ZERO + CALL SROTM(NP1-NSOLN, W(JP,NSP1), MDW, W(J,NSP1), & + MDW, SPARAM) + endif + J = JM1 + enddo !810 +!C +!C SOLVE FOR Z(NSOLN)=PROPOSED NEW VALUE FOR X(NSOLN). +!C TEST IF THIS IS NONPOSITIVE OR TOO LARGE. +!C IF THIS WAS TRUE OR IF THE PIVOT TERM WAS ZERO REJECT +!C THE COL AS DEPENDENT. + IF ((W(NIV,NSOLN).NE.ZERO)) then + ISOL = NIV + call sub897(Z2,Z,BLOWUP,BNORM, EANORM,ISOL, NP1, & + NSOLN,POS,MDW, W) +!C +!C TEST-PROPOSED-NEW-COMPONENT + IF (.NOT.(POS)) then + NSP1 = NSOLN + NSOLN = NSOLN - 1 + NIV1 = NIV + NIV = NIV - 1 + endif + IF (POS .OR. DONE) then + exit + else + cycle + endif + endif + IF ((NIV.LE.ME .AND. W(MEP1,NSOLN).NE.ZERO)) then +!C +!C TRY TO ADD ROW MEP1 AS AN ADDITIONAL EQUALITY CONSTRAINT. +!C CHECK SIZE OF PROPOSED NEW SOLN COMPONENT. +!C REJECT IT IF IT IS TOO LARGE. + ISOL = MEP1 + call sub897(Z2,Z,BLOWUP,BNORM, EANORM,ISOL, NP1, & + NSOLN,POS,MDW, W) +!C +!C TEST-PROPOSED-NEW-COMPONENT + IF ((POS)) then +!C +!C SWAP ROWS MEP1 AND NIV, AND SCALE FACTORS FOR THESE ROWS. + + if (kind(W) == real_single) then + CALL SSWAP(NP1, W(MEP1,1), MDW, W(NIV,1), MDW) + else if (kind(W) == real_double) then + CALL DSWAP(NP1, W(MEP1,1), MDW, W(NIV,1), MDW) + endif + if (kind(SCALE) == real_single) then + CALL SSWAP(1, SCALE(MEP1), 1, SCALE(NIV), 1) + else if (kind(SCALE) == real_double) then + CALL DSWAP(1, SCALE(MEP1), 1, SCALE(NIV), 1) + endif + + ITEMP = ITYPE(MEP1) + ITYPE(MEP1) = ITYPE(NIV) + ITYPE(NIV) = ITEMP + ME = MEP1 + MEP1 = ME + 1 + endif + ind91=1 + endif + if(ind91.ne.1) then + POS = .FALSE. + endif + IF (.NOT.(POS)) then + NSP1 = NSOLN + NSOLN = NSOLN - 1 + NIV1 = NIV + NIV = NIV - 1 + endif + IF (POS .OR. DONE) exit + enddo + +!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!C +!C ELSE PERFORM-MULTIPLIER-TEST-AND-DROP-A-CONSTRAINT +!C + enddo + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! 1000 CONTINUE +!C TO COMPUTE-FINAL-SOLUTION +!C +!C SOLVE SYSTEM, STORE RESULTS IN X(*). +!C +!!!!!!!!!!FNL SOLUTION DONE!!!!!!!!!!!!!!!!!!!!!! + + call sub958(DONE,LP1,NSOLN,MDW,NP1,W,TEMP,NIV,KRANK,Z,L) + +!C SOLVE-SYSTEM + if (kind(Z) == real_single) then + CALL SCOPY(NSOLN, Z, 1, X, 1) + else if (kind(Z) == real_double) then + CALL DCOPY(NSOLN, Z, 1, X, 1) + endif +!C +!C APPLY HOUSEHOLDER TRANSFORMATIONS TO X(*) IF KRANK.LT.L + IF ((0.LT.KRANK .AND. KRANK.LT.L)) then + DO I=1,KRANK !1020 + CALL H12(2, I, KRP1, L, W(I,1), MDW, H(I), X, 1, 1, 1) + enddo !1020 + endif +!C +!C FILL IN TRAILING ZEROES FOR CONSTRAINED VARIABLES NOT IN SOLN. + IF ((NSOLN.LT.N)) then + X(NSP1) = ZERO + if (kind(X) == real_single) then + CALL SCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) + else if (kind(X) == real_double) then + CALL DCOPY(N-NSOLN, X(NSP1), 0, X(NSP1), 1) + endif + endif +!C +!C REPERMUTE SOLN VECTOR TO NATURAL ORDER. + DO I=1,N !1070 + J = I + do + IF (IPIVOT(J).EQ.I) exit + J = J + 1 + enddo + IPIVOT(J) = IPIVOT(I) + IPIVOT(I) = J + if (kind(X) == real_single) then + CALL SSWAP(1, X(J), 1, X(I), 1) + else if (kind(X) == real_double) then + CALL DSWAP(1, X(J), 1, X(I), 1) + endif + enddo !1070 +!C +!C RESCALE THE SOLN USING THE COL SCALING. + DO J=1,N !1080 + X(J) = X(J)*D(J) + enddo !1080 + IF ((NSOLN.LT.M)) then + DO I=NSP1,M !1090 + T = W(I,NP1) + IF (I.LE.ME) T = T/ALAMDA + T = (SCALE(I)*T)*T + RNORM = RNORM + T + enddo !1090 + endif + RNORM = SQRT(RNORM) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!C +!C COMPUTE-FINAL-SOLUTION +!C + RETURN + + END subroutine WNLSM + + !yonghui subroutine sub998(SRELPR, M, MA, MME,MEP1) + subroutine sub998(SRELPR, M, MA, MME, ME, MEP1) + use setparms + implicit none + REAL SRELPR + REAL TWO, ZERO, ONE + integer MA, MME, ME, MEP1, M + DATA ZERO /0.E0/, ONE /1.E0/, TWO /2.E0/ !, SRELPR /0.E0/ + +!C TO INITIALIZE-VARIABLES +!C +!C SRELPR IS THE PRECISION FOR THE PARTICULAR MACHINE +!C BEING USED. THIS LOGIC AVOIDS RECOMPUTING IT EVERY ENTRY. + IF ((SRELPR.EQ.ZERO)) then +!c*** changed back by BROSS +!c*** changed by RF Boisvert, 19-Feb-92 (fails on HP 9000 Series 300) +!cross srelpr = r1mach(4) + SRELPR = ONE + do + IF (ONE+SRELPR.EQ.ONE) exit + SRELPR = SRELPR/TWO + enddo + SRELPR = SRELPR*TWO +!cross + endif + M = MA + MME + ME = MME + MEP1 = ME + 1 + + return + end subroutine sub998 + + + subroutine sub958(DONE,LP1,NSOLN,MDW,NP1,W,TEMP,NIV,KRANK,Z,L) + use setparms + implicit none + logical DONE + integer I,J,JJ,LP1,NSOLN,MDW,NP1,KRANK, ISOL, L,NIV + REAL W(MDW,1) + REAL Z(1), TEMP(1),ZERO + DATA ZERO /0.E0/ + + IF ((DONE)) then + ISOL = 1 + else + ISOL = LP1 + endif + IF ((NSOLN.GE.ISOL)) then +!C +!C COPY RT. HAND SIDE INTO TEMP VECTOR TO USE OVERWRITING METHOD. + if (kind(W) == real_single) then + CALL SCOPY(NIV, W(1,NP1), 1, TEMP, 1) + else if (kind(W) == real_double) then + CALL DCOPY(NIV, W(1,NP1), 1, TEMP, 1) + endif + + DO JJ=ISOL,NSOLN + J = NSOLN - JJ + ISOL + IF ((J.GT.KRANK)) then + I = NIV - JJ + ISOL + else + I = J + endif + IF ((J.GT.KRANK .AND. J.LE.L)) then + Z(J) = ZERO + cycle + endif + Z(J) = TEMP(I)/W(I,J) + + if (kind(W) == real_single .and. & + kind(TEMP) == real_single) then + CALL SAXPY(I-1, -Z(J), W(1,J), 1, TEMP, 1) + else if (kind(W) == real_double .and. & + kind(TEMP) == real_double) then + CALL DAXPY(I-1, -Z(J), W(1,J), 1, TEMP, 1) + endif + + enddo + endif + + return + end subroutine sub958 + + + !yonghui subroutine sub995(L, ITYPE, N, MDW, W, WD, ME, MEP1, NSOLN, L1, & + subroutine sub995(L, ITYPE, N, MDW, W, WD, ME, MEP1, M, NSOLN, L1, & + ALSQ, EANORM, FAC, TAU, KRANK, KRP1, NIV, NIV1, SCALE) + USE setparms + implicit none + integer MA, MME, ME, MEP1, M, MDW, L1, N, L + REAL W(MDW,1), WD(1), H(1), SCALE(1), DOPE(4) + REAL ALSQ, EANORM + REAL FAC, ONE + REAL RNORM, TAU, TWO, ZERO + integer ISOL, NP1, NSOLN, NIV, NIV1, KRP1, KRANK + + LOGICAL DONE + INTEGER IPIVOT(1), ITYPE(1), IDOPE(8) + DATA ZERO /0.E0/, ONE /1.E0/, TWO /2.E0/ + +!C +!C TO INITIALLY-TRIANGULARIZE +!C +!C SET FIRST L COMPS. OF DUAL VECTOR TO ZERO BECAUSE +!C THESE CORRESPOND TO THE UNCONSTRAINED VARIABLES. + IF ((L.GT.0)) then + WD(1) = ZERO + if (kind(WD) == real_single) then + CALL SCOPY(L, WD, 0, WD, 1) + else if (kind(WD) == real_double) then + CALL DCOPY(L, WD, 0, WD, 1) + endif + endif +!C +!C THE ARRAYS IDOPE(*) AND DOPE(*) ARE USED TO PASS +!C INFORMATION TO WNLIT(). THIS WAS DONE TO AVOID +!C A LONG CALLING SEQUENCE OR THE USE OF COMMON. + IDOPE(1) = ME + IDOPE(2) = MEP1 + IDOPE(3) = 0 + IDOPE(4) = 1 + IDOPE(5) = NSOLN + IDOPE(6) = 0 + IDOPE(7) = 1 + IDOPE(8) = L1 +!C + DOPE(1) = ALSQ + DOPE(2) = EANORM + DOPE(3) = FAC + DOPE(4) = TAU + CALL WNLIT(W, MDW, M, N, L, IPIVOT, ITYPE, H, SCALE, RNORM, & + IDOPE, DOPE, DONE) + ME = IDOPE(1) + MEP1 = IDOPE(2) + KRANK = IDOPE(3) + KRP1 = IDOPE(4) + NSOLN = IDOPE(5) + NIV = IDOPE(6) + NIV1 = IDOPE(7) + L1 = IDOPE(8) + + return + end subroutine sub995 + + subroutine sub897(Z2,Z,BLOWUP,BNORM, EANORM,ISOL, NP1, & + NSOLN,POS,MDW, W) + use setparms + implicit none + integer MDW + REAL W(MDW,1) + real BNORM, EANORM, Z2, Z(1),BLOWUP + integer ISOL, NP1, NSOLN + logical pos + REAL TWO, WMAX, ZERO, ONE + DATA ZERO /0.E0/, ONE /1.E0/, TWO /2.E0/ +!C +!C TO TEST-PROPOSED-NEW-COMPONENT + Z2 = W(ISOL,NP1)/W(ISOL,NSOLN) + Z(NSOLN) = Z2 + POS = Z2.GT.ZERO + IF ((Z2*EANORM.GE.BNORM .AND. POS)) then + POS = .NOT.(BLOWUP*Z2*EANORM.GE.BNORM) + endif + return + end subroutine sub897 + + subroutine sub938(SPARAM, SCALE, W, MDW, I, J, NP1) + use setparms + implicit none + integer MDW, I, J, NP1 + REAL W(MDW,1), SCALE(1) + REAL SPARAM(5) + REAL TWO, WMAX, ZERO, ONE + DATA ZERO /0.E0/, ONE /1.E0/, TWO /2.E0/ +!C +!C TO ZERO-IP1-TO-I-IN-COL-J + IF ((W(I+1,J).NE.ZERO)) then + CALL SROTMG(SCALE(I), SCALE(I+1), W(I,J), W(I+1,J), SPARAM) + W(I+1,J) = ZERO + CALL SROTM(NP1-J, W(I,J+1), MDW, W(I+1,J+1), MDW, SPARAM) + endif + + return + end subroutine sub938 + diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNNLS.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNNLS.f deleted file mode 100644 index 27b7f0a0d..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNNLS.f +++ /dev/null @@ -1,356 +0,0 @@ - SUBROUTINE WNNLS(W,MDW,ME,MA,N,L,PRGOPT,X,RNORM,MODE,IWORK,WORK) -C***BEGIN PROLOGUE WNNLS -C***DATE WRITTEN 790701 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. K1A2A -C***KEYWORDS CONSTRAINED LEAST SQUARES,CURVE FITTING,DATA FITTING, -C EQUALITY CONSTRAINTS,INEQUALITY CONSTRAINTS, -C NONNEGATIVITY CONSTRAINTS,QUADRATIC PROGRAMMING -C***AUTHOR HANSON, R. J., (SNLA) -C HASKELL, K. H., (SNLA) -C***PURPOSE Solve a linearly constrained least squares problem with -C equality constraints and nonnegativity constraints on -C selected variables. -C***DESCRIPTION -C -C DIMENSION W(MDW,N+1),PRGOPT(*),X(N),IWORK(M+N),WORK(M+5*N) -C -C Written by Karen H. Haskell, Sandia Laboratories, -C and R.J. Hanson, Sandia Laboratories. -C -C Abstract -C -C This subprogram solves a linearly constrained least squares -C problem. Suppose there are given matrices E and A of -C respective dimensions ME by N and MA by N, and vectors F -C and B of respective lengths ME and MA. This subroutine -C solves the problem -C -C EX = F, (equations to be exactly satisfied) -C -C AX = B, (equations to be approximately satisfied, -C in the least squares sense) -C -C subject to components L+1,...,N nonnegative -C -C Any values ME.GE.0, MA.GE.0 and 0.LE. L .LE.N are permitted. -C -C The problem is reposed as problem WNNLS -C -C (WT*E)X = (WT*F) -C ( A) ( B), (least squares) -C subject to components L+1,...,N nonnegative. -C -C The subprogram chooses the heavy weight (or penalty parameter) WT. -C -C The parameters for WNNLS are -C -C INPUT.. -C -C W(*,*),MDW, The array W(*,*) is double subscripted with first -C ME,MA,N,L dimensioning parameter equal to MDW. For this -C discussion let us call M = ME + MA. Then MDW -C must satisfy MDW.GE.M. The condition MDW.LT.M -C is an error. -C -C The array W(*,*) contains the matrices and vectors -C -C (E F) -C (A B) -C -C in rows and columns 1,...,M and 1,...,N+1 -C respectively. Columns 1,...,L correspond to -C unconstrained variables X(1),...,X(L). The -C remaining variables are constrained to be -C nonnegative. The condition L.LT.0 or L.GT.N is -C an error. -C -C PRGOPT(*) This real-valued array is the option vector. -C If the user is satisfied with the nominal -C subprogram features set -C -C PRGOPT(1)=1 (or PRGOPT(1)=1.0) -C -C Otherwise PRGOPT(*) is a linked list consisting of -C groups of data of the following form -C -C LINK -C KEY -C DATA SET -C -C The parameters LINK and KEY are each one word. -C The DATA SET can be comprised of several words. -C The number of items depends on the value of KEY. -C The value of LINK points to the first -C entry of the next group of data within -C PRGOPT(*). The exception is when there are -C no more options to change. In that -C case LINK=1 and the values KEY and DATA SET -C are not referenced. The general layout of -C PRGOPT(*) is as follows. -C -C ...PRGOPT(1)=LINK1 (link to first entry of next group) -C . PRGOPT(2)=KEY1 (key to the option change) -C . PRGOPT(3)=DATA VALUE (data value for this change) -C . . -C . . -C . . -C ...PRGOPT(LINK1)=LINK2 (link to the first entry of -C . next group) -C . PRGOPT(LINK1+1)=KEY2 (key to the option change) -C . PRGOPT(LINK1+2)=DATA VALUE -C ... . -C . . -C . . -C ...PRGOPT(LINK)=1 (no more options to change) -C -C Values of LINK that are nonpositive are errors. -C A value of LINK.GT.NLINK=100000 is also an error. -C This helps prevent using invalid but positive -C values of LINK that will probably extend -C beyond the program limits of PRGOPT(*). -C Unrecognized values of KEY are ignored. The -C order of the options is arbitrary and any number -C of options can be changed with the following -C restriction. To prevent cycling in the -C processing of the option array a count of the -C number of options changed is maintained. -C Whenever this count exceeds NOPT=1000 an error -C message is printed and the subprogram returns. -C -C OPTIONS.. -C -C KEY=6 -C Scale the nonzero columns of the -C entire data matrix -C (E) -C (A) -C to have length one. The DATA SET for -C this option is a single value. It must -C be nonzero if unit length column scaling is -C desired. -C -C KEY=7 -C Scale columns of the entire data matrix -C (E) -C (A) -C with a user-provided diagonal matrix. -C The DATA SET for this option consists -C of the N diagonal scaling factors, one for -C each matrix column. -C -C KEY=8 -C Change the rank determination tolerance from -C the nominal value of SQRT(SRELPR). This quantity -C can be no smaller than SRELPR, The arithmetic- -C storage precision. The quantity used -C here is internally restricted to be at -C least SRELPR. The DATA SET for this option -C is the new tolerance. -C -C KEY=9 -C Change the blow-up parameter from the -C nominal value of SQRT(SRELPR). The reciprocal of -C this parameter is used in rejecting solution -C components as too large when a variable is -C first brought into the active set. Too large -C means that the proposed component times the -C reciprocal of the parameter is not less than -C the ratio of the norms of the right-side -C vector and the data matrix. -C This parameter can be no smaller than SRELPR, -C the arithmetic-storage precision. -C -C For example, suppose we want to provide -C a diagonal matrix to scale the problem -C matrix and change the tolerance used for -C determining linear dependence of dropped col -C vectors. For these options the dimensions of -C PRGOPT(*) must be at least N+6. The FORTRAN -C statements defining these options would -C be as follows. -C -C PRGOPT(1)=N+3 (link to entry N+3 in PRGOPT(*)) -C PRGOPT(2)=7 (user-provided scaling key) -C -C CALL SCOPY(N,D,1,PRGOPT(3),1) (copy the N -C scaling factors from a user array called D(*) -C into PRGOPT(3)-PRGOPT(N+2)) -C -C PRGOPT(N+3)=N+6 (link to entry N+6 of PRGOPT(*)) -C PRGOPT(N+4)=8 (linear dependence tolerance key) -C PRGOPT(N+5)=... (new value of the tolerance) -C -C PRGOPT(N+6)=1 (no more options to change) -C -C -C IWORK(1), The amounts of working storage actually allocated -C IWORK(2) for the working arrays WORK(*) and IWORK(*), -C respectively. These quantities are compared with -C the actual amounts of storage needed for WNNLS( ). -C Insufficient storage allocated for either WORK(*) -C or IWORK(*) is considered an error. This feature -C was included in WNNLS( ) because miscalculating -C the storage formulas for WORK(*) and IWORK(*) -C might very well lead to subtle and hard-to-find -C execution errors. -C -C The length of WORK(*) must be at least -C -C LW = ME+MA+5*N -C This test will not be made if IWORK(1).LE.0. -C -C The length of IWORK(*) must be at least -C -C LIW = ME+MA+N -C This test will not be made if IWORK(2).LE.0. -C -C OUTPUT.. -C -C X(*) An array dimensioned at least N, which will -C contain the N components of the solution vector -C on output. -C -C RNORM The residual norm of the solution. The value of -C RNORM contains the residual vector length of the -C equality constraints and least squares equations. -C -C MODE The value of MODE indicates the success or failure -C of the subprogram. -C -C MODE = 0 Subprogram completed successfully. -C -C = 1 Max. number of iterations (equal to -C 3*(N-L)) exceeded. Nearly all problems -C should complete in fewer than this -C number of iterations. An approximate -C solution and its corresponding residual -C vector length are in X(*) and RNORM. -C -C = 2 Usage error occurred. The offending -C condition is noted with the error -C processing subprogram, XERROR( ). -C -C User-designated -C Working arrays.. -C -C WORK(*) A real-valued working array of length at least -C M + 5*N. -C -C IWORK(*) An integer-valued working array of length at least -C M+N. -C***REFERENCES K.H. HASKELL AND R.J. HANSON, *AN ALGORITHM FOR -C LINEAR LEAST SQUARES PROBLEMS WITH EQUALITY AND -C NONNEGATIVITY CONSTRAINTS*, SAND77-0552, JUNE 1978. -C K.H. HASKELL AND R.J. HANSON, *SELECTED ALGORITHMS FOR -C THE LINEARLY CONSTRAINED LEAST SQUARES PROBLEM-- -C A USERS GUIDE*, SAND78-1290, AUGUST 1979. -C K.H. HASKELL AND R.H. HANSON, *AN ALGORITHM FOR -C LINEAR LEAST SQUARES PROBLEMS WITH EQUALITY AND -C NONNEGATIVITY CONSTRAINTS*, MATH. PROG. 21 (1981), -C PP. 98-118. -C R.J. HANSON AND K.H. HASKELL, *TWO ALGORITHMS FOR THE -C LINEARLY CONSTRAINED LEAST SQUARES PROBLEM*, ACM -C TRANS. ON MATH. SOFTWARE, SEPT. 1982. -C***ROUTINES CALLED WNLSM,XERROR,XERRWV -C***END PROLOGUE WNNLS -C -C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO -C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. -C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. -C (START AT LINE WITH C++ IN COLS. 1-3.) -C /REAL (12 BLANKS)/DOUBLE PRECISION/,/, DUMMY/,SNGL(DUMMY)/ -C -C WRITTEN BY KAREN H. HASKELL, SANDIA LABORATORIES, -C AND R.J. HANSON, SANDIA LABORATORIES. -C REVISED FEB.25, 1982. -C -C SUBROUTINES CALLED BY WNNLS( ) -C -C++ -C WNLSM COMPANION SUBROUTINE TO WNNLS( ), WHERE -C MOST OF THE COMPUTATION TAKES PLACE. -C -C XERROR,XERRWV FROM SLATEC ERROR PROCESSING PACKAGE. -C THIS IS DOCUMENTED IN SANDIA TECH. REPT., -C SAND78-1189. -C -C REFERENCES -C -C 1. SOLVING LEAST SQUARES PROBLEMS, BY C.L. LAWSON -C AND R.J. HANSON. PRENTICE-HALL, INC. (1974). -C -C 2. BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE, BY -C C.L. LAWSON, R.J. HANSON, D.R. KINCAID, AND F.T. KROGH. -C TOMS, V. 5, NO. 3, P. 308. ALSO AVAILABLE AS -C SANDIA TECHNICAL REPORT NO. SAND77-0898. -C -C 3. AN ALGORITHM FOR LINEAR LEAST SQUARES WITH EQUALITY -C AND NONNEGATIVITY CONSTRAINTS, BY K.H. HASKELL AND -C R.J. HANSON. AVAILABLE AS SANDIA TECHNICAL REPORT NO. -C SAND77-0552, AND MATH. PROGRAMMING, VOL. 21, (1981), P. 98-118. -C -C 4. SLATEC COMMON MATH. LIBRARY ERROR HANDLING -C PACKAGE. BY R. E. JONES. AVAILABLE AS SANDIA -C TECHNICAL REPORT SAND78-1189. -C - REAL DUMMY, W(MDW,1), PRGOPT(1), X(1), WORK(1), RNORM - INTEGER IWORK(*) -C -C -C***FIRST EXECUTABLE STATEMENT WNNLS - MODE = 0 - iwork(1)=mdw*6 - iwork(2)=mdw*2 - IF (MA+ME.LE.0 .OR. N.LE.0) RETURN - IF (.NOT.(IWORK(1).GT.0)) GO TO 20 - LW = ME + MA + 5*N - IF (.NOT.(IWORK(1).LT.LW)) GO TO 10 - NERR = 2 - IOPT = 1 - print*,'work array',iwork(1),lw - CALL XERRWV( 'WNNLS( ), INSUFFICIENT STORAGE ALLOCATED FOR WORK(*) - 1, NEED LW=I1 BELOW', 70, NERR, IOPT, 1, LW, 0, 0, DUMMY, DUMMY) - MODE = 2 - RETURN - 10 CONTINUE - 20 IF (.NOT.(IWORK(2).GT.0)) GO TO 40 - LIW = ME + MA + N - IF (.NOT.(IWORK(2).LT.LIW)) GO TO 30 - NERR = 2 - IOPT = 1 - CALL XERRWV( 'WNNLS( ), INSUFFICIENT STORAGE ALLOCATED FOR IWORK(* - 1), NEED LIW=I1 BELOW', 72, NERR, IOPT, 1, LIW, 0, 0, DUMMY, DUMMY) - MODE = 2 - RETURN - 30 CONTINUE - 40 IF (.NOT.(MDW.LT.ME+MA)) GO TO 50 - NERR = 1 - IOPT = 1 - CALL XERROR( 'WNNLS( ), THE VALUE MDW.LT.ME+MA IS AN ERROR', 44, - 1 NERR, IOPT) - MODE = 2 - RETURN - 50 IF (0.LE.L .AND. L.LE.N) GO TO 60 - NERR = 2 - IOPT = 1 - CALL XERROR( 'WNNLS( ), L.LE.0.AND.L.LE.N IS REQUIRED', 39, NERR, - 1 IOPT) - MODE = 2 - RETURN -C -C THE PURPOSE OF THIS SUBROUTINE IS TO BREAK UP THE ARRAYS -C WORK(*) AND IWORK(*) INTO SEPARATE WORK ARRAYS -C REQUIRED BY THE MAIN SUBROUTINE WNLSM( ). -C - 60 L1 = N + 1 - L2 = L1 + N - L3 = L2 + ME + MA - L4 = L3 + N - L5 = L4 + N -C - CALL WNLSM(W, MDW, ME, MA, N, L, PRGOPT, X, RNORM, MODE, IWORK, - 1 IWORK(L1), WORK(1), WORK(L1), WORK(L2), WORK(L3), WORK(L4), - 2 WORK(L5)) - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNNLS.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNNLS.f90 new file mode 100644 index 000000000..71103e844 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/WNNLS.f90 @@ -0,0 +1,439 @@ +SUBROUTINE WNNLS(W,MDW,ME,MA,N,L,PRGOPT,X,RNORM,MODE,IWORK,WORK) +!C***BEGIN PROLOGUE WNNLS +!C***DATE WRITTEN 790701 (YYMMDD) +!C***REVISION DATE 820801 (YYMMDD) +!C***CATEGORY NO. K1A2A +!C***KEYWORDS CONSTRAINED LEAST SQUARES,CURVE FITTING,DATA FITTING, +!C EQUALITY CONSTRAINTS,INEQUALITY CONSTRAINTS, +!C NONNEGATIVITY CONSTRAINTS,QUADRATIC PROGRAMMING +!C***AUTHOR HANSON, R. J., (SNLA) +!C HASKELL, K. H., (SNLA) +!C***PURPOSE Solve a linearly constrained least squares problem with +!C equality constraints and nonnegativity constraints on +!C selected variables. +!C***DESCRIPTION +!C +!C DIMENSION W(MDW,N+1),PRGOPT(*),X(N),IWORK(M+N),WORK(M+5*N) +!C +!C Written by Karen H. Haskell, Sandia Laboratories, +!C and R.J. Hanson, Sandia Laboratories. +!C +!C Abstract +!C +!C This subprogram solves a linearly constrained least squares +!C problem. Suppose there are given matrices E and A of +!C respective dimensions ME by N and MA by N, and vectors F +!C and B of respective lengths ME and MA. This subroutine +!C solves the problem +!C +!C EX = F, (equations to be exactly satisfied) +!C +!C AX = B, (equations to be approximately satisfied, +!C in the least squares sense) +!C +!C subject to components L+1,...,N nonnegative +!C +!C Any values ME.GE.0, MA.GE.0 and 0.LE. L .LE.N are permitted. +!C +!C The problem is reposed as problem WNNLS +!C +!C (WT*E)X = (WT*F) +!C ( A) ( B), (least squares) +!C subject to components L+1,...,N nonnegative. +!C +!C The subprogram chooses the heavy weight (or penalty parameter) WT. +!C +!C The parameters for WNNLS are +!C +!C INPUT.. +!C +!C W(*,*),MDW, The array W(*,*) is double subscripted with first +!C ME,MA,N,L dimensioning parameter equal to MDW. For this +!C discussion let us call M = ME + MA. Then MDW +!C must satisfy MDW.GE.M. The condition MDW.LT.M +!C is an error. +!C +!C The array W(*,*) contains the matrices and vectors +!C +!C (E F) +!C (A B) +!C +!C in rows and columns 1,...,M and 1,...,N+1 +!C respectively. Columns 1,...,L correspond to +!C unconstrained variables X(1),...,X(L). The +!C remaining variables are constrained to be +!C nonnegative. The condition L.LT.0 or L.GT.N is +!C an error. +!C +!C PRGOPT(*) This real-valued array is the option vector. +!C If the user is satisfied with the nominal +!C subprogram features set +!C +!C PRGOPT(1)=1 (or PRGOPT(1)=1.0) +!C +!C Otherwise PRGOPT(*) is a linked list consisting of +!C groups of data of the following form +!C +!C LINK +!C KEY +!C DATA SET +!C +!C The parameters LINK and KEY are each one word. +!C The DATA SET can be comprised of several words. +!C The number of items depends on the value of KEY. +!C The value of LINK points to the first +!C entry of the next group of data within +!C PRGOPT(*). The exception is when there are +!C no more options to change. In that +!C case LINK=1 and the values KEY and DATA SET +!C are not referenced. The general layout of +!C PRGOPT(*) is as follows. +!C +!C ...PRGOPT(1)=LINK1 (link to first entry of next group) +!C . PRGOPT(2)=KEY1 (key to the option change) +!C . PRGOPT(3)=DATA VALUE (data value for this change) +!C . . +!C . . +!C . . +!C ...PRGOPT(LINK1)=LINK2 (link to the first entry of +!C . next group) +!C . PRGOPT(LINK1+1)=KEY2 (key to the option change) +!C . PRGOPT(LINK1+2)=DATA VALUE +!C ... . +!C . . +!C . . +!C ...PRGOPT(LINK)=1 (no more options to change) +!C +!C Values of LINK that are nonpositive are errors. +!C A value of LINK.GT.NLINK=100000 is also an error. +!C This helps prevent using invalid but positive +!C values of LINK that will probably extend +!C beyond the program limits of PRGOPT(*). +!C Unrecognized values of KEY are ignored. The +!C order of the options is arbitrary and any number +!C of options can be changed with the following +!C restriction. To prevent cycling in the +!C processing of the option array a count of the +!C number of options changed is maintained. +!C Whenever this count exceeds NOPT=1000 an error +!C message is printed and the subprogram returns. +!C +!C OPTIONS.. +!C +!C KEY=6 +!C Scale the nonzero columns of the +!C entire data matrix +!C (E) +!C (A) +!C to have length one. The DATA SET for +!C this option is a single value. It must +!C be nonzero if unit length column scaling is +!C desired. +!C +!C KEY=7 +!C Scale columns of the entire data matrix +!C (E) +!C (A) +!C with a user-provided diagonal matrix. +!C The DATA SET for this option consists +!C of the N diagonal scaling factors, one for +!C each matrix column. +!C +!C KEY=8 +!C Change the rank determination tolerance from +!C the nominal value of SQRT(SRELPR). This quantity +!C can be no smaller than SRELPR, The arithmetic- +!C storage precision. The quantity used +!C here is internally restricted to be at +!C least SRELPR. The DATA SET for this option +!C is the new tolerance. +!C +!C KEY=9 +!C Change the blow-up parameter from the +!C nominal value of SQRT(SRELPR). The reciprocal of +!C this parameter is used in rejecting solution +!C components as too large when a variable is +!C first brought into the active set. Too large +!C means that the proposed component times the +!C reciprocal of the parameter is not less than +!C the ratio of the norms of the right-side +!C vector and the data matrix. +!C This parameter can be no smaller than SRELPR, +!C the arithmetic-storage precision. +!C +!C For example, suppose we want to provide +!C a diagonal matrix to scale the problem +!C matrix and change the tolerance used for +!C determining linear dependence of dropped col +!C vectors. For these options the dimensions of +!C PRGOPT(*) must be at least N+6. The FORTRAN +!C statements defining these options would +!C be as follows. +!C +!C PRGOPT(1)=N+3 (link to entry N+3 in PRGOPT(*)) +!C PRGOPT(2)=7 (user-provided scaling key) +!C +!C CALL SCOPY(N,D,1,PRGOPT(3),1) (copy the N +!C scaling factors from a user array called D(*) +!C into PRGOPT(3)-PRGOPT(N+2)) +!C +!C PRGOPT(N+3)=N+6 (link to entry N+6 of PRGOPT(*)) +!C PRGOPT(N+4)=8 (linear dependence tolerance key) +!C PRGOPT(N+5)=... (new value of the tolerance) +!C +!C PRGOPT(N+6)=1 (no more options to change) +!C +!C +!C IWORK(1), The amounts of working storage actually allocated +!C IWORK(2) for the working arrays WORK(*) and IWORK(*), +!C respectively. These quantities are compared with +!C the actual amounts of storage needed for WNNLS( ). +!C Insufficient storage allocated for either WORK(*) +!C or IWORK(*) is considered an error. This feature +!C was included in WNNLS( ) because miscalculating +!C the storage formulas for WORK(*) and IWORK(*) +!C might very well lead to subtle and hard-to-find +!C execution errors. +!C +!C The length of WORK(*) must be at least +!C +!C LW = ME+MA+5*N +!C This test will not be made if IWORK(1).LE.0. +!C +!C The length of IWORK(*) must be at least +!C +!C LIW = ME+MA+N +!C This test will not be made if IWORK(2).LE.0. +!C +!C OUTPUT.. +!C +!C X(*) An array dimensioned at least N, which will +!C contain the N components of the solution vector +!C on output. +!C +!C RNORM The residual norm of the solution. The value of +!C RNORM contains the residual vector length of the +!C equality constraints and least squares equations. +!C +!C MODE The value of MODE indicates the success or failure +!C of the subprogram. +!C +!C MODE = 0 Subprogram completed successfully. +!C +!C = 1 Max. number of iterations (equal to +!C 3*(N-L)) exceeded. Nearly all problems +!C should complete in fewer than this +!C number of iterations. An approximate +!C solution and its corresponding residual +!C vector length are in X(*) and RNORM. +!C +!C = 2 Usage error occurred. The offending +!C condition is noted with the error +!C processing subprogram, XERROR( ). +!C +!C User-designated +!C Working arrays.. +!C +!C WORK(*) A real-valued working array of length at least +!C M + 5*N. +!C +!C IWORK(*) An integer-valued working array of length at least +!C M+N. +!C***REFERENCES K.H. HASKELL AND R.J. HANSON, *AN ALGORITHM FOR +!C LINEAR LEAST SQUARES PROBLEMS WITH EQUALITY AND +!C NONNEGATIVITY CONSTRAINTS*, SAND77-0552, JUNE 1978. +!C K.H. HASKELL AND R.J. HANSON, *SELECTED ALGORITHMS FOR +!C THE LINEARLY CONSTRAINED LEAST SQUARES PROBLEM-- +!C A USERS GUIDE*, SAND78-1290, AUGUST 1979. +!C K.H. HASKELL AND R.H. HANSON, *AN ALGORITHM FOR +!C LINEAR LEAST SQUARES PROBLEMS WITH EQUALITY AND +!C NONNEGATIVITY CONSTRAINTS*, MATH. PROG. 21 (1981), +!C PP. 98-118. +!C R.J. HANSON AND K.H. HASKELL, *TWO ALGORITHMS FOR THE +!C LINEARLY CONSTRAINED LEAST SQUARES PROBLEM*, ACM +!C TRANS. ON MATH. SOFTWARE, SEPT. 1982. +!C***ROUTINES CALLED WNLSM,XERROR,XERRWV +!C***END PROLOGUE WNNLS +!C +!C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO +!C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. +!C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. +!C (START AT LINE WITH C++ IN COLS. 1-3.) +!C /REAL (12 BLANKS)/DOUBLE PRECISION/,/, DUMMY/,SNGL(DUMMY)/ +!C +!C WRITTEN BY KAREN H. HASKELL, SANDIA LABORATORIES, +!C AND R.J. HANSON, SANDIA LABORATORIES. +!C REVISED FEB.25, 1982. +!C +!C SUBROUTINES CALLED BY WNNLS( ) +!C +!C++ +!C WNLSM COMPANION SUBROUTINE TO WNNLS( ), WHERE +!C MOST OF THE COMPUTATION TAKES PLACE. +!C +!C XERROR,XERRWV FROM SLATEC ERROR PROCESSING PACKAGE. +!C THIS IS DOCUMENTED IN SANDIA TECH. REPT., +!C SAND78-1189. +!C +!C REFERENCES +!C +!C 1. SOLVING LEAST SQUARES PROBLEMS, BY C.L. LAWSON +!C AND R.J. HANSON. PRENTICE-HALL, INC. (1974). +!C +!C 2. BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE, BY +!C C.L. LAWSON, R.J. HANSON, D.R. KINCAID, AND F.T. KROGH. +!C TOMS, V. 5, NO. 3, P. 308. ALSO AVAILABLE AS +!C SANDIA TECHNICAL REPORT NO. SAND77-0898. +!C +!C 3. AN ALGORITHM FOR LINEAR LEAST SQUARES WITH EQUALITY +!C AND NONNEGATIVITY CONSTRAINTS, BY K.H. HASKELL AND +!C R.J. HANSON. AVAILABLE AS SANDIA TECHNICAL REPORT NO. +!C SAND77-0552, AND MATH. PROGRAMMING, VOL. 21, (1981), P. 98-118. +!C +!C 4. SLATEC COMMON MATH. LIBRARY ERROR HANDLING +!C PACKAGE. BY R. E. JONES. AVAILABLE AS SANDIA +!C TECHNICAL REPORT SAND78-1189. +!C +REAL DUMMY, W(MDW,1), PRGOPT(1), X(1), WORK(1), RNORM +INTEGER IWORK(*) +!C +!C +!C***FIRST EXECUTABLE STATEMENT WNNLS +MODE = 0 +iwork(1)=mdw*6 +iwork(2)=mdw*2 +IF (MA+ME.LE.0 .OR. N.LE.0) THEN + RETURN +ENDIF + +IF(.NOT.(IWORK(1).GT.0)) THEN + IF (.NOT.(IWORK(2).GT.0)) THEN + IF (.NOT.(MDW.LT.ME+MA)) THEN + IF (0.LE.L .AND. L.LE.N) THEN + L1 = N + 1 + L2 = L1 + N + L3 = L2 + ME + MA + L4 = L3 + N + L5 = L4 + N + CALL WNLSM(W, MDW, ME, MA, N, L, PRGOPT, X,RNORM,MODE,IWORK,IWORK(L1),WORK(1), WORK(L1), WORK(L2), WORK(L3),WORK(L4),WORK(L5)) + RETURN + ELSE + NERR = 2 + IOPT = 1 + CALL XERROR( 'WNNLS( ), L.LE.0.AND.L.LE.N IS REQUIRED', 39, NERR,IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + NERR = 1 + IOPT = 1 + CALL XERROR( 'WNNLS( ), THE VALUE MDW.LT.ME+MA IS AN ERROR', 44,NERR,IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + LIW = ME + MA + N + IF (.NOT.(IWORK(2).LT.LIW)) THEN + IF (.NOT.(MDW.LT.ME+MA)) THEN + IF (0.LE.L .AND. L.LE.N) THEN + L1 = N + 1 + L2 = L1 + N + L3 = L2 + ME + MA + L4 = L3 + N + L5 = L4 + N + CALL WNLSM(W, MDW, ME, MA, N, L, PRGOPT, X,RNORM,MODE,IWORK,IWORK(L1),WORK(1), WORK(L1), WORK(L2), WORK(L3),WORK(L4),WORK(L5)) + RETURN + ELSE + NERR = 2 + IOPT = 1 + CALL XERROR( 'WNNLS( ), L.LE.0.AND.L.LE.N IS REQUIRED', 39, NERR,IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + NERR = 1 + IOPT = 1 + CALL XERROR( 'WNNLS( ), THE VALUE MDW.LT.ME+MA IS AN ERROR',44,NERR,IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + NERR = 2 + IOPT = 1 + CALL XERRWV( 'WNNLS( ), INSUFFICIENT STORAGE ALLOCATED FOR IWORK(*),NEEDL IW=I1 BELOW', 72, NERR, IOPT, 1, LIW, 0, 0, DUMMY, DUMMY) + MODE = 2 + RETURN + ENDIF + ENDIF +ELSE + LW = ME + MA + 5*N + IF (.NOT.(IWORK(1).LT.LW)) THEN + IF (.NOT.(IWORK(2).GT.0)) THEN + IF (.NOT.(MDW.LT.ME+MA)) THEN + IF (0.LE.L .AND. L.LE.N) THEN + L1 = N + 1 + L2 = L1 + N + L3 = L2 + ME + MA + L4 = L3 + N + L5 = L4 + N + CALL WNLSM(W, MDW, ME, MA, N, L, PRGOPT, X, RNORM,MODE,IWORK,IWORK(L1),WORK(1), WORK(L1), WORK(L2), WORK(L3), WORK(L4),WORK(L5)) + RETURN + ELSE + NERR = 2 + IOPT = 1 + CALL XERROR( 'WNNLS( ), L.LE.0.AND.L.LE.N IS REQUIRED', 39, NERR,IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + NERR = 1 + IOPT = 1 + CALL XERROR( 'WNNLS( ), THE VALUE MDW.LT.ME+MA IS AN ERROR', 44,NERR, IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + LIW = ME + MA + N + IF (.NOT.(IWORK(2).LT.LIW)) THEN + IF (.NOT.(MDW.LT.ME+MA)) THEN + IF (0.LE.L .AND. L.LE.N) THEN + L1 = N + 1 + L2 = L1 + N + L3 = L2 + ME + MA + L4 = L3 + N + L5 = L4 + N + CALL WNLSM(W, MDW, ME, MA, N, L, PRGOPT, X, RNORM,MODE,IWORK,IWORK(L1),WORK(1), WORK(L1), WORK(L2), WORK(L3), WORK(L4),WORK(L5)) + RETURN + ELSE + NERR = 2 + IOPT = 1 + CALL XERROR( 'WNNLS( ), L.LE.0.AND.L.LE.N IS REQUIRED', 39, NERR,IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + NERR = 1 + IOPT = 1 + CALL XERROR( 'WNNLS( ), THE VALUE MDW.LT.ME+MA IS AN ERROR', 44,NERR,IOPT) + MODE = 2 + RETURN + ENDIF + ELSE + NERR = 2 + IOPT = 1 + CALL XERRWV( 'WNNLS( ), INSUFFICIENT STORAGE ALLOCATED FOR IWORK(*), NEEDL IW=I1 BELOW', 72, NERR, IOPT, 1, LIW, 0, 0, DUMMY, DUMMY) + MODE = 2 + RETURN + ENDIF + ENDIF + ELSE + NERR = 2 + IOPT = 1 + print*,'work array',iwork(1),lw + CALL XERRWV( 'WNNLS( ), INSUFFICIENT STORAGE ALLOCATED FOR WORK(*), NEED LW=I1 BELOW', 70, NERR, IOPT, 1, LW, 0, 0, DUMMY, DUMMY) + MODE = 2 + RETURN + ENDIF +ENDIF + +END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERABT.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERABT.f deleted file mode 100644 index 95990ae70..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERABT.f +++ /dev/null @@ -1,31 +0,0 @@ - SUBROUTINE XERABT(MESSG,NMESSG) -C***BEGIN PROLOGUE XERABT -C***DATE WRITTEN 790801 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. R3C -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Aborts program execution and prints error message. -C***DESCRIPTION -C Abstract -C ***Note*** machine dependent routine -C XERABT aborts the execution of the program. -C The error message causing the abort is given in the calling -C sequence, in case one needs it for printing on a dayfile, -C for example. -C -C Description of Parameters -C MESSG and NMESSG are as in XERROR, except that NMESSG may -C be zero, in which case no message is being supplied. -C -C Written by Ron Jones, with SLATEC Common Math Library Subcommittee -C Latest revision --- 19 MAR 1980 -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED (NONE) -C***END PROLOGUE XERABT - CHARACTER*(*) MESSG -C***FIRST EXECUTABLE STATEMENT XERABT - STOP - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERABT.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERABT.f90 new file mode 100644 index 000000000..a510b1e83 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERABT.f90 @@ -0,0 +1,33 @@ + SUBROUTINE XERABT(MESSG,NMESSG) +!C***BEGIN PROLOGUE XERABT +!C***DATE WRITTEN 790801 (YYMMDD) +!C***REVISION DATE 820801 (YYMMDD) +!C***CATEGORY NO. R3C +!C***KEYWORDS ERROR,XERROR PACKAGE +!C***AUTHOR JONES, R. E., (SNLA) +!C***PURPOSE Aborts program execution and prints error message. +!C***DESCRIPTION +!C Abstract +!C ***Note*** machine dependent routine +!C XERABT aborts the execution of the program. +!C The error message causing the abort is given in the calling +!C sequence, in case one needs it for printing on a dayfile, +!C for example. +!C +!C Description of Parameters +!C MESSG and NMESSG are as in XERROR, except that NMESSG may +!C be zero, in which case no message is being supplied. +!C +!C Written by Ron Jones, with SLATEC Common Math Library Subcommittee +!C Latest revision --- 19 MAR 1980 +!C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" +!C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," +!C 1982. +!C***ROUTINES CALLED (NONE) +!C***END PROLOGUE XERABT + implicit none + CHARACTER*(*) MESSG + integer nmessg +!C***FIRST EXECUTABLE STATEMENT XERABT + STOP + END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERCTL.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERCTL.f deleted file mode 100644 index 6020d5558..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERCTL.f +++ /dev/null @@ -1,47 +0,0 @@ - SUBROUTINE XERCTL(MESSG1,NMESSG,NERR,LEVEL,KONTRL) -C***BEGIN PROLOGUE XERCTL -C***DATE WRITTEN 790801 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. R3C -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Allows user control over handling of individual errors. -C***DESCRIPTION -C Abstract -C Allows user control over handling of individual errors. -C Just after each message is recorded, but before it is -C processed any further (i.e., before it is printed or -C a decision to abort is made), a call is made to XERCTL. -C If the user has provided his own version of XERCTL, he -C can then override the value of KONTROL used in processing -C this message by redefining its value. -C KONTRL may be set to any value from -2 to 2. -C The meanings for KONTRL are the same as in XSETF, except -C that the value of KONTRL changes only for this message. -C If KONTRL is set to a value outside the range from -2 to 2, -C it will be moved back into that range. -C -C Description of Parameters -C -C --Input-- -C MESSG1 - the first word (only) of the error message. -C NMESSG - same as in the call to XERROR or XERRWV. -C NERR - same as in the call to XERROR or XERRWV. -C LEVEL - same as in the call to XERROR or XERRWV. -C KONTRL - the current value of the control flag as set -C by a call to XSETF. -C -C --Output-- -C KONTRL - the new value of KONTRL. If KONTRL is not -C defined, it will remain at its original value. -C This changed value of control affects only -C the current occurrence of the current message. -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED (NONE) -C***END PROLOGUE XERCTL - CHARACTER*20 MESSG1 -C***FIRST EXECUTABLE STATEMENT XERCTL - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERCTL.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERCTL.f90 new file mode 100644 index 000000000..476ef014b --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERCTL.f90 @@ -0,0 +1,49 @@ + SUBROUTINE XERCTL(MESSG1,NMESSG,NERR,LEVEL,KONTRL) + implicit none +!C***BEGIN PROLOGUE XERCTL +!C***DATE WRITTEN 790801 (YYMMDD) +!C***REVISION DATE 820801 (YYMMDD) +!C***CATEGORY NO. R3C +!C***KEYWORDS ERROR,XERROR PACKAGE +!C***AUTHOR JONES, R. E., (SNLA) +!C***PURPOSE Allows user control over handling of individual errors. +!C***DESCRIPTION +!C Abstract +!C Allows user control over handling of individual errors. +!C Just after each message is recorded, but before it is +!C processed any further (i.e., before it is printed or +!C a decision to abort is made), a call is made to XERCTL. +!C If the user has provided his own version of XERCTL, he +!C can then override the value of KONTROL used in processing +!C this message by redefining its value. +!C KONTRL may be set to any value from -2 to 2. +!C The meanings for KONTRL are the same as in XSETF, except +!C that the value of KONTRL changes only for this message. +!C If KONTRL is set to a value outside the range from -2 to 2, +!C it will be moved back into that range. +!C +!C Description of Parameters +!C +!C --Input-- +!C MESSG1 - the first word (only) of the error message. +!C NMESSG - same as in the call to XERROR or XERRWV. +!C NERR - same as in the call to XERROR or XERRWV. +!C LEVEL - same as in the call to XERROR or XERRWV. +!C KONTRL - the current value of the control flag as set +!C by a call to XSETF. +!C +!C --Output-- +!C KONTRL - the new value of KONTRL. If KONTRL is not +!C defined, it will remain at its original value. +!C This changed value of control affects only +!C the current occurrence of the current message. +!C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" +!C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," +!C 1982. +!C***ROUTINES CALLED (NONE) +!C***END PROLOGUE XERCTL + CHARACTER*20 MESSG1 + integer nmessg,nerr,level,kontrl +!C***FIRST EXECUTABLE STATEMENT XERCTL + RETURN + END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERPRT.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERPRT.f deleted file mode 100644 index 6370bc017..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERPRT.f +++ /dev/null @@ -1,34 +0,0 @@ - SUBROUTINE XERPRT(MESSG,NMESSG) -C***BEGIN PROLOGUE XERPRT -C***DATE WRITTEN 790801 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. Z -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Prints error messages. -C***DESCRIPTION -C Abstract -C Print the Hollerith message in MESSG, of length NMESSG, -C on each file indicated by XGETUA. -C Latest revision --- 19 MAR 1980 -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED I1MACH,S88FMT,XGETUA -C***END PROLOGUE XERPRT - INTEGER LUN(5) - CHARACTER*(*) MESSG -C OBTAIN UNIT NUMBERS AND WRITE LINE TO EACH UNIT -C***FIRST EXECUTABLE STATEMENT XERPRT - CALL XGETUA(LUN,NUNIT) - LENMES = LEN(MESSG) - DO 20 KUNIT=1,NUNIT - IUNIT = LUN(KUNIT) - IF (IUNIT.EQ.0) IUNIT = I1MACH(4) - DO 10 ICHAR=1,LENMES,72 - LAST = MIN0(ICHAR+71 , LENMES) - WRITE (IUNIT,'(1X,A)') MESSG(ICHAR:LAST) - 10 CONTINUE - 20 CONTINUE - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERPRT.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERPRT.f90 new file mode 100644 index 000000000..90f5420d9 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERPRT.f90 @@ -0,0 +1,37 @@ + SUBROUTINE XERPRT(MESSG,NMESSG) + implicit none +!C***BEGIN PROLOGUE XERPRT +!C***DATE WRITTEN 790801 (YYMMDD) +!C***REVISION DATE 820801 (YYMMDD) +!C***CATEGORY NO. Z +!C***KEYWORDS ERROR,XERROR PACKAGE +!C***AUTHOR JONES, R. E., (SNLA) +!C***PURPOSE Prints error messages. +!C***DESCRIPTION +!C Abstract +!C Print the Hollerith message in MESSG, of length NMESSG, +!C on each file indicated by XGETUA. +!C Latest revision --- 19 MAR 1980 +!C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" +!C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," +!C 1982. +!C***ROUTINES CALLED I1MACH,S88FMT,XGETUA +!C***END PROLOGUE XERPRT + INTEGER LUN(5) + CHARACTER*(*) MESSG + integer lenmes,ichar,iunit,kunit,nunit,last,nmessg + integer, external :: I1MACH +!C OBTAIN UNIT NUMBERS AND WRITE LINE TO EACH UNIT +!C***FIRST EXECUTABLE STATEMENT XERPRT + CALL XGETUA(LUN,NUNIT) + LENMES = LEN(MESSG) + do kunit=1,nunit + IUNIT = LUN(KUNIT) + IF (IUNIT.EQ.0) IUNIT = I1MACH(4) + do ichar=1,lenmes,72 + LAST = MIN0(ICHAR+71 , LENMES) + WRITE (IUNIT,'(1X,A)') MESSG(ICHAR:LAST) + enddo + enddo + RETURN + END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERROR.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERROR.f deleted file mode 100644 index 56b0f9800..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERROR.f +++ /dev/null @@ -1,51 +0,0 @@ - SUBROUTINE XERROR(MESSG,NMESSG,NERR,LEVEL) -C***BEGIN PROLOGUE XERROR -C***DATE WRITTEN 790801 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. R3C -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Processes an error (diagnostic) message. -C***DESCRIPTION -C Abstract -C XERROR processes a diagnostic message, in a manner -C determined by the value of LEVEL and the current value -C of the library error control flag, KONTRL. -C (See subroutine XSETF for details.) -C -C Description of Parameters -C --Input-- -C MESSG - the Hollerith message to be processed, containing -C no more than 72 characters. -C NMESSG- the actual number of characters in MESSG. -C NERR - the error number associated with this message. -C NERR must not be zero. -C LEVEL - error category. -C =2 means this is an unconditionally fatal error. -C =1 means this is a recoverable error. (I.e., it is -C non-fatal if XSETF has been appropriately called.) -C =0 means this is a warning message only. -C =-1 means this is a warning message which is to be -C printed at most once, regardless of how many -C times this call is executed. -C -C Examples -C CALL XERROR('SMOOTH -- NUM WAS ZERO.',23,1,2) -C CALL XERROR('INTEG -- LESS THAN FULL ACCURACY ACHIEVED.', -C 43,2,1) -C CALL XERROR('ROOTER -- ACTUAL ZERO OF F FOUND BEFORE INTERVAL F -C 1ULLY COLLAPSED.',65,3,0) -C CALL XERROR('EXP -- UNDERFLOWS BEING SET TO ZERO.',39,1,-1) -C -C Latest revision --- 19 MAR 1980 -C Written by Ron Jones, with SLATEC Common Math Library Subcommittee -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED XERRWV -C***END PROLOGUE XERROR - CHARACTER*(*) MESSG -C***FIRST EXECUTABLE STATEMENT XERROR - CALL XERRWV(MESSG,NMESSG,NERR,LEVEL,0,0,0,0,0.,0.) - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERROR.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERROR.f90 new file mode 100644 index 000000000..160aaf6b3 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERROR.f90 @@ -0,0 +1,53 @@ + SUBROUTINE XERROR(MESSG,NMESSG,NERR,LEVEL) + implicit none +!C***BEGIN PROLOGUE XERROR +!C***DATE WRITTEN 790801 (YYMMDD) +!C***REVISION DATE 820801 (YYMMDD) +!C***CATEGORY NO. R3C +!C***KEYWORDS ERROR,XERROR PACKAGE +!C***AUTHOR JONES, R. E., (SNLA) +!C***PURPOSE Processes an error (diagnostic) message. +!C***DESCRIPTION +!C Abstract +!C XERROR processes a diagnostic message, in a manner +!C determined by the value of LEVEL and the current value +!C of the library error control flag, KONTRL. +!C (See subroutine XSETF for details.) +!C +!C Description of Parameters +!C --Input-- +!C MESSG - the Hollerith message to be processed, containing +!C no more than 72 characters. +!C NMESSG- the actual number of characters in MESSG. +!C NERR - the error number associated with this message. +!C NERR must not be zero. +!C LEVEL - error category. +!C =2 means this is an unconditionally fatal error. +!C =1 means this is a recoverable error. (I.e., it is +!C non-fatal if XSETF has been appropriately called.) +!C =0 means this is a warning message only. +!C =-1 means this is a warning message which is to be +!C printed at most once, regardless of how many +!C times this call is executed. +!C +!C Examples +!C CALL XERROR('SMOOTH -- NUM WAS ZERO.',23,1,2) +!C CALL XERROR('INTEG -- LESS THAN FULL ACCURACY ACHIEVED.', +!C 43,2,1) +!C CALL XERROR('ROOTER -- ACTUAL ZERO OF F FOUND BEFORE INTERVAL F +!C 1ULLY COLLAPSED.',65,3,0) +!C CALL XERROR('EXP -- UNDERFLOWS BEING SET TO ZERO.',39,1,-1) +!C +!C Latest revision --- 19 MAR 1980 +!C Written by Ron Jones, with SLATEC Common Math Library Subcommittee +!C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" +!C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," +!C 1982. +!C***ROUTINES CALLED XERRWV +!C***END PROLOGUE XERROR + CHARACTER*(*) MESSG + integer nmessg,nerr,level +!C***FIRST EXECUTABLE STATEMENT XERROR + CALL XERRWV(MESSG,NMESSG,NERR,LEVEL,0,0,0,0,0.,0.) + RETURN + END SUBROUTINE XERROR diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERRWV.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERRWV.f deleted file mode 100644 index 7dfa41267..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERRWV.f +++ /dev/null @@ -1,153 +0,0 @@ - SUBROUTINE XERRWV(MESSG,NMESSG,NERR,LEVEL,NI,I1,I2,NR,R1,R2) -C***BEGIN PROLOGUE XERRWV -C***DATE WRITTEN 800319 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. R3C -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Processes error message allowing 2 integer and two real -C values to be included in the message. -C***DESCRIPTION -C Abstract -C XERRWV processes a diagnostic message, in a manner -C determined by the value of LEVEL and the current value -C of the library error control flag, KONTRL. -C (See subroutine XSETF for details.) -C In addition, up to two integer values and two real -C values may be printed along with the message. -C -C Description of Parameters -C --Input-- -C MESSG - the Hollerith message to be processed. -C NMESSG- the actual number of characters in MESSG. -C NERR - the error number associated with this message. -C NERR must not be zero. -C LEVEL - error category. -C =2 means this is an unconditionally fatal error. -C =1 means this is a recoverable error. (I.e., it is -C non-fatal if XSETF has been appropriately called.) -C =0 means this is a warning message only. -C =-1 means this is a warning message which is to be -C printed at most once, regardless of how many -C times this call is executed. -C NI - number of integer values to be printed. (0 to 2) -C I1 - first integer value. -C I2 - second integer value. -C NR - number of real values to be printed. (0 to 2) -C R1 - first real value. -C R2 - second real value. -C -C Examples -C CALL XERRWV('SMOOTH -- NUM (=I1) WAS ZERO.',29,1,2, -C 1 1,NUM,0,0,0.,0.) -C CALL XERRWV('QUADXY -- REQUESTED ERROR (R1) LESS THAN MINIMUM ( -C 1R2).,54,77,1,0,0,0,2,ERRREQ,ERRMIN) -C -C Latest revision --- 19 MAR 1980 -C Written by Ron Jones, with SLATEC Common Math Library Subcommittee -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED FDUMP,I1MACH,J4SAVE,XERABT,XERCTL,XERPRT,XERSAV, -C XGETUA -C***END PROLOGUE XERRWV - CHARACTER*(*) MESSG - CHARACTER*20 LFIRST - CHARACTER*37 FORM - DIMENSION LUN(5) -C GET FLAGS -C***FIRST EXECUTABLE STATEMENT XERRWV - LKNTRL = J4SAVE(2,0,.FALSE.) - MAXMES = J4SAVE(4,0,.FALSE.) -C CHECK FOR VALID INPUT - IF ((NMESSG.GT.0).AND.(NERR.NE.0).AND. - 1 (LEVEL.GE.(-1)).AND.(LEVEL.LE.2)) GO TO 10 - IF (LKNTRL.GT.0) CALL XERPRT('FATAL ERROR IN...',17) - CALL XERPRT('XERROR -- INVALID INPUT',23) - IF (LKNTRL.GT.0) CALL FDUMP - IF (LKNTRL.GT.0) CALL XERPRT('JOB ABORT DUE TO FATAL ERROR.', - 1 29) - IF (LKNTRL.GT.0) CALL XERSAV(' ',0,0,0,KDUMMY) - CALL XERABT('XERROR -- INVALID INPUT',23) - RETURN - 10 CONTINUE -C RECORD MESSAGE - JUNK = J4SAVE(1,NERR,.TRUE.) - CALL XERSAV(MESSG,NMESSG,NERR,LEVEL,KOUNT) -C LET USER OVERRIDE - LFIRST = MESSG - LMESSG = NMESSG - LERR = NERR - LLEVEL = LEVEL - CALL XERCTL(LFIRST,LMESSG,LERR,LLEVEL,LKNTRL) -C RESET TO ORIGINAL VALUES - LMESSG = NMESSG - LERR = NERR - LLEVEL = LEVEL - LKNTRL = MAX0(-2,MIN0(2,LKNTRL)) - MKNTRL = IABS(LKNTRL) -C DECIDE WHETHER TO PRINT MESSAGE - IF ((LLEVEL.LT.2).AND.(LKNTRL.EQ.0)) GO TO 100 - IF (((LLEVEL.EQ.(-1)).AND.(KOUNT.GT.MIN0(1,MAXMES))) - 1.OR.((LLEVEL.EQ.0) .AND.(KOUNT.GT.MAXMES)) - 2.OR.((LLEVEL.EQ.1) .AND.(KOUNT.GT.MAXMES).AND.(MKNTRL.EQ.1)) - 3.OR.((LLEVEL.EQ.2) .AND.(KOUNT.GT.MAX0(1,MAXMES)))) GO TO 100 - IF (LKNTRL.LE.0) GO TO 20 - CALL XERPRT(' ',1) -C INTRODUCTION - IF (LLEVEL.EQ.(-1)) CALL XERPRT - 1('WARNING MESSAGE...THIS MESSAGE WILL ONLY BE PRINTED ONCE.',57) - IF (LLEVEL.EQ.0) CALL XERPRT('WARNING IN...',13) - IF (LLEVEL.EQ.1) CALL XERPRT - 1 ('RECOVERABLE ERROR IN...',23) - IF (LLEVEL.EQ.2) CALL XERPRT('FATAL ERROR IN...',17) - 20 CONTINUE -C MESSAGE - CALL XERPRT(MESSG,LMESSG) - CALL XGETUA(LUN,NUNIT) - ISIZEI = LOG10(FLOAT(I1MACH(9))) + 1.0 - ISIZEF = LOG10(FLOAT(I1MACH(10))**I1MACH(11)) + 1.0 - DO 50 KUNIT=1,NUNIT - IUNIT = LUN(KUNIT) - IF (IUNIT.EQ.0) IUNIT = I1MACH(4) - DO 22 I=1,MIN(NI,2) - WRITE (FORM,21) I,ISIZEI - 21 FORMAT ('(11X,21HIN ABOVE MESSAGE, I',I1,'=,I',I2,') ') - IF (I.EQ.1) WRITE (IUNIT,FORM) I1 - IF (I.EQ.2) WRITE (IUNIT,FORM) I2 - 22 CONTINUE - DO 24 I=1,MIN(NR,2) - WRITE (FORM,23) I,ISIZEF+10,ISIZEF - 23 FORMAT ('(11X,21HIN ABOVE MESSAGE, R',I1,'=,E', - 1 I2,'.',I2,')') - IF (I.EQ.1) WRITE (IUNIT,FORM) R1 - IF (I.EQ.2) WRITE (IUNIT,FORM) R2 - 24 CONTINUE - IF (LKNTRL.LE.0) GO TO 40 -C ERROR NUMBER - WRITE (IUNIT,30) LERR - 30 FORMAT (15H ERROR NUMBER =,I10) - 40 CONTINUE - 50 CONTINUE -C TRACE-BACK - IF (LKNTRL.GT.0) CALL FDUMP - 100 CONTINUE - IFATAL = 0 - IF ((LLEVEL.EQ.2).OR.((LLEVEL.EQ.1).AND.(MKNTRL.EQ.2))) - 1IFATAL = 1 -C QUIT HERE IF MESSAGE IS NOT FATAL - IF (IFATAL.LE.0) RETURN - IF ((LKNTRL.LE.0).OR.(KOUNT.GT.MAX0(1,MAXMES))) GO TO 120 -C PRINT REASON FOR ABORT - IF (LLEVEL.EQ.1) CALL XERPRT - 1 ('JOB ABORT DUE TO UNRECOVERED ERROR.',35) - IF (LLEVEL.EQ.2) CALL XERPRT - 1 ('JOB ABORT DUE TO FATAL ERROR.',29) -C PRINT ERROR SUMMARY - CALL XERSAV(' ',-1,0,0,KDUMMY) - 120 CONTINUE -C ABORT - IF ((LLEVEL.EQ.2).AND.(KOUNT.GT.MAX0(1,MAXMES))) LMESSG = 0 - CALL XERABT(MESSG,LMESSG) - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERRWV.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERRWV.f90 new file mode 100644 index 000000000..ede1e84c5 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERRWV.f90 @@ -0,0 +1,309 @@ +subroutine xerrwv ( messg, nmessg, nerr, level, ni, i1, i2, nr, r1, r2 ) + +!*****************************************************************************80 +! +!! XERRWV processes an error message that includes numeric information. +! +! Discussion: +! +! This routine processes a diagnostic message, in a manner determined +! by the value of LEVEL and the current value of the library error +! control flag KONTRL. +! +! See XSETF for details about KONTRL. +! +! In addition, up to two integer values and two real values may be +! printed along with the message. +! +! Example: +! +! call xerrwv ( 'SMOOTH -- NUM (=I1) was zero.', 29, 1, 2, 1, num, +! 0, 0, 0.0, 0.0 ) +! +! call xerrwv ( & +! 'QUADXY -- Requested error (R1) less than minimum(R2).', & +! 54, 77, 1, 0, 0, 0, 2, errreq, errmin ) +! +! Modified: +! +! 05 April 2007 +! +! Author: +! +! Ron Jones +! +! Reference: +! +! Ron Jones, David Kahaner, +! XERROR, The SLATEC Error Handling Package, +! Technical Report SAND82-0800, +! Sandia National Laboratories, 1982. +! +! Ron Jones, David Kahaner, +! XERROR, The SLATEC Error Handling Package, +! Software: Practice and Experience, +! Volume 13, Number 3, 1983, pages 251-257. +! +! David Kahaner, Cleve Moler, Steven Nash, +! Numerical Methods and Software, +! Prentice Hall, 1989, +! ISBN: 0-13-627258-4, +! LC: TA345.K34. +! +! Parameters: +! +! Input, character ( len = * ) MESSG, the message to be processed. +! +! Input, integer ( kind = 4 ) NMESSG, the number of characters in +! MESSG. +! +! Input, integer ( kind = 4 ) NERR, the error number associated with +! this message. NERR must not be zero. +! +! Input, integer ( kind = 4 ) LEVEL, the error category. +! * 2, this is an unconditionally fatal error. +! * 1, this is a recoverable error. It is normally non-fatal, unless +! KONTRL has been reset by XSETF. +! * 0, this is a warning message only. +! *-1, this is a warning message which is to be printed at most once, +! regardless of how many times this call is executed. +! +! Input, integer ( kind = 4 ) NI, the number of integer values to be +! printed. (0 to 2) +! +! Input, integer ( kind = 4 ) I1, I2, the first and second integer +! values. +! +! Input, integer ( kind = 4 ) NR, the number of real values to be +! printed. +! (0 to 2) +! +! Input, real ( kind = 8 ) R1, R2, the first and second real values. +! + implicit none + + character ( len = 37 ) form + integer ( kind = 4 ) i + integer ( kind = 4 ) i1 + integer ( kind = 4 ) i1mach + integer ( kind = 4 ) i2 + integer ( kind = 4 ) ifatal + integer ( kind = 4 ) isizei + integer ( kind = 4 ) isizef + integer ( kind = 4 ) iunit + integer ( kind = 4 ) j4save + integer ( kind = 4 ) junk + integer ( kind = 4 ) kdummy + integer ( kind = 4 ) kount + integer ( kind = 4 ) kunit + integer ( kind = 4 ) lerr + integer ( kind = 4 ) level + integer ( kind = 4 ) lkntrl + integer ( kind = 4 ) llevel + integer ( kind = 4 ) lmessg + integer ( kind = 4 ) lun(5) + integer ( kind = 4 ) maxmes + character ( len = * ) messg + integer ( kind = 4 ) mkntrl + integer ( kind = 4 ) nerr + integer ( kind = 4 ) ni + integer ( kind = 4 ) nmessg + integer ( kind = 4 ) nr + integer ( kind = 4 ) nunit + real ( kind = 8 ) r1 + real ( kind = 8 ) r2 + logical set + integer ( kind = 4 ) value + integer ( kind = 4 ) which +! +! Get flags +! + which = 2 + value = 0 + set = .false. + + lkntrl = j4save ( which, value, set ) + + which = 4 + value = 0 + set = .false. + + maxmes = j4save ( which, value, set ) +! +! Check for valid input +! + if ( nmessg <= 0 .or. & + nerr == 0 .or. & + level < -1 .or. & + 2 < level ) then + + if ( 0 < lkntrl ) then + call xerprt ( 'Fatal error in...', 17 ) + end if + + call xerprt( 'XERROR -- Invalid input', 23 ) + + if ( 0 < lkntrl ) then + call xerprt ( 'Job abort due to fatal error.', 29 ) + end if + + if ( 0 < lkntrl ) then + call xersav ( ' ', 0, 0, 0, kdummy ) + end if + + call xerabt ( 'XERROR -- invalid input', 23 ) + return + + end if +! +! Record the message. +! + which = 1 + value = nerr + set = .true. + + junk = j4save ( which, value, set ) + + call xersav ( messg, nmessg, nerr, level, kount ) +! +! Let the user override. +! + lmessg = nmessg + lerr = nerr + llevel = level + + call xerctl ( messg, lmessg, lerr, llevel, lkntrl ) +! +! Reset to original values. +! + lmessg = nmessg + lerr = nerr + llevel = level + + lkntrl = max ( -2, min ( 2, lkntrl ) ) + mkntrl = abs ( lkntrl ) +! +! Decide whether to print message +! + if ( .NOT. (llevel < 2 .and. lkntrl == 0 ) ) then +! end if + + elseif ( .NOT. ( ( llevel == -1 .and. min ( 1, maxmes ) < kount ) .or. & + ( llevel == 0 .and. maxmes < kount ) .or. & + ( llevel == 1 .and. maxmes < kount .and. mkntrl == 1 ) .or. & + ( llevel == 2 .and. max ( 1, maxmes ) < kount ) ) ) then +! end if + + if ( 0 < lkntrl ) then + + call xerprt ( ' ', 1 ) + + if ( llevel == -1 ) then + call xerprt & + ( 'Warning message...this message will only be printed once.',57) + else if ( llevel == 0 ) then + call xerprt ( 'Warning in...', 13 ) + else if ( llevel == 1 ) then + call xerprt ( 'Recoverable error in...', 23 ) + else if ( llevel == 2 ) then + call xerprt ( 'Fatal error in...', 17 ) + end if + + end if +! +! Message. +! + call xerprt ( messg, lmessg ) + call xgetua(lun,nunit) + isizei = 1 + int ( log10 ( real ( i1mach(9), kind = 8 ) ) ) + isizef = 1 + int ( log10 ( real ( i1mach(10), kind = 8 )**i1mach(14) )) + + do kunit = 1, nunit + + iunit = lun(kunit) + + do i = 1, min ( ni, 2 ) + write (form,21) i,isizei + 21 format ('(11x,21hin above message, i',i1,'=,i',i2,') ') + if ( iunit == 0 ) then + if ( i == 1 ) write (*,form) i1 + if ( i == 2 ) write (*,form) i2 + else + if ( i == 1 ) write (iunit,form) i1 + if ( i == 2 ) write (iunit,form) i2 + end if + end do + + do i = 1, min ( nr, 2 ) + write (form,23) i,isizef+10,isizef + 23 format ('(11x,21hin above message, r',i1,'=,e',i2,'.',i2,')') + if ( iunit == 0 ) then + if ( i == 1 ) write (*,form) r1 + if ( i == 2 ) write (*,form) r2 + else + if ( i == 1 ) write (iunit,form) r1 + if ( i == 2 ) write (iunit,form) r2 + end if + end do +! +! Print the error number. +! + if ( 0 < lkntrl ) then + + if ( iunit == 0 ) then + write ( *, '(a,i10)' ) ' Error number = ', lerr + else + write ( iunit, '(a,i10)' ) ' Error number = ', lerr + end if + + end if + + end do +! +! Traceback +! + if ( 0 < lkntrl ) then + call fdump ( ) + end if + + else + + if ( llevel == 2 .or. ( llevel == 1 .and. mkntrl ==2 ) ) then + ifatal = 1 + else + ifatal = 0 + end if +! +! Quit here if message is not fatal. +! + if ( ifatal <= 0 ) then + return + end if +! +! Print reason for abort and error summary. +! + if ( 0 < lkntrl .and. kount <= max ( 1, maxmes ) ) then + + if ( llevel == 1 ) then + call xerprt ( 'Job abort due to unrecovered error.', 35 ) + end if + + if ( llevel == 2 ) then + call xerprt ( 'Job abort due to fatal error.', 29 ) + end if + + call xersav ( ' ', -1, 0, 0, kdummy ) + + end if +! +! Abort +! + if ( llevel == 2 .and. max ( 1, maxmes ) < kount ) then + lmessg = 0 + end if + + call xerabt ( messg, lmessg ) + + return + endif +end subroutine xerrwv diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERSAV.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERSAV.f deleted file mode 100644 index 89a88ade9..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERSAV.f +++ /dev/null @@ -1,104 +0,0 @@ - SUBROUTINE XERSAV(MESSG,NMESSG,NERR,LEVEL,ICOUNT) -C***BEGIN PROLOGUE XERSAV -C***DATE WRITTEN 800319 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. Z -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Records that an error occurred. -C***DESCRIPTION -C Abstract -C Record that this error occurred. -C -C Description of Parameters -C --Input-- -C MESSG, NMESSG, NERR, LEVEL are as in XERROR, -C except that when NMESSG=0 the tables will be -C dumped and cleared, and when NMESSG is less than zero the -C tables will be dumped and not cleared. -C --Output-- -C ICOUNT will be the number of times this message has -C been seen, or zero if the table has overflowed and -C does not contain this message specifically. -C When NMESSG=0, ICOUNT will not be altered. -C -C Written by Ron Jones, with SLATEC Common Math Library Subcommittee -C Latest revision --- 19 Mar 1980 -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED I1MACH,S88FMT,XGETUA -C***END PROLOGUE XERSAV - INTEGER LUN(5) - CHARACTER*(*) MESSG - CHARACTER*20 MESTAB(10),MES - DIMENSION NERTAB(10),LEVTAB(10),KOUNT(10) - SAVE MESTAB,NERTAB,LEVTAB,KOUNT,KOUNTX -C NEXT TWO DATA STATEMENTS ARE NECESSARY TO PROVIDE A BLANK -C ERROR TABLE INITIALLY - DATA KOUNT(1),KOUNT(2),KOUNT(3),KOUNT(4),KOUNT(5), - 1 KOUNT(6),KOUNT(7),KOUNT(8),KOUNT(9),KOUNT(10) - 2 /0,0,0,0,0,0,0,0,0,0/ - DATA KOUNTX/0/ -C***FIRST EXECUTABLE STATEMENT XERSAV - IF (NMESSG.GT.0) GO TO 80 -C DUMP THE TABLE - IF (KOUNT(1).EQ.0) RETURN -C PRINT TO EACH UNIT - CALL XGETUA(LUN,NUNIT) - DO 60 KUNIT=1,NUNIT - IUNIT = LUN(KUNIT) - IF (IUNIT.EQ.0) IUNIT = I1MACH(4) -C PRINT TABLE HEADER - WRITE (IUNIT,10) - 10 FORMAT (32H0 ERROR MESSAGE SUMMARY/ - 1 51H MESSAGE START NERR LEVEL COUNT) -C PRINT BODY OF TABLE - DO 20 I=1,10 - IF (KOUNT(I).EQ.0) GO TO 30 - WRITE (IUNIT,15) MESTAB(I),NERTAB(I),LEVTAB(I),KOUNT(I) - 15 FORMAT (1X,A20,3I10) - 20 CONTINUE - 30 CONTINUE -C PRINT NUMBER OF OTHER ERRORS - IF (KOUNTX.NE.0) WRITE (IUNIT,40) KOUNTX - 40 FORMAT (41H0OTHER ERRORS NOT INDIVIDUALLY TABULATED=,I10) - WRITE (IUNIT,50) - 50 FORMAT (1X) - 60 CONTINUE - IF (NMESSG.LT.0) RETURN -C CLEAR THE ERROR TABLES - DO 70 I=1,10 - 70 KOUNT(I) = 0 - KOUNTX = 0 - RETURN - 80 CONTINUE -C PROCESS A MESSAGE... -C SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG, -C OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL. - MES = MESSG - DO 90 I=1,10 - II = I - IF (KOUNT(I).EQ.0) GO TO 110 - IF (MES.NE.MESTAB(I)) GO TO 90 - IF (NERR.NE.NERTAB(I)) GO TO 90 - IF (LEVEL.NE.LEVTAB(I)) GO TO 90 - GO TO 100 - 90 CONTINUE -C THREE POSSIBLE CASES... -C TABLE IS FULL - KOUNTX = KOUNTX+1 - ICOUNT = 1 - RETURN -C MESSAGE FOUND IN TABLE - 100 KOUNT(II) = KOUNT(II) + 1 - ICOUNT = KOUNT(II) - RETURN -C EMPTY SLOT FOUND FOR NEW MESSAGE - 110 MESTAB(II) = MES - NERTAB(II) = NERR - LEVTAB(II) = LEVEL - KOUNT(II) = 1 - ICOUNT = 1 - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERSAV.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERSAV.f90 new file mode 100644 index 000000000..f34e9be99 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XERSAV.f90 @@ -0,0 +1,188 @@ + subroutine xersav ( messg, nmessg, nerr, level, count ) + +!*****************************************************************************80 +! +!! XERSAV records that an error occurred. +! +! Modified: +! +! 05 April 2007 +! +! Author: +! +! Ron Jones +! +! Reference: +! +! Ron Jones, David Kahaner, +! XERROR, The SLATEC Error Handling Package, +! Technical Report SAND82-0800, +! Sandia National Laboratories, 1982. +! +! Ron Jones, David Kahaner, +! XERROR, The SLATEC Error Handling Package, +! Software: Practice and Experience, +! Volume 13, Number 3, 1983, pages 251-257. +! +! David Kahaner, Cleve Moler, Steven Nash, +! Numerical Methods and Software, +! Prentice Hall, 1989, +! ISBN: 0-13-627258-4, +! LC: TA345.K34. +! +! Parameters: +! +! Input, character ( len = * ) MESSG, as in XERROR. +! +! Input, integer ( kind = 4 ) NMESSG, as in XERROR, except that, when +! NMESSG = 0, the tables will be dumped and cleared; and when NMESSG +! < 0, +! the tables will be dumped, but not cleared. +! +! Input, integer ( kind = 4 ) NERR, the error number. NERR should +! not be 0. +! +! Input, integer ( kind = 4 ) LEVEL, the error severity level. +! * 2, this is an unconditionally fatal error. +! * 1, this is a recoverable error. It is normally non-fatal, unless +! KONTRL has been reset by XSETF. +! * 0, this is a warning message only. +! *-1, this is a warning message which is to be printed at most once, +! regardless of how many times this call is executed. +! +! Output, integer ( kind = 4 ) COUNT, the number of times this +! message has +! been seen, or zero if the table has overflowed and does not contain +! this message specifically. +! When NMESSG = 0, COUNT will not be altered. +! + implicit none + + integer ( kind = 4 ) count + integer ( kind = 4 ) i + integer ( kind = 4 ) i1mach + integer ( kind = 4 ) ii + integer ( kind = 4 ) iunit + integer ( kind = 4 ), save, dimension ( 10 ) :: kount = (/ & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer ( kind = 4 ), save :: kountx = 0 + integer ( kind = 4 ) kunit + integer ( kind = 4 ) level + integer ( kind = 4 ), save, dimension ( 10 ) :: levtab = (/ & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer ( kind = 4 ) lun(5) + character ( len = 20 ) mes + character ( len = * ) messg + character ( len = 20 ), save, dimension ( 10 ) :: mestab + integer ( kind = 4 ) nerr + integer ( kind = 4 ), save, dimension ( 10 ) :: nertab = (/ & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer ( kind = 4 ) nmessg + integer ( kind = 4 ) nunit +! +! Dump the table +! + if ( nmessg <= 0 ) then + + if ( kount(1) == 0 ) then + return + end if +! +! Print to each unit +! + call xgetua ( lun, nunit ) + + do kunit = 1, nunit + + iunit = lun(kunit) + if ( iunit == 0 ) then + iunit = i1mach(4) + end if +! +! Print table header +! + write ( iunit, '(a)' ) ' ' + write ( iunit, '(a)' ) & + ' Error message summary' + write ( iunit, '(a)' ) & + 'Message start NERR Level Count' +! +! Print body of table. +! + do i = 1, 10 + + if ( kount(i) == 0 ) then + exit + end if + + write ( iunit, '(a20,3i10)' ) & + mestab(i), nertab(i), levtab(i), kount(i) + + end do +! +! Print number of other errors. +! + if ( kountx /= 0 ) then + write ( iunit, '(a)' ) ' ' + write ( iunit, '(a,i10)' ) & + 'Other errors not individually tabulated = ', kountx + end if + + write ( iunit, '(a)' ) ' ' + + end do + + if ( nmessg < 0 ) then + return + end if +! +! Clear the error tables. +! + kount(1:10) = 0 + kountx = 0 +! +! Process a message. +! +! Search for this message, or else an empty slot for this message, +! or else determine that the error table is full. +! + else + + mes(1:20) = messg(1:20) + + do i = 1, 10 + + ii = i +! +! An empty slot was found for the new message. +! + if ( kount(i) == 0 ) then + mestab(ii) = mes + nertab(ii) = nerr + levtab(ii) = level + kount(ii) = 1 + count = 1 + return + end if +! +! Message found in table. +! + if ( mes == mestab(i) .and. & + nerr == nertab(i) .and. & + level == levtab(i) ) then + kount(ii) = kount(ii) + 1 + count = kount(ii) + return + end if + + end do +! +! The table is full. +! + kountx = kountx + 1 + count = 1 + + end if + + return + end subroutine xersav diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XGETUA.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XGETUA.f deleted file mode 100644 index 2f0e5f6f7..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XGETUA.f +++ /dev/null @@ -1,46 +0,0 @@ - SUBROUTINE XGETUA(IUNITA,N) -C***BEGIN PROLOGUE XGETUA -C***DATE WRITTEN 790801 (YYMMDD) -C***REVISION DATE 820801 (YYMMDD) -C***CATEGORY NO. R3C -C***KEYWORDS ERROR,XERROR PACKAGE -C***AUTHOR JONES, R. E., (SNLA) -C***PURPOSE Returns unit number(s) to which error messages are being -C sent. -C***DESCRIPTION -C Abstract -C XGETUA may be called to determine the unit number or numbers -C to which error messages are being sent. -C These unit numbers may have been set by a call to XSETUN, -C or a call to XSETUA, or may be a default value. -C -C Description of Parameters -C --Output-- -C IUNIT - an array of one to five unit numbers, depending -C on the value of N. A value of zero refers to the -C default unit, as defined by the I1MACH machine -C constant routine. Only IUNIT(1),...,IUNIT(N) are -C defined by XGETUA. The values of IUNIT(N+1),..., -C IUNIT(5) are not defined (for N .LT. 5) or altered -C in any way by XGETUA. -C N - the number of units to which copies of the -C error messages are being sent. N will be in the -C range from 1 to 5. -C -C Latest revision --- 19 MAR 1980 -C Written by Ron Jones, with SLATEC Common Math Library Subcommittee -C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" -C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," -C 1982. -C***ROUTINES CALLED J4SAVE -C***END PROLOGUE XGETUA - DIMENSION IUNITA(5) -C***FIRST EXECUTABLE STATEMENT XGETUA - N = J4SAVE(5,0,.FALSE.) - DO 30 I=1,N - INDEX = I+4 - IF (I.EQ.1) INDEX = 3 - IUNITA(I) = J4SAVE(INDEX,0,.FALSE.) - 30 CONTINUE - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/XGETUA.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XGETUA.f90 new file mode 100644 index 000000000..82abddd85 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/XGETUA.f90 @@ -0,0 +1,52 @@ + SUBROUTINE XGETUA(IUNITA,N) + use setparms + implicit none + +!***BEGIN PROLOGUE XGETUA +!***DATE WRITTEN 790801 (YYMMDD) +!***REVISION DATE 820801 (YYMMDD) +!***CATEGORY NO. R3C +!***KEYWORDS ERROR,XERROR PACKAGE +!***AUTHOR JONES, R. E., (SNLA) +!***PURPOSE Returns unit number(s) to which error messages are being +! sent. +!***DESCRIPTION +! Abstract +! XGETUA may be called to determine the unit number or numbers +! to which error messages are being sent. +! These unit numbers may have been set by a call to XSETUN, +! or a call to XSETUA, or may be a default value. +! +! Description of Parameters +! --Output-- +! IUNIT - an array of one to five unit numbers, depending +! on the value of N. A value of zero refers to the +! default unit, as defined by the I1MACH machine +! constant routine. Only IUNIT(1),...,IUNIT(N) are +! defined by XGETUA. The values of IUNIT(N+1),..., +! IUNIT(5) are not defined (for N .LT. 5) or altered +! in any way by XGETUA. +! N - the number of units to which copies of the +! error messages are being sent. N will be in the +! range from 1 to 5. +! +! Latest revision --- 19 MAR 1980 +! Written by Ron Jones, with SLATEC Common Math Library Subcommittee +!***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-" +! HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES," +! 1982. +!***ROUTINES CALLED J4SAVE +!***END PROLOGUE XGETUA + ! DIMENSION IUNITA(5) + integer,dimension(5) :: iunita + integer :: N,i,index + integer, external:: J4SAVE +!***FIRST EXECUTABLE STATEMENT XGETUA + N = J4SAVE(5,0,.FALSE.) + do i=1,n + INDEX = I+4 + IF (I.EQ.1) INDEX = 3 + IUNITA(I) = J4SAVE(INDEX,0,.FALSE.) + enddo + RETURN + END SUBROUTINE XGETUA diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/amatrix.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/amatrix.f deleted file mode 100644 index 0e84ed95e..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/amatrix.f +++ /dev/null @@ -1,21 +0,0 @@ - subroutine amatrix - parameter(nmx=24) - common /matrix/ a(nmx,nmx),capd2 - COMMON /POSIT/ XOLD,YOLD,XCORN,YCORN - common /vect/rovect(nmx),xvect(nmx),yvect(nmx) -c - PI180 = 4.*ATAN(1.0)/180. - yo=yold*pi180 -c qliu fact=cos(yo) - fact=1.0 -c capd2=(3.15)*(3.15) - capd2=(2.25)*(2.25) - do 10 ip=1,nmx - do 10 jp=ip,nmx - dpij=(fact*(xvect(ip)-xvect(jp)))**2 +(yvect(ip)-yvect(jp))**2 - a(ip,jp)= exp(-dpij/capd2) - a(jp,ip)= a(ip,jp) -10 continue -100 format(5f8.4) - return - end diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/amatrix.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/amatrix.f90 new file mode 100644 index 000000000..7077f3f61 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/amatrix.f90 @@ -0,0 +1,29 @@ + subroutine amatrix + use matrix, only: a, capd2,nmx + use posit, only: xold,yold,xcorn,ycorn + use vect, only: xvect,yvect!,rovect + + implicit none + real:: dpij,PI180,fact,yo + integer:: ip,jp + +!c + PI180 = 4.*ATAN(1.0)/180. + yo=yold*pi180 + +! print*,'yold',yold + +!c qliu fact=cos(yo) + fact=1.0 +!c capd2=(3.15)*(3.15) + capd2=(2.25)*(2.25) + do ip=1,nmx + do jp=ip,nmx + dpij=(fact*(xvect(ip)-xvect(jp)))**2 +(yvect(ip)-yvect(jp))**2 + a(ip,jp)= exp(-dpij/capd2) + a(jp,ip)= a(ip,jp) + enddo + enddo +100 format(5f8.4) + return + end subroutine amatrix diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/create_rel_domain.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/create_rel_domain.f deleted file mode 100644 index 27b512c31..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/create_rel_domain.f +++ /dev/null @@ -1,504 +0,0 @@ -!?????????????????????????????????????????????????????????? - SUBROUTINE CREAT_41X41(ITIM,KST,KMX,MTV6,KS850,U850,V850, - & SDAT,P2) -! SUBPROGRAM -! PRGRMMR -! -! ABSTRACT -! -! DECLARE VARIABLES -! - INTEGER I,J,K,NX,NY,NZ -! -! PARAMETER (NX=215,NY=431,NZ=42) - PARAMETER (NST=10,IRX=41,JRX=41,MAXNGRID=10000) - PARAMETER (GAMMA=6.5E-3,G=9.8,GI=1./G,D608=0.608) -! -! variable for outer nest - - REAL(4), ALLOCATABLE :: T3(:,:,:),Q3(:,:,:) - REAL(4), ALLOCATABLE :: U3(:,:,:),V3(:,:,:),W3(:,:,:) - REAL(4), ALLOCATABLE :: Z3(:,:,:),P3(:,:,:) - REAL(4), ALLOCATABLE :: SLP3(:,:),HP3(:,:,:),RH3(:,:) - - REAL(4), ALLOCATABLE :: ZM3(:,:,:),PM3(:,:,:) - REAL(4), ALLOCATABLE :: PMV3(:,:,:),TV3(:,:,:) - - REAL(4), ALLOCATABLE :: HLON3(:,:),HLAT3(:,:) - REAL(4), ALLOCATABLE :: VLON3(:,:),VLAT3(:,:) - -! REAL(4) DLMD3,DPHD3,CLON3,CLAT3,PT3,PDTOP3 - REAL(4) LON1,LAT1,LON2,LAT2,CLON3,CLAT3 - - real(4),allocatable :: UT850(:,:),VT850(:,:) - real(4),allocatable :: wrk1(:,:,:),wrk2(:,:,:) - - integer(4) IGD(IRX,JRX,MAXNGRID),JGD(IRX,JRX,MAXNGRID) - integer(4) NSUM(IRX,JRX),NGRID,KST - real WGD(IRX,JRX,MAXNGRID),WSUM(IRX,JRX) - - REAL(4) BLON(IRX), BLAT(JRX) - - REAL(4) U850(IRX,JRX),V850(IRX,JRX) - - REAL(4) P2(KMX),SDAT(IRX,JRX,MTV6) - -! Variables on P surface - - real(4) SLON_N,SLAT_N,CLON_N,CLAT_N - - COMMON /NHC/ KSTM,IC_N(NST),JC_N(NST) - COMMON /NHC1/ SLON_N(NST),SLAT_N(NST),CLON_N(NST),CLAT_N(NST) - CHARACTER ST_NAME(NST)*3,STMNAME(NST)*3,TCVT(NST)*95 - COMMON /STNAME/ST_NAME,STMNAME - COMMON /TCVIT/TCVT - COMMON /RSFC/STRPSF(NST),STVMAX(NST) -! - COEF3=287.05*GI*GAMMA - COEF2=1./COEF3 - - pi=4.*atan(1.) - pi_deg=180./pi - pi180=pi/180. -! read data - -! READ(5,*)ITIM,IBGS - -! newly added -! compute SDATA from outter nest domain - - IUNIT=46 - - READ(IUNIT)KX,KY,KZ - KZ1=KZ+1 - print*,'KX,KY,KZ=',KX,KY,KZ - - max_kz_kmx=kz - if(kmx .gt. kz) then - max_kz_kmx=kmx - end if - - ALLOCATE ( HLON3(KX,KY),HLAT3(KX,KY) ) - ALLOCATE ( VLON3(KX,KY),VLAT3(KX,KY) ) - - ALLOCATE ( T3(KX,KY,KZ),Q3(KX,KY,KZ) ) - ALLOCATE ( U3(KX,KY,KZ),V3(KX,KY,KZ),W3(KX,KY,KZ) ) - ALLOCATE ( Z3(KX,KY,KZ1),P3(KX,KY,KZ1) ) - - ALLOCATE ( SLP3(KX,KY),ZM3(KX,KY,KZ) ) - ALLOCATE ( HP3(KX,KY,max_kz_kmx),RH3(KX,KY) ) - ALLOCATE ( PM3(KX,KY,KZ),PMV3(KX,KY,KZ) ) - ALLOCATE ( TV3(KX,KY,KZ) ) - - ALLOCATE ( wrk1(KX,KY,KMX), wrk2(KX,KY,KMX) ) - ALLOCATE ( UT850(KX,KY),VT850(KX,KY) ) - - READ(IUNIT) LON1,LAT1,LON2,LAT2,CLON3,CLAT3 - READ(IUNIT) PM3 - READ(IUNIT) T3 - READ(IUNIT) Q3 - READ(IUNIT) U3 - READ(IUNIT) V3 - READ(IUNIT) W3 - READ(IUNIT) Z3 - READ(IUNIT) HLON3,HLAT3,VLON3,VLAT3 - READ(IUNIT) P3 - READ(IUNIT) - READ(IUNIT) - READ(IUNIT) - CLOSE(IUNIT) - print*,'finish reading data' -! -!$omp parallel do -!$omp& private(i,j,k) - DO K=1,KZ - DO J=1,KY - DO I=1,KX - TV3(I,J,K)=T3(I,J,K)*(1.+D608*Q3(I,J,K)) - ZM3(I,J,K)=(Z3(I,J,K)+Z3(I,J,K+1))*0.5+ - & 0.5*TV3(I,J,K)/GAMMA*(2.-(P3(I,J,K)/PM3(I,J,K))**COEF3- - & (P3(I,J,K+1)/PM3(I,J,K))**COEF3) -! ZM3(I,J,K)=(Z3(I,J,K)+Z3(I,J,K+1))*0.5 -! PM3(I,J,K)=EXP((ALOG(1.*P3(I,J,K))+ALOG(1.*P3(I,J,K+1)))*0.5) - END DO - END DO - END DO - -!C COMPUTE SEA LEVEL PRESSURE. -!C -!$omp parallel do -!$omp& private(i,j,ZSF1,PSF1,A) - DO J=1,KY - DO I=1,KX - ZSF1 = ZM3(I,J,1) - PSF1 = PM3(I,J,1) - A = (GAMMA * ZSF1) / TV3(I,J,1) - SLP3(I,J) = PSF1*(1+A)**COEF2 - ENDDO - ENDDO - - PMV3=PM3 -!!$omp parallel do -!!$omp& private(i,j,k) -! DO J=2,KY-1 -! IF(MOD(J,2).NE.0.)THEN -! DO K=1,KZ -! DO I=1,KX-1 -! PMV3(I,J,K)=0.25*(PM3(I,J,K)+PM3(I+1,J,K)+ -! & PM3(I,J-1,K)+PM3(I,J+1,K)) -! END DO -! END DO -! ELSE -! DO K=1,KZ -! DO I=2,KX -! PMV3(I,J,K)=0.25*(PM3(I-1,J,K)+PM3(I,J,K)+ -! & PM3(I,J-1,K)+PM3(I,J+1,K)) -! END DO -! END DO -! END IF -! END DO - -! Height at P3 grids - -!$omp parallel do -!$omp& private(i,j,k,n) - DO J=1,KY - DO I=1,KX - CYC_510: DO K=1,KMX - IF(P2(K).GE.PM3(I,J,1))THEN - HP3(I,J,K)=ZM3(I,J,1)+ - & TV3(I,J,1)/GAMMA*(1.-(P2(K)/PM3(I,J,1))**COEF3) - ELSE IF(P2(K).LE.PM3(I,J,KZ))THEN - HP3(I,J,K)=ZM3(I,J,KZ)+ - & TV3(I,J,KZ)/GAMMA*(1.-(P2(K)/PM3(I,J,KZ))**COEF3) - ELSE - DO N=1,KZ-1 - IF(P2(K).LE.PM3(I,J,N).and.P2(K).GT.PM3(I,J,N+1))THEN - HP3(I,J,K)=ZM3(I,J,N)+ - & TV3(I,J,N)/GAMMA*(1.-(P2(K)/PM3(I,J,N))**COEF3) - CYCLE CYC_510 - END IF - END DO - END IF - END DO CYC_510 - END DO - END DO - - - do i=1,IRX - BLON(i)=SLON_N(kst)+i-1. - end do - do j=1,JRX - BLAT(j)=SLAT_N(kst)+j-1. - end do - - - DO J=1,KY - DO I=1,KX - UT850(I,J)=U3(I,J,KS850) - VT850(I,J)=V3(I,J,KS850) - END DO - END DO - - - print*,'compute weight' - - IGD=0 - JGD=0 - WGD=0 -! RDST=0.75 - !RDST=10.*(LON2-LON1)/FLOAT(KX-1) - RDST=5.*(LON2-LON1)/FLOAT(KX-1) - print*,'parent RDST=',RDST - !IF(RDST.LT.0.25)RDST=0.25 - IF(RDST.LT.0.10)RDST=0.10 - RDST1=RDST*RDST - -!$omp parallel do -!$omp& private(i,j,k,N,NGRID,COST2,DIST) - DO J=1,JRX - DO I=1,IRX - NGRID=0 - NSUM(I,J)=0. - WSUM(I,J)=0. - DO N=1,KY - DO K=1,KX - COST2=(COS((VLAT3(K,N)+BLAT(J))*0.5*pi180))**2 - DIST=COST2*(VLON3(K,N)-BLON(I))**2+ - & (VLAT3(K,N)-BLAT(J))**2 - IF(DIST.LE.RDST1)THEN - NGRID=NGRID+1 - IGD(I,J,NGRID)=K - JGD(I,J,NGRID)=N - WGD(I,J,NGRID)=EXP(-DIST/RDST1) - WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) - NSUM(I,J)=NGRID - END IF - END DO - END DO -! print*,'I,J=',I,J,NSUM(I,J),WSUM(I,J),BLON(I),BLAT(J) - END DO - END DO - - if(ngrid .ge. maxngrid) then - print*,'NGRID has passed MAXNGRID in create_rel_domain.f.' - print*,'NGRID = ',NGRID - print*,'MAXNGRID = ',MAXNGRID - stop - end if - -!$omp parallel do -!$omp& private(i,j,N,SDAT1,I1,J1) - DO J=1,JRX - DO I=1,IRX - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+UT850(I1,J1)*WGD(I,J,N) - END DO -! -! Chanh puts a check here for the case that the outer domain -! needs to be used, which caused NSUM = 0, and WSUM = 0 -! - IF (WSUM(I,J).gt.0) THEN - U850(I,J)=SDAT1/WSUM(I,J) - ELSE - U850(I,J)=0 - ENDIF - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+VT850(I1,J1)*WGD(I,J,N) - END DO -! -! Chanh puts a check here for the case that the outer domain -! needs to be used, which caused NSUM = 0, and WSUM = 0 -! - IF (WSUM(I,J).gt.0) THEN - V850(I,J)=SDAT1/WSUM(I,J) - ELSE - V850(I,J)=0 - ENDIF - ENDDO - ENDDO - -!$omp parallel do -!$omp& private(i,j,k,N,W1,W) - DO J=1,KY - DO I=1,KX - CYC_44: DO K=1,KMX - IF(P2(K).GE.PMV3(I,J,1))THEN ! Below PMV1(I,J,1) -! wrk1(I,J,K)=U3(I,J,1)*(1.-(P2(K)-PMV3(I,J,1))*1.4E-5) -! wrk2(I,J,K)=V3(I,J,1)*(1.-(P2(K)-PMV3(I,J,1))*1.4E-5) - wrk1(I,J,K)=U3(I,J,1) - wrk2(I,J,K)=V3(I,J,1) - ELSE IF(P2(K).LE.PMV3(I,J,KZ))THEN - wrk1(I,J,K)=U3(I,J,KZ) - wrk2(I,J,K)=V3(I,J,KZ) - ELSE - DO N=1,KZ-1 - IF(P2(K).LE.PMV3(I,J,N).and.P2(K).GT.PMV3(I,J,N+1))THEN - W1=ALOG(1.*PMV3(I,J,N+1))-ALOG(1.*PMV3(I,J,N)) - W=(ALOG(1.*P2(K))-ALOG(1.*PMV3(I,J,N)))/W1 - wrk1(I,J,K)=U3(I,J,N)+(U3(I,J,N+1)-U3(I,J,N))*W - wrk2(I,J,K)=V3(I,J,N)+(V3(I,J,N+1)-V3(I,J,N))*W - CYCLE CYC_44 - END IF - END DO - END IF - END DO CYC_44 - END DO - END DO - -!$omp parallel do -!$omp& private(i,j,k,N,K2,K3,K5,K6,SDAT1,I1,J1) - DO K=1,KMX - K2=4*(K-1)+3+KMX+2 - K3=4*(K-1)+4+KMX+2 - K5=4*(K-1)+1+KMX+2 ! div (here U,V, otherwise move to next loop) - K6=4*(K-1)+2+KMX+2 ! vor - DO J=1,JRX - DO I=1,IRX - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+wrk1(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K2)=SDAT1/WSUM(I,J) - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+wrk2(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K3)=SDAT1/WSUM(I,J) - SDAT(I,J,K5)=SDAT(I,J,K2) - SDAT(I,J,K6)=SDAT(I,J,K3) - ENDDO - ENDDO - -! WRITE(83)((SDAT(I,J,K2),I=1,41),J=1,41) - - ENDDO - -! DO K=1,KMX -! K3=4*(K-1)+4+KMX+2 -! WRITE(83)((SDAT(I,J,K3),I=1,41),J=1,41) -! END DO - -!*** FOR T PS points - - - IGD=0 - JGD=0 - WGD=0 - !RDST=0.75 - !RDST=10.*(LON2-LON1)/FLOAT(KX-1) - RDST=5.*(LON2-LON1)/FLOAT(KX-1) - print*,'parent RDST=',RDST - !IF(RDST.LT.0.25)RDST=0.25 - IF(RDST.LT.0.10)RDST=0.10 - RDST1=RDST*RDST - -!$omp parallel do -!$omp& private(i,j,k,N,NGRID,COST2,DIST) - DO J=1,JRX - DO I=1,IRX - NGRID=0 - WSUM(I,J)=0. - DO N=1,KY - DO K=1,KX - COST2=(COS((HLAT3(K,N)+BLAT(J))*0.5*pi180))**2 - DIST=COST2*(HLON3(K,N)-BLON(I))**2+ - & (HLAT3(K,N)-BLAT(J))**2 - IF(DIST.LE.RDST1)THEN - NGRID=NGRID+1 - IGD(I,J,NGRID)=K - JGD(I,J,NGRID)=N - WGD(I,J,NGRID)=EXP(-DIST/RDST1) - WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) - NSUM(I,J)=NGRID - END IF - END DO - END DO - END DO - END DO - -!$omp parallel do -!$omp& private(i,j,N,SDAT1,I1,J1) - DO J=1,JRX - DO I=1,IRX - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+Z3(I1,J1,1)*WGD(I,J,N) - END DO - SDAT(I,J,1)=SDAT1/WSUM(I,J) - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+SLP3(I1,J1)*WGD(I,J,N) - END DO - SDAT(I,J,2)=SDAT1/WSUM(I,J) - END DO - END DO - -! WRITE(83)((SDAT(I,J,1),I=1,41),J=1,41) -! WRITE(83)((SDAT(I,J,2),I=1,41),J=1,41) - - - K=1 -!$omp parallel do -!$omp& private(i,j,DTEMP,ES,QS3) - DO J=1,KY - DO I=1,KX - DTEMP=T3(I,J,K)-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - QS3=0.622*ES/(PM3(I,J,K)-0.378*ES) - RH3(I,J)=MIN(MAX(Q3(I,J,K)/QS3,0.),1.0) - END DO - END DO - -! Iterpolation to constant P - -!$omp parallel do -!$omp& private(i,j,k,N,DTEMP,ES,QSK,W1,W) - DO J=1,KY - DO I=1,KX - DO K=1,KMX - IF(P2(K).GE.PM3(I,J,1))THEN ! Below PM1(I,J,1) - wrk1(I,J,K)=T3(I,J,1)-GAMMA*(HP3(I,J,K)-ZM3(I,J,1)) - DTEMP=wrk1(I,J,K)-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - QSK=0.622*ES/(P2(K)-0.378*ES) - wrk2(I,J,K)=RH3(I,J)*QSK ! constant RH below KZ=1 - ELSE IF(P2(K).LE.PM3(I,J,KZ))THEN - wrk1(I,J,K)=T3(I,J,KZ)-GAMMA*(HP3(I,J,K)-ZM3(I,J,KZ)) - wrk2(I,J,K)=Q3(I,J,KZ) ! very small - ELSE - DO N=1,KZ-1 - IF(P2(K).LE.PM3(I,J,N).and.P2(K).GT.PM3(I,J,N+1))THEN - W1=ALOG(1.*PM3(I,J,N+1))-ALOG(1.*PM3(I,J,N)) - W=(ALOG(1.*P2(K))-ALOG(1.*PM3(I,J,N)))/W1 - wrk1(I,J,K)=T3(I,J,N)+(T3(I,J,N+1)-T3(I,J,N))*W - wrk2(I,J,K)=Q3(I,J,N)+(Q3(I,J,N+1)-Q3(I,J,N))*W - GO TO 42 - END IF - END DO - 42 CONTINUE - END IF - END DO - END DO - END DO - -!$omp parallel do -!$omp& private(i,j,K,K1,K4,N,SDAT1,I1,J1) - DO K=1,KMX - K1=K+2 -! K2=4*(K-1)+3+KMX+2 -! K3=4*(K-1)+4+KMX+2 - K4=K+5*KMX+2 -! K5=4*(K-1)+1+KMX+2 ! div -! K6=4*(K-1)+2+KMX+2 ! vor - DO J=1,JRX - DO I=1,IRX - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+wrk1(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K1)=SDAT1/WSUM(I,J) - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+wrk2(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K4)=SDAT1/WSUM(I,J) - ENDDO - ENDDO - -! WRITE(83)((SDAT(I,J,K1),I=1,41),J=1,41) - - ENDDO - -! DO K=1,KMX -! K4=K+5*KMX+2 -! WRITE(83)((SDAT(I,J,K4),I=1,41),J=1,41) -! END DO - - DEALLOCATE (HLON3,HLAT3,VLON3,VLAT3) - DEALLOCATE (T3,Q3,U3,V3,Z3,P3,SLP3) - DEALLOCATE (ZM3,PM3,PMV3,TV3,HP3,RH3) - DEALLOCATE (wrk1,wrk2,UT850,VT850) - - -! finish computing SDATA - - end diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/create_rel_domain.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/create_rel_domain.f90 new file mode 100644 index 000000000..e04762552 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/create_rel_domain.f90 @@ -0,0 +1,509 @@ +!?????????????????????????????????????????????????????????? + SUBROUTINE CREAT_41X41(ITIM,KST,KMX,MTV6,KS850,U850,V850,SDAT,P2) +! SUBPROGRAM +! PRGRMMR +! +! ABSTRACT +! +! DECLARE VARIABLES +! + use nhc + use nhc1 + use tcvit + use rsfc + use stname + implicit none + INTEGER I,J,K,NX,NY,NZ +! + integer,parameter:: IRX=41,JRX=41,MAXNGRID=10000 + real, parameter:: GAMMA=6.5E-3,G=9.8,GI=1./G,D608=0.608 +! +! variable for outer nest + + REAL(4), ALLOCATABLE :: T3(:,:,:),Q3(:,:,:) + REAL(4), ALLOCATABLE :: U3(:,:,:),V3(:,:,:),W3(:,:,:) + REAL(4), ALLOCATABLE :: Z3(:,:,:),P3(:,:,:) + REAL(4), ALLOCATABLE :: SLP3(:,:),HP3(:,:,:),RH3(:,:) + + REAL(4), ALLOCATABLE :: ZM3(:,:,:),PM3(:,:,:) + REAL(4), ALLOCATABLE :: PMV3(:,:,:),TV3(:,:,:) + + REAL(4), ALLOCATABLE :: HLON3(:,:),HLAT3(:,:) + REAL(4), ALLOCATABLE :: VLON3(:,:),VLAT3(:,:) + +! REAL(4) DLMD3,DPHD3,CLON3,CLAT3,PT3,PDTOP3 + REAL(4) LON1,LAT1,LON2,LAT2,CLON3,CLAT3 + + real(4),allocatable :: UT850(:,:),VT850(:,:) + real(4),allocatable :: wrk1(:,:,:),wrk2(:,:,:) + + integer(4) IGD(IRX,JRX,MAXNGRID),JGD(IRX,JRX,MAXNGRID) + integer(4) NSUM(IRX,JRX),NGRID,KST + real WGD(IRX,JRX,MAXNGRID),WSUM(IRX,JRX) + + REAL(4) BLON(IRX), BLAT(JRX) + + REAL(4) U850(IRX,JRX),V850(IRX,JRX) + + REAL(4) P2(KMX),SDAT(IRX,JRX,MTV6) + +! Variables on P surface + + integer,intent(in):: itim + integer:: iunit,kx,ky,kz,kz1,MAX_KZ_KMX,kmx,mtv6 + integer:: n,i1,j1,k1,k2,k3,k4,k5,k6,ks850 + real:: coef3,coef2 + real:: w,w1,dist,es,qs3,qsk,dtemp,cost2 + real::PI180,pi,PI_DEG + real:: rdst,rdst1,sdat1 + real psf1,zsf1,a + !real(4),allocatable :: psf1(:,:),zsf1(:,:),a(:,:) + +! + COEF3=287.05*GI*GAMMA + COEF2=1./COEF3 + + pi=4.*atan(1.) + pi_deg=180./pi + pi180=pi/180. +! read data + +! READ(5,*)ITIM,IBGS + +! newly added +! compute SDATA from outter nest domain + + IUNIT=46 + + READ(IUNIT)KX,KY,KZ + KZ1=KZ+1 + print*,'KX,KY,KZ=',KX,KY,KZ + + max_kz_kmx=kz + if(kmx .gt. kz) then + max_kz_kmx=kmx + end if + + ALLOCATE ( HLON3(KX,KY),HLAT3(KX,KY) ) + ALLOCATE ( VLON3(KX,KY),VLAT3(KX,KY) ) + + ALLOCATE ( T3(KX,KY,KZ),Q3(KX,KY,KZ) ) + ALLOCATE ( U3(KX,KY,KZ),V3(KX,KY,KZ),W3(KX,KY,KZ) ) + ALLOCATE ( Z3(KX,KY,KZ1),P3(KX,KY,KZ1) ) + + ALLOCATE ( SLP3(KX,KY),ZM3(KX,KY,KZ) ) + ALLOCATE ( HP3(KX,KY,max_kz_kmx),RH3(KX,KY) ) + ALLOCATE ( PM3(KX,KY,KZ),PMV3(KX,KY,KZ) ) + ALLOCATE ( TV3(KX,KY,KZ) ) + + ALLOCATE ( wrk1(KX,KY,KMX), wrk2(KX,KY,KMX) ) + ALLOCATE ( UT850(KX,KY),VT850(KX,KY) ) + + READ(IUNIT) LON1,LAT1,LON2,LAT2,CLON3,CLAT3 + READ(IUNIT) PM3 + READ(IUNIT) T3 + READ(IUNIT) Q3 + READ(IUNIT) U3 + READ(IUNIT) V3 + READ(IUNIT) W3 + READ(IUNIT) Z3 + READ(IUNIT) HLON3,HLAT3,VLON3,VLAT3 + READ(IUNIT) P3 + READ(IUNIT) + READ(IUNIT) + READ(IUNIT) + CLOSE(IUNIT) + print*,'finish reading data' +! +!$omp parallel do & +!$omp& private(i,j,k) + DO K=1,KZ + DO J=1,KY + DO I=1,KX + TV3(I,J,K)=T3(I,J,K)*(1.+D608*Q3(I,J,K)) + ZM3(I,J,K)=(Z3(I,J,K)+Z3(I,J,K+1))*0.5+ & + 0.5*TV3(I,J,K)/GAMMA*(2.-(P3(I,J,K)/PM3(I,J,K))**COEF3- & + (P3(I,J,K+1)/PM3(I,J,K))**COEF3) +! ZM3(I,J,K)=(Z3(I,J,K)+Z3(I,J,K+1))*0.5 +! PM3(I,J,K)=EXP((ALOG(1.*P3(I,J,K))+ALOG(1.*P3(I,J,K+1)))*0.5) + END DO + END DO + END DO + +!C COMPUTE SEA LEVEL PRESSURE. +!C +!$omp parallel do & +!$omp& private(i,j,ZSF1,PSF1,A) + DO J=1,KY + DO I=1,KX + ZSF1 = ZM3(I,J,1) + PSF1 = PM3(I,J,1) + A = (GAMMA * ZSF1) / TV3(I,J,1) + SLP3(I,J) = PSF1*(1+A)**COEF2 + ENDDO + ENDDO + + PMV3=PM3 +!!$omp parallel do +!!$omp& private(i,j,k) +! DO J=2,KY-1 +! IF(MOD(J,2).NE.0.)THEN +! DO K=1,KZ +! DO I=1,KX-1 +! PMV3(I,J,K)=0.25*(PM3(I,J,K)+PM3(I+1,J,K)+ +! & PM3(I,J-1,K)+PM3(I,J+1,K)) +! END DO +! END DO +! ELSE +! DO K=1,KZ +! DO I=2,KX +! PMV3(I,J,K)=0.25*(PM3(I-1,J,K)+PM3(I,J,K)+ +! & PM3(I,J-1,K)+PM3(I,J+1,K)) +! END DO +! END DO +! END IF +! END DO + +! Height at P3 grids + +!$omp parallel do & +!$omp& private(i,j,k,n) + DO J=1,KY + DO I=1,KX + CYC_510: DO K=1,KMX + IF(P2(K).GE.PM3(I,J,1))THEN + HP3(I,J,K)=ZM3(I,J,1)+ & + TV3(I,J,1)/GAMMA*(1.-(P2(K)/PM3(I,J,1))**COEF3) + ELSE IF(P2(K).LE.PM3(I,J,KZ))THEN + HP3(I,J,K)=ZM3(I,J,KZ)+ & + TV3(I,J,KZ)/GAMMA*(1.-(P2(K)/PM3(I,J,KZ))**COEF3) + ELSE + DO N=1,KZ-1 + IF(P2(K).LE.PM3(I,J,N).and.P2(K).GT.PM3(I,J,N+1))THEN + HP3(I,J,K)=ZM3(I,J,N)+ & + TV3(I,J,N)/GAMMA*(1.-(P2(K)/PM3(I,J,N))**COEF3) + CYCLE CYC_510 + END IF + END DO + END IF + END DO CYC_510 + END DO + END DO + + + do i=1,IRX + BLON(i)=SLON_N(kst)+i-1. + end do + do j=1,JRX + BLAT(j)=SLAT_N(kst)+j-1. + end do + + + DO J=1,KY + DO I=1,KX + UT850(I,J)=U3(I,J,KS850) + VT850(I,J)=V3(I,J,KS850) + END DO + END DO + + + print*,'compute weight' + + IGD=0 + JGD=0 + WGD=0 +! RDST=0.75 + !RDST=10.*(LON2-LON1)/FLOAT(KX-1) + RDST=5.*(LON2-LON1)/FLOAT(KX-1) + print*,'parent RDST=',RDST + !IF(RDST.LT.0.25)RDST=0.25 + IF(RDST.LT.0.10)RDST=0.10 + RDST1=RDST*RDST + +!$omp parallel do & +!$omp& private(i,j,k,N,NGRID,COST2,DIST) + DO J=1,JRX + DO I=1,IRX + NGRID=0 + NSUM(I,J)=0. + WSUM(I,J)=0. + DO N=1,KY + DO K=1,KX + COST2=(COS((VLAT3(K,N)+BLAT(J))*0.5*pi180))**2 + DIST=COST2*(VLON3(K,N)-BLON(I))**2+ & + (VLAT3(K,N)-BLAT(J))**2 + IF(DIST.LE.RDST1)THEN + NGRID=NGRID+1 + IGD(I,J,NGRID)=K + JGD(I,J,NGRID)=N + WGD(I,J,NGRID)=EXP(-DIST/RDST1) + WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) + NSUM(I,J)=NGRID + END IF + END DO + END DO +! print*,'I,J=',I,J,NSUM(I,J),WSUM(I,J),BLON(I),BLAT(J) + END DO + END DO + + if(ngrid .ge. maxngrid) then + print*,'NGRID has passed MAXNGRID in create_rel_domain.f.' + print*,'NGRID = ',NGRID + print*,'MAXNGRID = ',MAXNGRID + stop + end if + +!$omp parallel do & +!$omp& private(i,j,N,SDAT1,I1,J1) + DO J=1,JRX + DO I=1,IRX + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+UT850(I1,J1)*WGD(I,J,N) + END DO +! +! Chanh puts a check here for the case that the outer domain +! needs to be used, which caused NSUM = 0, and WSUM = 0 +! + IF (WSUM(I,J).gt.0) THEN + U850(I,J)=SDAT1/WSUM(I,J) + ELSE + U850(I,J)=0 + ENDIF + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+VT850(I1,J1)*WGD(I,J,N) + END DO +! +! Chanh puts a check here for the case that the outer domain +! needs to be used, which caused NSUM = 0, and WSUM = 0 +! + IF (WSUM(I,J).gt.0) THEN + V850(I,J)=SDAT1/WSUM(I,J) + ELSE + V850(I,J)=0 + ENDIF + ENDDO + ENDDO + +!$omp parallel do & +!$omp& private(i,j,k,N,W1,W) + DO J=1,KY + DO I=1,KX + CYC_44: DO K=1,KMX + IF(P2(K).GE.PMV3(I,J,1))THEN ! Below PMV1(I,J,1) +! wrk1(I,J,K)=U3(I,J,1)*(1.-(P2(K)-PMV3(I,J,1))*1.4E-5) +! wrk2(I,J,K)=V3(I,J,1)*(1.-(P2(K)-PMV3(I,J,1))*1.4E-5) + wrk1(I,J,K)=U3(I,J,1) + wrk2(I,J,K)=V3(I,J,1) + ELSE IF(P2(K).LE.PMV3(I,J,KZ))THEN + wrk1(I,J,K)=U3(I,J,KZ) + wrk2(I,J,K)=V3(I,J,KZ) + ELSE + DO N=1,KZ-1 + IF(P2(K).LE.PMV3(I,J,N).and.P2(K).GT.PMV3(I,J,N+1))THEN + W1=ALOG(1.*PMV3(I,J,N+1))-ALOG(1.*PMV3(I,J,N)) + W=(ALOG(1.*P2(K))-ALOG(1.*PMV3(I,J,N)))/W1 + wrk1(I,J,K)=U3(I,J,N)+(U3(I,J,N+1)-U3(I,J,N))*W + wrk2(I,J,K)=V3(I,J,N)+(V3(I,J,N+1)-V3(I,J,N))*W + CYCLE CYC_44 + END IF + END DO + END IF + END DO CYC_44 + END DO + END DO + +!$omp parallel do & +!$omp& private(i,j,k,N,K2,K3,K5,K6,SDAT1,I1,J1) + DO K=1,KMX + K2=4*(K-1)+3+KMX+2 + K3=4*(K-1)+4+KMX+2 + K5=4*(K-1)+1+KMX+2 ! div (here U,V, otherwise move to next loop) + K6=4*(K-1)+2+KMX+2 ! vor + DO J=1,JRX + DO I=1,IRX + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+wrk1(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K2)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+wrk2(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K3)=SDAT1/WSUM(I,J) + SDAT(I,J,K5)=SDAT(I,J,K2) + SDAT(I,J,K6)=SDAT(I,J,K3) + ENDDO + ENDDO + +! WRITE(83)((SDAT(I,J,K2),I=1,41),J=1,41) + + ENDDO + +! DO K=1,KMX +! K3=4*(K-1)+4+KMX+2 +! WRITE(83)((SDAT(I,J,K3),I=1,41),J=1,41) +! END DO + +!*** FOR T PS points + + + IGD=0 + JGD=0 + WGD=0 + !RDST=0.75 + !RDST=10.*(LON2-LON1)/FLOAT(KX-1) + RDST=5.*(LON2-LON1)/FLOAT(KX-1) + print*,'parent RDST=',RDST + !IF(RDST.LT.0.25)RDST=0.25 + IF(RDST.LT.0.10)RDST=0.10 + RDST1=RDST*RDST + +!$omp parallel do & +!$omp& private(i,j,k,N,NGRID,COST2,DIST) + DO J=1,JRX + DO I=1,IRX + NGRID=0 + WSUM(I,J)=0. + DO N=1,KY + DO K=1,KX + COST2=(COS((HLAT3(K,N)+BLAT(J))*0.5*pi180))**2 + DIST=COST2*(HLON3(K,N)-BLON(I))**2+ & + (HLAT3(K,N)-BLAT(J))**2 + IF(DIST.LE.RDST1)THEN + NGRID=NGRID+1 + IGD(I,J,NGRID)=K + JGD(I,J,NGRID)=N + WGD(I,J,NGRID)=EXP(-DIST/RDST1) + WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) + NSUM(I,J)=NGRID + END IF + END DO + END DO + END DO + END DO + +!$omp parallel do & +!$omp& private(i,j,N,SDAT1,I1,J1) + DO J=1,JRX + DO I=1,IRX + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+Z3(I1,J1,1)*WGD(I,J,N) + END DO + SDAT(I,J,1)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+SLP3(I1,J1)*WGD(I,J,N) + END DO + SDAT(I,J,2)=SDAT1/WSUM(I,J) + END DO + END DO + +! WRITE(83)((SDAT(I,J,1),I=1,41),J=1,41) +! WRITE(83)((SDAT(I,J,2),I=1,41),J=1,41) + + + K=1 +!$omp parallel do & +!$omp& private(i,j,DTEMP,ES,QS3) + DO J=1,KY + DO I=1,KX + DTEMP=T3(I,J,K)-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + QS3=0.622*ES/(PM3(I,J,K)-0.378*ES) + RH3(I,J)=MIN(MAX(Q3(I,J,K)/QS3,0.),1.0) + END DO + END DO + +! Iterpolation to constant P + +!$omp parallel do & +!$omp& private(i,j,k,N,DTEMP,ES,QSK,W1,W) + DO J=1,KY + DO I=1,KX + DO K=1,KMX + IF(P2(K).GE.PM3(I,J,1))THEN ! Below PM1(I,J,1) + wrk1(I,J,K)=T3(I,J,1)-GAMMA*(HP3(I,J,K)-ZM3(I,J,1)) + DTEMP=wrk1(I,J,K)-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + QSK=0.622*ES/(P2(K)-0.378*ES) + wrk2(I,J,K)=RH3(I,J)*QSK ! constant RH below KZ=1 + ELSE IF(P2(K).LE.PM3(I,J,KZ))THEN + wrk1(I,J,K)=T3(I,J,KZ)-GAMMA*(HP3(I,J,K)-ZM3(I,J,KZ)) + wrk2(I,J,K)=Q3(I,J,KZ) ! very small + ELSE + DO N=1,KZ-1 + IF(P2(K).LE.PM3(I,J,N).and.P2(K).GT.PM3(I,J,N+1))THEN + W1=ALOG(1.*PM3(I,J,N+1))-ALOG(1.*PM3(I,J,N)) + W=(ALOG(1.*P2(K))-ALOG(1.*PM3(I,J,N)))/W1 + wrk1(I,J,K)=T3(I,J,N)+(T3(I,J,N+1)-T3(I,J,N))*W + wrk2(I,J,K)=Q3(I,J,N)+(Q3(I,J,N+1)-Q3(I,J,N))*W + exit + END IF + END DO + END IF + END DO + END DO + END DO + +!$omp parallel do & +!$omp& private(i,j,K,K1,K4,N,SDAT1,I1,J1) + DO K=1,KMX + K1=K+2 +! K2=4*(K-1)+3+KMX+2 +! K3=4*(K-1)+4+KMX+2 + K4=K+5*KMX+2 +! K5=4*(K-1)+1+KMX+2 ! div +! K6=4*(K-1)+2+KMX+2 ! vor + DO J=1,JRX + DO I=1,IRX + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+wrk1(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K1)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+wrk2(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K4)=SDAT1/WSUM(I,J) + ENDDO + ENDDO + +! WRITE(83)((SDAT(I,J,K1),I=1,41),J=1,41) + + ENDDO + +! DO K=1,KMX +! K4=K+5*KMX+2 +! WRITE(83)((SDAT(I,J,K4),I=1,41),J=1,41) +! END DO + + DEALLOCATE (HLON3,HLAT3,VLON3,VLAT3) + DEALLOCATE (T3,Q3,U3,V3,Z3,P3,SLP3) + DEALLOCATE (ZM3,PM3,PMV3,TV3,HP3,RH3) + DEALLOCATE (wrk1,wrk2,UT850,VT850) + + +! finish computing SDATA + return + end subroutine CREAT_41X41 diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/fft99.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/fft99.f deleted file mode 100644 index 3fcdedc7e..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/fft99.f +++ /dev/null @@ -1,1126 +0,0 @@ -C - SUBROUTINE FFT99(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) -C -C PURPOSE PERFORMS MULTIPLE FAST FOURIER TRANSFORMS. THIS PACKAGE -C WILL PERFORM A NUMBER OF SIMULTANEOUS REAL/HALF-COMPLEX -C PERIODIC FOURIER TRANSFORMS OR CORRESPONDING INVERSE -C TRANSFORMS, I.E. GIVEN A SET OF REAL DATA VECTORS, THE -C PACKAGE RETURNS A SET OF 'HALF-COMPLEX' FOURIER -C COEFFICIENT VECTORS, OR VICE VERSA. THE LENGTH OF THE -C TRANSFORMS MUST BE AN EVEN NUMBER GREATER THAN 4 THAT HAS -C NO OTHER FACTORS EXCEPT POSSIBLY POWERS OF 2, 3, AND 5. -C THIS IS AN ALL FORTRAN VERSION OF THE CRAYLIB PACKAGE -C THAT IS MOSTLY WRITTEN IN CAL. -C -C THE PACKAGE FFT99F CONTAINS SEVERAL USER-LEVEL ROUTINES: -C -C SUBROUTINE FFTFAX -C AN INITIALIZATION ROUTINE THAT MUST BE CALLED ONCE -C BEFORE A SEQUENCE OF CALLS TO THE FFT ROUTINES -C (PROVIDED THAT N IS NOT CHANGED). -C -C SUBROUTINES FFT99 AND FFT991 -C TWO FFT ROUTINES THAT RETURN SLIGHTLY DIFFERENT -C ARRANGEMENTS OF THE DATA IN GRIDPOINT SPACE. -C -C -C ACCESS THIS FORTRAN VERSION MAY BE ACCESSED WITH -C -C *FORTRAN,P=XLIB,SN=FFT99F -C -C TO ACCESS THE CRAY OBJECT CODE, CALLING THE USER ENTRY -C POINTS FROM A CRAY PROGRAM IS SUFFICIENT. THE SOURCE -C FORTRAN AND CAL CODE FOR THE CRAYLIB VERSION MAY BE -C ACCESSED USING -C -C FETCH P=CRAYLIB,SN=FFT99 -C FETCH P=CRAYLIB,SN=CAL99 -C -C USAGE LET N BE OF THE FORM 2**P * 3**Q * 5**R, WHERE P .GE. 1, -C Q .GE. 0, AND R .GE. 0. THEN A TYPICAL SEQUENCE OF -C CALLS TO TRANSFORM A GIVEN SET OF REAL VECTORS OF LENGTH -C N TO A SET OF 'HALF-COMPLEX' FOURIER COEFFICIENT VECTORS -C OF LENGTH N IS -C -C DIMENSION IFAX(13),TRIGS(3*N/2+1),A(M*(N+2)), -C + WORK(M*(N+1)) -C -C CALL FFTFAX (N, IFAX, TRIGS) -C CALL FFT99 (A,WORK,TRIGS,IFAX,INC,JUMP,N,M,ISIGN) -C -C SEE THE INDIVIDUAL WRITE-UPS FOR FFTFAX, FFT99, AND -C FFT991 BELOW, FOR A DETAILED DESCRIPTION OF THE -C ARGUMENTS. -C -C HISTORY THE PACKAGE WAS WRITTEN BY CLIVE TEMPERTON AT ECMWF IN -C NOVEMBER, 1978. IT WAS MODIFIED, DOCUMENTED, AND TESTED -C FOR NCAR BY RUSS REW IN SEPTEMBER, 1980. -C -C----------------------------------------------------------------------- -C -C SUBROUTINE FFTFAX (N,IFAX,TRIGS) -C -C PURPOSE A SET-UP ROUTINE FOR FFT99 AND FFT991. IT NEED ONLY BE -C CALLED ONCE BEFORE A SEQUENCE OF CALLS TO THE FFT -C ROUTINES (PROVIDED THAT N IS NOT CHANGED). -C -C ARGUMENT IFAX(13),TRIGS(3*N/2+1) -C DIMENSIONS -C -C ARGUMENTS -C -C ON INPUT N -C AN EVEN NUMBER GREATER THAN 4 THAT HAS NO PRIME FACTOR -C GREATER THAN 5. N IS THE LENGTH OF THE TRANSFORMS (SEE -C THE DOCUMENTATION FOR FFT99 AND FFT991 FOR THE -C DEFINITIONS OF THE TRANSFORMS). -C -C IFAX -C AN INTEGER ARRAY. THE NUMBER OF ELEMENTS ACTUALLY USED -C WILL DEPEND ON THE FACTORIZATION OF N. DIMENSIONING -C IFAX FOR 13 SUFFICES FOR ALL N LESS THAN A MILLION. -C -C TRIGS -C A FLOATING POINT ARRAY OF DIMENSION 3*N/2 IF N/2 IS -C EVEN, OR 3*N/2+1 IF N/2 IS ODD. -C -C ON OUTPUT IFAX -C CONTAINS THE FACTORIZATION OF N/2. IFAX(1) IS THE -C NUMBER OF FACTORS, AND THE FACTORS THEMSELVES ARE STORED -C IN IFAX(2),IFAX(3),... IF FFTFAX IS CALLED WITH N ODD, -C OR IF N HAS ANY PRIME FACTORS GREATER THAN 5, IFAX(1) -C IS SET TO -99. -C -C TRIGS -C AN ARRAY OF TRIGNOMENTRIC FUNCTION VALUES SUBSEQUENTLY -C USED BY THE FFT ROUTINES. -C -C----------------------------------------------------------------------- -C -C SUBROUTINE FFT991 (A,WORK,TRIGS,IFAX,INC,JUMP,N,M,ISIGN) -C AND -C SUBROUTINE FFT99 (A,WORK,TRIGS,IFAX,INC,JUMP,N,M,ISIGN) -C -C PURPOSE PERFORM A NUMBER OF SIMULTANEOUS REAL/HALF-COMPLEX -C PERIODIC FOURIER TRANSFORMS OR CORRESPONDING INVERSE -C TRANSFORMS, USING ORDINARY SPATIAL ORDER OF GRIDPOINT -C VALUES (FFT991) OR EXPLICIT CYCLIC CONTINUITY IN THE -C GRIDPOINT VALUES (FFT99). GIVEN A SET -C OF REAL DATA VECTORS, THE PACKAGE RETURNS A SET OF -C 'HALF-COMPLEX' FOURIER COEFFICIENT VECTORS, OR VICE -C VERSA. THE LENGTH OF THE TRANSFORMS MUST BE AN EVEN -C NUMBER THAT HAS NO OTHER FACTORS EXCEPT POSSIBLY POWERS -C OF 2, 3, AND 5. THESE VERSION OF FFT991 AND FFT99 ARE -C OPTIMIZED FOR USE ON THE CRAY-1. -C -C ARGUMENT A(M*(N+2)), WORK(M*(N+1)), TRIGS(3*N/2+1), IFAX(13) -C DIMENSIONS -C -C ARGUMENTS -C -C ON INPUT A -C AN ARRAY OF LENGTH M*(N+2) CONTAINING THE INPUT DATA -C OR COEFFICIENT VECTORS. THIS ARRAY IS OVERWRITTEN BY -C THE RESULTS. -C -C WORK -C A WORK ARRAY OF DIMENSION M*(N+1) -C -C TRIGS -C AN ARRAY SET UP BY FFTFAX, WHICH MUST BE CALLED FIRST. -C -C IFAX -C AN ARRAY SET UP BY FFTFAX, WHICH MUST BE CALLED FIRST. -C -C INC -C THE INCREMENT (IN WORDS) BETWEEN SUCCESSIVE ELEMENTS OF -C EACH DATA OR COEFFICIENT VECTOR (E.G. INC=1 FOR -C CONSECUTIVELY STORED DATA). -C -C JUMP -C THE INCREMENT (IN WORDS) BETWEEN THE FIRST ELEMENTS OF -C SUCCESSIVE DATA OR COEFFICIENT VECTORS. ON THE CRAY-1, -C TRY TO ARRANGE DATA SO THAT JUMP IS NOT A MULTIPLE OF 8 -C (TO AVOID MEMORY BANK CONFLICTS). FOR CLARIFICATION OF -C INC AND JUMP, SEE THE EXAMPLES BELOW. -C -C N -C THE LENGTH OF EACH TRANSFORM (SEE DEFINITION OF -C TRANSFORMS, BELOW). -C -C M -C THE NUMBER OF TRANSFORMS TO BE DONE SIMULTANEOUSLY. -C -C ISIGN -C = +1 FOR A TRANSFORM FROM FOURIER COEFFICIENTS TO -C GRIDPOINT VALUES. -C = -1 FOR A TRANSFORM FROM GRIDPOINT VALUES TO FOURIER -C COEFFICIENTS. -C -C ON OUTPUT A -C IF ISIGN = +1, AND M COEFFICIENT VECTORS ARE SUPPLIED -C EACH CONTAINING THE SEQUENCE: -C -C A(0),B(0),A(1),B(1),...,A(N/2),B(N/2) (N+2 VALUES) -C -C THEN THE RESULT CONSISTS OF M DATA VECTORS EACH -C CONTAINING THE CORRESPONDING N+2 GRIDPOINT VALUES: -C -C FOR FFT991, X(0), X(1), X(2),...,X(N-1),0,0. -C FOR FFT99, X(N-1),X(0),X(1),X(2),...,X(N-1),X(0). -C (EXPLICIT CYCLIC CONTINUITY) -C -C WHEN ISIGN = +1, THE TRANSFORM IS DEFINED BY: -C X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) -C WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) -C AND I=SQRT (-1) -C -C IF ISIGN = -1, AND M DATA VECTORS ARE SUPPLIED EACH -C CONTAINING A SEQUENCE OF GRIDPOINT VALUES X(J) AS -C DEFINED ABOVE, THEN THE RESULT CONSISTS OF M VECTORS -C EACH CONTAINING THE CORRESPONDING FOURIER COFFICIENTS -C A(K), B(K), 0 .LE. K .LE N/2. -C -C WHEN ISIGN = -1, THE INVERSE TRANSFORM IS DEFINED BY: -C C(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*EXP(-2*I*J*K*PI/N)) -C WHERE C(K)=A(K)+I*B(K) AND I=SQRT(-1) -C -C A CALL WITH ISIGN=+1 FOLLOWED BY A CALL WITH ISIGN=-1 -C (OR VICE VERSA) RETURNS THE ORIGINAL DATA. -C -C NOTE: THE FACT THAT THE GRIDPOINT VALUES X(J) ARE REAL -C IMPLIES THAT B(0)=B(N/2)=0. FOR A CALL WITH ISIGN=+1, -C IT IS NOT ACTUALLY NECESSARY TO SUPPLY THESE ZEROS. -C -C EXAMPLES GIVEN 19 DATA VECTORS EACH OF LENGTH 64 (+2 FOR EXPLICIT -C CYCLIC CONTINUITY), COMPUTE THE CORRESPONDING VECTORS OF -C FOURIER COEFFICIENTS. THE DATA MAY, FOR EXAMPLE, BE -C ARRANGED LIKE THIS: -C -C FIRST DATA A(1)= . . . A(66)= A(70) -C VECTOR X(63) X(0) X(1) X(2) ... X(63) X(0) (4 EMPTY LOCATIONS) -C -C SECOND DATA A(71)= . . . A(140) -C VECTOR X(63) X(0) X(1) X(2) ... X(63) X(0) (4 EMPTY LOCATIONS) -C -C AND SO ON. HERE INC=1, JUMP=70, N=64, M=19, ISIGN=-1, -C AND FFT99 SHOULD BE USED (BECAUSE OF THE EXPLICIT CYCLIC -C CONTINUITY). -C -C ALTERNATIVELY THE DATA MAY BE ARRANGED LIKE THIS: -C -C FIRST SECOND LAST -C DATA DATA DATA -C VECTOR VECTOR VECTOR -C -C A(1)= A(2)= A(19)= -C -C X(63) X(63) . . . X(63) -C A(20)= X(0) X(0) . . . X(0) -C A(39)= X(1) X(1) . . . X(1) -C . . . -C . . . -C . . . -C -C IN WHICH CASE WE HAVE INC=19, JUMP=1, AND THE REMAINING -C PARAMETERS ARE THE SAME AS BEFORE. IN EITHER CASE, EACH -C COEFFICIENT VECTOR OVERWRITES THE CORRESPONDING INPUT -C DATA VECTOR. -C -C----------------------------------------------------------------------- - DIMENSION A(N),WORK(N),TRIGS(N),IFAX(1) -C -C SUBROUTINE "FFT99" - MULTIPLE FAST REAL PERIODIC TRANSFORM -C CORRESPONDING TO OLD SCALAR ROUTINE FFT9 -C PROCEDURE USED TO CONVERT TO HALF-LENGTH COMPLEX TRANSFORM -C IS GIVEN BY COOLEY, LEWIS AND WELCH (J. SOUND VIB., VOL. 12 -C (1970), 315-337) -C -C A IS THE ARRAY CONTAINING INPUT AND OUTPUT DATA -C WORK IS AN AREA OF SIZE (N+1)*LOT -C TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES -C IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N/2 -C INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' -C (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) -C JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR -C N IS THE LENGTH OF THE DATA VECTORS -C LOT IS THE NUMBER OF DATA VECTORS -C ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT -C = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL -C -C ORDERING OF COEFFICIENTS: -C A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) -C WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED -C -C ORDERING OF DATA: -C X(N-1),X(0),X(1),X(2),...,X(N),X(0) -C I.E. EXPLICIT CYCLIC CONTINUITY; (N+2) LOCATIONS REQUIRED -C -C VECTORIZATION IS ACHIEVED ON CRAY BY DOING THE TRANSFORMS IN -C PARALLEL -C -C *** N.B. N IS ASSUMED TO BE AN EVEN NUMBER -C -C DEFINITION OF TRANSFORMS: -C ------------------------- -C -C ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) -C WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) -C -C ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) -C B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) -C -C -C THE FOLLOWING CALL IS FOR MONITORING LIBRARY USE AT NCAR -C CALL Q8QST4 ( 4HXLIB, 6HFFT99F, 5HFFT99, 10HVERSION 01) - NFAX=IFAX(1) - NX=N+1 - NH=N/2 - INK=INC+INC - IF (ISIGN.EQ.+1) GO TO 30 -C -C IF NECESSARY, TRANSFER DATA TO WORK AREA - IGO=50 - IF (MOD(NFAX,2).EQ.1) GOTO 40 - IBASE=INC+1 - JBASE=1 - DO 20 L=1,LOT - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 10 M=1,N - WORK(J)=A(I) - I=I+INC - J=J+1 - 10 CONTINUE - IBASE=IBASE+JUMP - JBASE=JBASE+NX - 20 CONTINUE -C - IGO=60 - GO TO 40 -C -C PREPROCESSING (ISIGN=+1) -C ------------------------ -C - 30 CONTINUE - CALL FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) - IGO=60 -C -C COMPLEX TRANSFORM -C ----------------- -C - 40 CONTINUE - IA=INC+1 - LA=1 - DO 80 K=1,NFAX - IF (IGO.EQ.60) GO TO 60 - 50 CONTINUE - CALL VPASSM(A(IA),A(IA+INC),WORK(1),WORK(2),TRIGS, - * INK,2,JUMP,NX,LOT,NH,IFAX(K+1),LA) - IGO=60 - GO TO 70 - 60 CONTINUE - CALL VPASSM(WORK(1),WORK(2),A(IA),A(IA+INC),TRIGS, - * 2,INK,NX,JUMP,LOT,NH,IFAX(K+1),LA) - IGO=50 - 70 CONTINUE - LA=LA*IFAX(K+1) - 80 CONTINUE -C - IF (ISIGN.EQ.-1) GO TO 130 -C -C IF NECESSARY, TRANSFER DATA FROM WORK AREA - IF (MOD(NFAX,2).EQ.1) GO TO 110 - IBASE=1 - JBASE=IA - DO 100 L=1,LOT - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 90 M=1,N - A(J)=WORK(I) - I=I+1 - J=J+INC - 90 CONTINUE - IBASE=IBASE+NX - JBASE=JBASE+JUMP - 100 CONTINUE -C -C FILL IN CYCLIC BOUNDARY POINTS - 110 CONTINUE - IA=1 - IB=N*INC+1 -CDIR$ IVDEP - DO 120 L=1,LOT - A(IA)=A(IB) - A(IB+INC)=A(IA+INC) - IA=IA+JUMP - IB=IB+JUMP - 120 CONTINUE - GO TO 140 -C -C POSTPROCESSING (ISIGN=-1): -C -------------------------- -C - 130 CONTINUE - CALL FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) -C - 140 CONTINUE - RETURN - END - SUBROUTINE FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) - DIMENSION A(N),WORK(N),TRIGS(N) -C -C SUBROUTINE FFT99A - PREPROCESSING STEP FOR FFT99, ISIGN=+1 -C (SPECTRAL TO GRIDPOINT TRANSFORM) -C - NH=N/2 - NX=N+1 - INK=INC+INC -C -C A(0) AND A(N/2) - IA=1 - IB=N*INC+1 - JA=1 - JB=2 -CDIR$ IVDEP - DO 10 L=1,LOT - WORK(JA)=A(IA)+A(IB) - WORK(JB)=A(IA)-A(IB) - IA=IA+JUMP - IB=IB+JUMP - JA=JA+NX - JB=JB+NX - 10 CONTINUE -C -C REMAINING WAVENUMBERS - IABASE=2*INC+1 - IBBASE=(N-2)*INC+1 - JABASE=3 - JBBASE=N-1 -C - DO 30 K=3,NH,2 - IA=IABASE - IB=IBBASE - JA=JABASE - JB=JBBASE - C=TRIGS(N+K) - S=TRIGS(N+K+1) -CDIR$ IVDEP - DO 20 L=1,LOT - WORK(JA)=(A(IA)+A(IB))- - * (S*(A(IA)-A(IB))+C*(A(IA+INC)+A(IB+INC))) - WORK(JB)=(A(IA)+A(IB))+ - * (S*(A(IA)-A(IB))+C*(A(IA+INC)+A(IB+INC))) - WORK(JA+1)=(C*(A(IA)-A(IB))-S*(A(IA+INC)+A(IB+INC)))+ - * (A(IA+INC)-A(IB+INC)) - WORK(JB+1)=(C*(A(IA)-A(IB))-S*(A(IA+INC)+A(IB+INC)))- - * (A(IA+INC)-A(IB+INC)) - IA=IA+JUMP - IB=IB+JUMP - JA=JA+NX - JB=JB+NX - 20 CONTINUE - IABASE=IABASE+INK - IBBASE=IBBASE-INK - JABASE=JABASE+2 - JBBASE=JBBASE-2 - 30 CONTINUE -C - IF (IABASE.NE.IBBASE) GO TO 50 -C WAVENUMBER N/4 (IF IT EXISTS) - IA=IABASE - JA=JABASE -CDIR$ IVDEP - DO 40 L=1,LOT - WORK(JA)=2.0*A(IA) - WORK(JA+1)=-2.0*A(IA+INC) - IA=IA+JUMP - JA=JA+NX - 40 CONTINUE -C - 50 CONTINUE - RETURN - END - SUBROUTINE FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) - DIMENSION WORK(N),A(N),TRIGS(N) -C -C SUBROUTINE FFT99B - POSTPROCESSING STEP FOR FFT99, ISIGN=-1 -C (GRIDPOINT TO SPECTRAL TRANSFORM) -C - NH=N/2 - NX=N+1 - INK=INC+INC -C -C A(0) AND A(N/2) - SCALE=1.0/FLOAT(N) - IA=1 - IB=2 - JA=1 - JB=N*INC+1 -CDIR$ IVDEP - DO 10 L=1,LOT - A(JA)=SCALE*(WORK(IA)+WORK(IB)) - A(JB)=SCALE*(WORK(IA)-WORK(IB)) - A(JA+INC)=0.0 - A(JB+INC)=0.0 - IA=IA+NX - IB=IB+NX - JA=JA+JUMP - JB=JB+JUMP - 10 CONTINUE -C -C REMAINING WAVENUMBERS - SCALE=0.5*SCALE - IABASE=3 - IBBASE=N-1 - JABASE=2*INC+1 - JBBASE=(N-2)*INC+1 -C - DO 30 K=3,NH,2 - IA=IABASE - IB=IBBASE - JA=JABASE - JB=JBBASE - C=TRIGS(N+K) - S=TRIGS(N+K+1) -CDIR$ IVDEP - DO 20 L=1,LOT - A(JA)=SCALE*((WORK(IA)+WORK(IB)) - * +(C*(WORK(IA+1)+WORK(IB+1))+S*(WORK(IA)-WORK(IB)))) - A(JB)=SCALE*((WORK(IA)+WORK(IB)) - * -(C*(WORK(IA+1)+WORK(IB+1))+S*(WORK(IA)-WORK(IB)))) - A(JA+INC)=SCALE*((C*(WORK(IA)-WORK(IB))-S*(WORK(IA+1)+WORK(IB+1))) - * +(WORK(IB+1)-WORK(IA+1))) - A(JB+INC)=SCALE*((C*(WORK(IA)-WORK(IB))-S*(WORK(IA+1)+WORK(IB+1))) - * -(WORK(IB+1)-WORK(IA+1))) - IA=IA+NX - IB=IB+NX - JA=JA+JUMP - JB=JB+JUMP - 20 CONTINUE - IABASE=IABASE+2 - IBBASE=IBBASE-2 - JABASE=JABASE+INK - JBBASE=JBBASE-INK - 30 CONTINUE -C - IF (IABASE.NE.IBBASE) GO TO 50 -C WAVENUMBER N/4 (IF IT EXISTS) - IA=IABASE - JA=JABASE - SCALE=2.0*SCALE -CDIR$ IVDEP - DO 40 L=1,LOT - A(JA)=SCALE*WORK(IA) - A(JA+INC)=-SCALE*WORK(IA+1) - IA=IA+NX - JA=JA+JUMP - 40 CONTINUE -C - 50 CONTINUE - RETURN - END - SUBROUTINE FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) - DIMENSION A(N),WORK(N),TRIGS(N),IFAX(1) -C -C SUBROUTINE "FFT991" - MULTIPLE REAL/HALF-COMPLEX PERIODIC -C FAST FOURIER TRANSFORM -C -C SAME AS FFT99 EXCEPT THAT ORDERING OF DATA CORRESPONDS TO -C THAT IN MRFFT2 -C -C PROCEDURE USED TO CONVERT TO HALF-LENGTH COMPLEX TRANSFORM -C IS GIVEN BY COOLEY, LEWIS AND WELCH (J. SOUND VIB., VOL. 12 -C (1970), 315-337) -C -C A IS THE ARRAY CONTAINING INPUT AND OUTPUT DATA -C WORK IS AN AREA OF SIZE (N+1)*LOT -C TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES -C IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N/2 -C INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' -C (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) -C JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR -C N IS THE LENGTH OF THE DATA VECTORS -C LOT IS THE NUMBER OF DATA VECTORS -C ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT -C = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL -C -C ORDERING OF COEFFICIENTS: -C A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) -C WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED -C -C ORDERING OF DATA: -C X(0),X(1),X(2),...,X(N-1) -C -C VECTORIZATION IS ACHIEVED ON CRAY BY DOING THE TRANSFORMS IN -C PARALLEL -C -C *** N.B. N IS ASSUMED TO BE AN EVEN NUMBER -C -C DEFINITION OF TRANSFORMS: -C ------------------------- -C -C ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) -C WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) -C -C ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) -C B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) -C -C THE FOLLOWING CALL IS FOR MONITORING LIBRARY USE AT NCAR -C CALL Q8QST4 ( 4HXLIB, 6HFFT99F, 6HFFT991, 10HVERSION 01) - NFAX=IFAX(1) - NX=N+1 - NH=N/2 - INK=INC+INC - IF (ISIGN.EQ.+1) GO TO 30 -C -C IF NECESSARY, TRANSFER DATA TO WORK AREA - IGO=50 - IF (MOD(NFAX,2).EQ.1) GOTO 40 - IBASE=1 - JBASE=1 - DO 20 L=1,LOT - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 10 M=1,N - WORK(J)=A(I) - I=I+INC - J=J+1 - 10 CONTINUE - IBASE=IBASE+JUMP - JBASE=JBASE+NX - 20 CONTINUE -C - IGO=60 - GO TO 40 -C -C PREPROCESSING (ISIGN=+1) -C ------------------------ -C - 30 CONTINUE - CALL FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) - IGO=60 -C -C COMPLEX TRANSFORM -C ----------------- -C - 40 CONTINUE - IA=1 - LA=1 - DO 80 K=1,NFAX - IF (IGO.EQ.60) GO TO 60 - 50 CONTINUE - CALL VPASSM(A(IA),A(IA+INC),WORK(1),WORK(2),TRIGS, - * INK,2,JUMP,NX,LOT,NH,IFAX(K+1),LA) - IGO=60 - GO TO 70 - 60 CONTINUE - CALL VPASSM(WORK(1),WORK(2),A(IA),A(IA+INC),TRIGS, - * 2,INK,NX,JUMP,LOT,NH,IFAX(K+1),LA) - IGO=50 - 70 CONTINUE - LA=LA*IFAX(K+1) - 80 CONTINUE -C - IF (ISIGN.EQ.-1) GO TO 130 -C -C IF NECESSARY, TRANSFER DATA FROM WORK AREA - IF (MOD(NFAX,2).EQ.1) GO TO 110 - IBASE=1 - JBASE=1 - DO 100 L=1,LOT - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 90 M=1,N - A(J)=WORK(I) - I=I+1 - J=J+INC - 90 CONTINUE - IBASE=IBASE+NX - JBASE=JBASE+JUMP - 100 CONTINUE -C -C FILL IN ZEROS AT END - 110 CONTINUE - IB=N*INC+1 -CDIR$ IVDEP - DO 120 L=1,LOT - A(IB)=0.0 - A(IB+INC)=0.0 - IB=IB+JUMP - 120 CONTINUE - GO TO 140 -C -C POSTPROCESSING (ISIGN=-1): -C -------------------------- -C - 130 CONTINUE - CALL FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) -C - 140 CONTINUE - RETURN - END - SUBROUTINE FFTFAX(N,IFAX,TRIGS) - DIMENSION IFAX(13),TRIGS(1) -C -C MODE 3 IS USED FOR REAL/HALF-COMPLEX TRANSFORMS. IT IS POSSIBLE -C TO DO COMPLEX/COMPLEX TRANSFORMS WITH OTHER VALUES OF MODE, BUT -C DOCUMENTATION OF THE DETAILS WERE NOT AVAILABLE WHEN THIS ROUTINE -C WAS WRITTEN. -C - DATA MODE /3/ - CALL FAX (IFAX, N, MODE) - I = IFAX(1) - IF (IFAX(I+1) .GT. 5 .OR. N .LE. 4) IFAX(1) = -99 - IF (IFAX(1) .LE. 0 ) WRITE(6,1) N - IF (IFAX(1) .LE. 0 ) STOP 999 - CALL FFTRIG (TRIGS, N, MODE) - 1 FORMAT(//5X, ' FFTFAX -- INVALID N =', I5,/) - RETURN - END - SUBROUTINE FAX(IFAX,N,MODE) - DIMENSION IFAX(10) - NN=N - IF (IABS(MODE).EQ.1) GO TO 10 - IF (IABS(MODE).EQ.8) GO TO 10 - NN=N/2 - IF ((NN+NN).EQ.N) GO TO 10 - IFAX(1)=-99 - RETURN - 10 K=1 -C TEST FOR FACTORS OF 4 - 20 IF (MOD(NN,4).NE.0) GO TO 30 - K=K+1 - IFAX(K)=4 - NN=NN/4 - IF (NN.EQ.1) GO TO 80 - GO TO 20 -C TEST FOR EXTRA FACTOR OF 2 - 30 IF (MOD(NN,2).NE.0) GO TO 40 - K=K+1 - IFAX(K)=2 - NN=NN/2 - IF (NN.EQ.1) GO TO 80 -C TEST FOR FACTORS OF 3 - 40 IF (MOD(NN,3).NE.0) GO TO 50 - K=K+1 - IFAX(K)=3 - NN=NN/3 - IF (NN.EQ.1) GO TO 80 - GO TO 40 -C NOW FIND REMAINING FACTORS - 50 L=5 - INC=2 -C INC ALTERNATELY TAKES ON VALUES 2 AND 4 - 60 IF (MOD(NN,L).NE.0) GO TO 70 - K=K+1 - IFAX(K)=L - NN=NN/L - IF (NN.EQ.1) GO TO 80 - GO TO 60 - 70 L=L+INC - INC=6-INC - GO TO 60 - 80 IFAX(1)=K-1 -C IFAX(1) CONTAINS NUMBER OF FACTORS - NFAX=IFAX(1) -C SORT FACTORS INTO ASCENDING ORDER - IF (NFAX.EQ.1) GO TO 110 - DO 100 II=2,NFAX - ISTOP=NFAX+2-II - DO 90 I=2,ISTOP - IF (IFAX(I+1).GE.IFAX(I)) GO TO 90 - ITEM=IFAX(I) - IFAX(I)=IFAX(I+1) - IFAX(I+1)=ITEM - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - RETURN - END - SUBROUTINE FFTRIG(TRIGS,N,MODE) - DIMENSION TRIGS(1) - PI=2.0*ASIN(1.0) - IMODE=IABS(MODE) - NN=N - IF (IMODE.GT.1.AND.IMODE.LT.6) NN=N/2 - DEL=(PI+PI)/FLOAT(NN) - L=NN+NN - DO 10 I=1,L,2 - ANGLE=0.5*FLOAT(I-1)*DEL - TRIGS(I)=COS(ANGLE) - TRIGS(I+1)=SIN(ANGLE) - 10 CONTINUE - IF (IMODE.EQ.1) RETURN - IF (IMODE.EQ.8) RETURN - DEL=0.5*DEL - NH=(NN+1)/2 - L=NH+NH - LA=NN+NN - DO 20 I=1,L,2 - ANGLE=0.5*FLOAT(I-1)*DEL - TRIGS(LA+I)=COS(ANGLE) - TRIGS(LA+I+1)=SIN(ANGLE) - 20 CONTINUE - IF (IMODE.LE.3) RETURN - DEL=0.5*DEL - LA=LA+NN - IF (MODE.EQ.5) GO TO 40 - DO 30 I=2,NN - ANGLE=FLOAT(I-1)*DEL - TRIGS(LA+I)=2.0*SIN(ANGLE) - 30 CONTINUE - RETURN - 40 CONTINUE - DEL=0.5*DEL - DO 50 I=2,N - ANGLE=FLOAT(I-1)*DEL - TRIGS(LA+I)=SIN(ANGLE) - 50 CONTINUE - RETURN - END - SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) - DIMENSION A(N),B(N),C(N),D(N),TRIGS(N) -C -C SUBROUTINE "VPASSM" - MULTIPLE VERSION OF "VPASSA" -C PERFORMS ONE PASS THROUGH DATA -C AS PART OF MULTIPLE COMPLEX FFT ROUTINE -C A IS FIRST REAL INPUT VECTOR -C B IS FIRST IMAGINARY INPUT VECTOR -C C IS FIRST REAL OUTPUT VECTOR -C D IS FIRST IMAGINARY OUTPUT VECTOR -C TRIGS IS PRECALCULATED TABLE OF SINES " COSINES -C INC1 IS ADDRESSING INCREMENT FOR A AND B -C INC2 IS ADDRESSING INCREMENT FOR C AND D -C INC3 IS ADDRESSING INCREMENT BETWEEN A"S & B"S -C INC4 IS ADDRESSING INCREMENT BETWEEN C"S & D"S -C LOT IS THE NUMBER OF VECTORS -C N IS LENGTH OF VECTORS -C IFAC IS CURRENT FACTOR OF N -C LA IS PRODUCT OF PREVIOUS FACTORS -C - DATA SIN36/0.587785252292473/,COS36/0.809016994374947/, - * SIN72/0.951056516295154/,COS72/0.309016994374947/, - * SIN60/0.866025403784437/ -C - M=N/IFAC - IINK=M*INC1 - JINK=LA*INC2 - JUMP=(IFAC-1)*JINK - IBASE=0 - JBASE=0 - IGO=IFAC-1 - IF (IGO.GT.4) RETURN - GO TO (10,50,90,130),IGO -C -C CODING FOR FACTOR 2 -C - 10 IA=1 - JA=1 - IB=IA+IINK - JB=JA+JINK - DO 20 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 15 IJK=1,LOT - C(JA+J)=A(IA+I)+A(IB+I) - D(JA+J)=B(IA+I)+B(IB+I) - C(JB+J)=A(IA+I)-A(IB+I) - D(JB+J)=B(IA+I)-B(IB+I) - I=I+INC3 - J=J+INC4 - 15 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 20 CONTINUE - IF (LA.EQ.M) RETURN - LA1=LA+1 - JBASE=JBASE+JUMP - DO 40 K=LA1,M,LA - KB=K+K-2 - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - DO 30 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 25 IJK=1,LOT - C(JA+J)=A(IA+I)+A(IB+I) - D(JA+J)=B(IA+I)+B(IB+I) - C(JB+J)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)-B(IB+I)) - D(JB+J)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)-B(IB+I)) - I=I+INC3 - J=J+INC4 - 25 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 30 CONTINUE - JBASE=JBASE+JUMP - 40 CONTINUE - RETURN -C -C CODING FOR FACTOR 3 -C - 50 IA=1 - JA=1 - IB=IA+IINK - JB=JA+JINK - IC=IB+IINK - JC=JB+JINK - DO 60 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 55 IJK=1,LOT - C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) - D(JA+J)=B(IA+I)+(B(IB+I)+B(IC+I)) - C(JB+J)=(A(IA+I)-0.5*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I))) - C(JC+J)=(A(IA+I)-0.5*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I))) - D(JB+J)=(B(IA+I)-0.5*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I))) - D(JC+J)=(B(IA+I)-0.5*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I))) - I=I+INC3 - J=J+INC4 - 55 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 60 CONTINUE - IF (LA.EQ.M) RETURN - LA1=LA+1 - JBASE=JBASE+JUMP - DO 80 K=LA1,M,LA - KB=K+K-2 - KC=KB+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - DO 70 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 65 IJK=1,LOT - C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) - D(JA+J)=B(IA+I)+(B(IB+I)+B(IC+I)) - C(JB+J)= - * C1*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I)))) - * -S1*((B(IA+I)-0.5*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I)))) - D(JB+J)= - * S1*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I)))) - * +C1*((B(IA+I)-0.5*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I)))) - C(JC+J)= - * C2*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I)))) - * -S2*((B(IA+I)-0.5*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I)))) - D(JC+J)= - * S2*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I)))) - * +C2*((B(IA+I)-0.5*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I)))) - I=I+INC3 - J=J+INC4 - 65 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 70 CONTINUE - JBASE=JBASE+JUMP - 80 CONTINUE - RETURN -C -C CODING FOR FACTOR 4 -C - 90 IA=1 - JA=1 - IB=IA+IINK - JB=JA+JINK - IC=IB+IINK - JC=JB+JINK - ID=IC+IINK - JD=JC+JINK - DO 100 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 95 IJK=1,LOT - C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) - C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)) - D(JA+J)=(B(IA+I)+B(IC+I))+(B(IB+I)+B(ID+I)) - D(JC+J)=(B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I)) - C(JB+J)=(A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I)) - C(JD+J)=(A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I)) - D(JB+J)=(B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I)) - D(JD+J)=(B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I)) - I=I+INC3 - J=J+INC4 - 95 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 100 CONTINUE - IF (LA.EQ.M) RETURN - LA1=LA+1 - JBASE=JBASE+JUMP - DO 120 K=LA1,M,LA - KB=K+K-2 - KC=KB+KB - KD=KC+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - DO 110 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 105 IJK=1,LOT - C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) - D(JA+J)=(B(IA+I)+B(IC+I))+(B(IB+I)+B(ID+I)) - C(JC+J)= - * C2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) - * -S2*((B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I))) - D(JC+J)= - * S2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) - * +C2*((B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I))) - C(JB+J)= - * C1*((A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I))) - * -S1*((B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I))) - D(JB+J)= - * S1*((A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I))) - * +C1*((B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I))) - C(JD+J)= - * C3*((A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I))) - * -S3*((B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I))) - D(JD+J)= - * S3*((A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I))) - * +C3*((B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I))) - I=I+INC3 - J=J+INC4 - 105 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 110 CONTINUE - JBASE=JBASE+JUMP - 120 CONTINUE - RETURN -C -C CODING FOR FACTOR 5 -C - 130 IA=1 - JA=1 - IB=IA+IINK - JB=JA+JINK - IC=IB+IINK - JC=JB+JINK - ID=IC+IINK - JD=JC+JINK - IE=ID+IINK - JE=JD+JINK - DO 140 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 135 IJK=1,LOT - C(JA+J)=A(IA+I)+(A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)) - D(JA+J)=B(IA+I)+(B(IB+I)+B(IE+I))+(B(IC+I)+B(ID+I)) - C(JB+J)=(A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) - * -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I))) - C(JE+J)=(A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) - * +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I))) - D(JB+J)=(B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) - * +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I))) - D(JE+J)=(B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) - * -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I))) - C(JC+J)=(A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) - * -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I))) - C(JD+J)=(A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) - * +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I))) - D(JC+J)=(B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) - * +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I))) - D(JD+J)=(B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) - * -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I))) - I=I+INC3 - J=J+INC4 - 135 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 140 CONTINUE - IF (LA.EQ.M) RETURN - LA1=LA+1 - JBASE=JBASE+JUMP - DO 160 K=LA1,M,LA - KB=K+K-2 - KC=KB+KB - KD=KC+KB - KE=KD+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - C4=TRIGS(KE+1) - S4=TRIGS(KE+2) - DO 150 L=1,LA - I=IBASE - J=JBASE -CDIR$ IVDEP - DO 145 IJK=1,LOT - C(JA+J)=A(IA+I)+(A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)) - D(JA+J)=B(IA+I)+(B(IB+I)+B(IE+I))+(B(IC+I)+B(ID+I)) - C(JB+J)= - * C1*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) - * -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) - * -S1*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) - * +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) - D(JB+J)= - * S1*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) - * -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) - * +C1*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) - * +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) - C(JE+J)= - * C4*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) - * +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) - * -S4*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) - * -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) - D(JE+J)= - * S4*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) - * +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) - * +C4*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) - * -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) - C(JC+J)= - * C2*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) - * -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) - * -S2*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) - * +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) - D(JC+J)= - * S2*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) - * -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) - * +C2*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) - * +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) - C(JD+J)= - * C3*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) - * +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) - * -S3*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) - * -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) - D(JD+J)= - * S3*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) - * +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) - * +C3*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) - * -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) - I=I+INC3 - J=J+INC4 - 145 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC2 - 150 CONTINUE - JBASE=JBASE+JUMP - 160 CONTINUE - RETURN - END -C ALTERNATE NAME - SUBROUTINE RFFTMLT(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) - DIMENSION A(N),WORK(N),TRIGS(N),IFAX(1) - CALL FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/fft99.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/fft99.f90 new file mode 100644 index 000000000..c16c3091d --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/fft99.f90 @@ -0,0 +1,1280 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! !! +!! GNU General Public License !! +!! !! +!! This file is part of the Flexible Modeling System (FMS). !! +!! !! +!! FMS is free software; you can redistribute it and/or modify !! +!! it and are expected to follow the terms of the GNU General Public !! +!! License as published by the Free Software Foundation. !! +!! !! +!! FMS is distributed in the hope that it will be useful, !! +!! but WITHOUT ANY WARRANTY; without even the implied warranty of !! +!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! +!! GNU General Public License for more details. !! +!! !! +!! You should have received a copy of the GNU General Public License !! +!! along with FMS; if not, write to: !! +!! Free Software Foundation, Inc. !! +!! 59 Temple Place, Suite 330 !! +!! Boston, MA 02111-1307 USA !! +!! or see: !! +!! http://www.gnu.org/licenses/gpl.txt !! +!! !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!FROM https://github.com/mom-ocean/MOM4p1/blob/master/src/shared/fft/fft99.F90 +!and modified + +module fft99_mod + +implicit none +private + +public :: fft99, fft991, set99 + +contains + +!########################################################################## + + subroutine fft99 (a,work,trigs,ifax,inc,jump,n,lot,isign) + +! purpose performs multiple fast fourier transforms. this package +! will perform a number of simultaneous real/half-complex +! periodic fourier transforms or corresponding inverse +! transforms, i.e. given a set of real data vectors, the +! package returns a set of 'half-complex' fourier +! coefficient vectors, or vice versa. the length of the +! transforms must be an even number greater than 4 that has +! no other factors except possibly powers of 2, 3, and 5. +! this is an all-fortran version of a optimized routine +! fft99 written for xmp/ymps by dr. clive temperton of +! ecmwf. +! +! the package fft99f contains several user-level routines: +! +! subroutine set99 +! an initialization routine that must be called once +! before a sequence of calls to the fft routines +! (provided that n is not changed). +! +! subroutines fft99 and fft991 +! two fft routines that return slightly different +! arrangements of the data in gridpoint space. +! +! usage let n be of the form 2**p * 3**q * 5**r, where p .ge. 1, +! q .ge. 0, and r .ge. 0. then a typical sequence of +! calls to transform a given set of real vectors of length +! n to a set of 'half-complex' fourier coefficient vectors +! of length n is +! +! dimension ifax(13),trigs(3*n/2+1),a(m*(n+2)), +! + work(m*(n+1)) +! +! call set99 (trigs, ifax, n) +! call fft99 (a,work,trigs,ifax,inc,jump,n,m,isign) +! +! see the individual write-ups for set99, fft99, and +! fft991 below, for a detailed description of the +! arguments. +! +! history the package was written by clive temperton at ecmwf in +! november, 1978. it was modified, documented, and tested +! for ncar by russ rew in september, 1980. +! +!----------------------------------------------------------------------- +! +! subroutine set99 (trigs, ifax, n) +! +! purpose a set-up routine for fft99 and fft991. it need only be +! called once before a sequence of calls to the fft +! routines (provided that n is not changed). +! +! argument ifax(13),trigs(3*n/2+1) +! dimensions +! +! arguments +! +! on input trigs +! a floating point array of dimension 3*n/2 if n/2 is +! even, or 3*n/2+1 if n/2 is odd. +! +! ifax +! an integer array. the number of elements actually used +! will depend on the factorization of n. dimensioning +! ifax for 13 suffices for all n less than a million. +! +! n +! an even number greater than 4 that has no prime factor +! greater than 5. n is the length of the transforms (see +! the documentation for fft99 and fft991 for the +! definitions of the transforms). +! +! on output ifax +! contains the factorization of n/2. ifax(1) is the +! number of factors, and the factors themselves are stored +! in ifax(2),ifax(3),... if set99 is called with n odd, +! or if n has any prime factors greater than 5, ifax(1) +! is set to -99. +! +! trigs +! an array of trigonometric function values subsequently +! used by the fft routines. +! +!----------------------------------------------------------------------- +! +! subroutine fft991 (a,work,trigs,ifax,inc,jump,n,m,isign) +! and +! subroutine fft99 (a,work,trigs,ifax,inc,jump,n,m,isign) +! +! purpose perform a number of simultaneous real/half-complex +! periodic fourier transforms or corresponding inverse +! transforms, using ordinary spatial order of gridpoint +! values (fft991) or explicit cyclic continuity in the +! gridpoint values (fft99). given a set +! of real data vectors, the package returns a set of +! 'half-complex' fourier coefficient vectors, or vice +! versa. the length of the transforms must be an even +! number that has no other factors except possibly powers +! of 2, 3, and 5. this is an all-fortran version of +! optimized routine fft991 written for xmp/ymps by +! dr. clive temperton of ecmwf. +! +! argument a(m*(n+2)), work(m*(n+1)), trigs(3*n/2+1), ifax(13) +! dimensions +! +! arguments +! +! on input a +! an array of length m*(n+2) containing the input data +! or coefficient vectors. this array is overwritten by +! the results. +! +! work +! a work array of dimension m*(n+1) +! +! trigs +! an array set up by set99, which must be called first. +! +! ifax +! an array set up by set99, which must be called first. +! +! inc +! the increment (in words) between successive elements of +! each data or coefficient vector (e.g. inc=1 for +! consecutively stored data). +! +! jump +! the increment (in words) between the first elements of +! successive data or coefficient vectors. on crays, +! try to arrange data so that jump is not a multiple of 8 +! (to avoid memory bank conflicts). for clarification of +! inc and jump, see the examples below. +! +! n +! the length of each transform (see definition of +! transforms, below). +! +! m +! the number of transforms to be done simultaneously. +! +! isign +! = +1 for a transform from fourier coefficients to +! gridpoint values. +! = -1 for a transform from gridpoint values to fourier +! coefficients. +! +! on output a +! if isign = +1, and m coefficient vectors are supplied +! each containing the sequence: +! +! a(0),b(0),a(1),b(1),...,a(n/2),b(n/2) (n+2 values) +! +! then the result consists of m data vectors each +! containing the corresponding n+2 gridpoint values: +! +! for fft991, x(0), x(1), x(2),...,x(n-1),0,0. +! for fft99, x(n-1),x(0),x(1),x(2),...,x(n-1),x(0). +! (explicit cyclic continuity) +! +! when isign = +1, the transform is defined by: +! x(j)=sum(k=0,...,n-1)(c(k)*exp(2*i*j*k*pi/n)) +! where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k) +! and i=sqrt (-1) +! +! if isign = -1, and m data vectors are supplied each +! containing a sequence of gridpoint values x(j) as +! defined above, then the result consists of m vectors +! each containing the corresponding fourier cofficients +! a(k), b(k), 0 .le. k .le n/2. +! +! when isign = -1, the inverse transform is defined by: +! c(k)=(1/n)*sum(j=0,...,n-1)(x(j)*exp(-2*i*j*k*pi/n)) +! where c(k)=a(k)+i*b(k) and i=sqrt(-1) +! +! a call with isign=+1 followed by a call with isign=-1 +! (or vice versa) returns the original data. +! +! note: the fact that the gridpoint values x(j) are real +! implies that b(0)=b(n/2)=0. for a call with isign=+1, +! it is not actually necessary to supply these zeros. +! +! examples given 19 data vectors each of length 64 (+2 for explicit +! cyclic continuity), compute the corresponding vectors of +! fourier coefficients. the data may, for example, be +! arranged like this: +! +! first data a(1)= . . . a(66)= a(70) +! vector x(63) x(0) x(1) x(2) ... x(63) x(0) (4 empty locations) +! +! second data a(71)= . . . a(140) +! vector x(63) x(0) x(1) x(2) ... x(63) x(0) (4 empty locations) +! +! and so on. here inc=1, jump=70, n=64, m=19, isign=-1, +! and fft99 should be used (because of the explicit cyclic +! continuity). +! +! alternatively the data may be arranged like this: +! +! first second last +! data data data +! vector vector vector +! +! a(1)= a(2)= a(19)= +! +! x(63) x(63) . . . x(63) +! a(20)= x(0) x(0) . . . x(0) +! a(39)= x(1) x(1) . . . x(1) +! . . . +! . . . +! . . . +! +! in which case we have inc=19, jump=1, and the remaining +! parameters are the same as before. in either case, each +! coefficient vector overwrites the corresponding input +! data vector. +! +!----------------------------------------------------------------------- + implicit none + integer, intent(in) :: inc,jump,n,lot,isign + integer, intent(inout) :: ifax(:) + real, intent(in) :: trigs(:) + real, intent(inout) :: a(*),work(*) + +! dimension a(n),work(n),trigs(n),ifax(1) +! +! subroutine "fft99" - multiple fast real periodic transform +! corresponding to old scalar routine fft9 +! procedure used to convert to half-length complex transform +! is given by cooley, lewis and welch (j. sound vib., vol. 12 +! (1970), 315-337) +! +! a is the array containing input and output data +! work is an area of size (n+1)*lot +! trigs is a previously prepared list of trig function values +! ifax is a previously prepared list of factors of n/2 +! inc is the increment within each data 'vector' +! (e.g. inc=1 for consecutively stored data) +! jump is the increment between the start of each data vector +! n is the length of the data vectors +! lot is the number of data vectors +! isign = +1 for transform from spectral to gridpoint +! = -1 for transform from gridpoint to spectral +! +! ordering of coefficients: +! a(0),b(0),a(1),b(1),a(2),b(2),...,a(n/2),b(n/2) +! where b(0)=b(n/2)=0; (n+2) locations required +! +! ordering of data: +! x(n-1),x(0),x(1),x(2),...,x(n),x(0) +! i.e. explicit cyclic continuity; (n+2) locations required +! +! vectorization is achieved on cray by doing the transforms in +! parallel +! +! *** n.b. n is assumed to be an even number +! +! definition of transforms: +! ------------------------- +! +! isign=+1: x(j)=sum(k=0,...,n-1)(c(k)*exp(2*i*j*k*pi/n)) +! where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k) +! +! isign=-1: a(k)=(1/n)*sum(j=0,...,n-1)(x(j)*cos(2*j*k*pi/n)) +! b(k)=-(1/n)*sum(j=0,...,n-1)(x(j)*sin(2*j*k*pi/n)) +! + + integer :: nfax, nx, nh, ink, igo, ibase, jbase + integer :: i, j, k, L, m, ia, la, ib + integer ind40,ind60 + + nfax=ifax(1) + nx=n+1 + nh=n/2 + ink=inc+inc + if (.NOT.(isign.eq.+1)) then + +! if necessary, transfer data to work area + igo=50 + if (.NOT.(mod(nfax,2).eq.1)) then + ibase=inc+1 + jbase=1 + do L=1,lot + i=ibase + j=jbase +!dir$ ivdep + do m=1,n + work(j)=a(i) + i=i+inc + j=j+1 + enddo + ibase=ibase+jump + jbase=jbase+nx + enddo + + igo=60 +! go to 40 + ind40=1 + else + ind40=1 + endif + +! preprocessing (isign=+1) +! ------------------------ + endif + if(ind40.ne.1) then + call fft99a(a,work,trigs,inc,jump,n,lot) + igo=60 + + endif +! complex transform +! ----------------- + + ia=inc+1 + la=1 + do k=1,nfax !80 + if (.NOT.(igo.eq.60)) then + call vpassm (a(ia),a(ia+inc),work(1),work(2),trigs, & + ink,2,jump,nx,lot,nh,ifax(k+1),la) + igo=60 + ind60=1 + endif + if(ind60.ne.1) then + call vpassm (work(1),work(2),a(ia),a(ia+inc),trigs, & + 2,ink,nx,jump,lot,nh,ifax(k+1),la) + igo=50 + endif + la=la*ifax(k+1) + enddo !80 + + if (isign.eq.-1) then + call fft99b(work,a,trigs,inc,jump,n,lot) + return + endif + +! if necessary, transfer data from work area + + if (mod(nfax,2).ne.1) then + ibase=1 + jbase=ia + do L=1,lot + i=ibase + j=jbase +!dir$ ivdep + do m=1,n + a(j)=work(i) + i=i+1 + j=j+inc + enddo + ibase=ibase+nx + jbase=jbase+jump + enddo + endif + +! fill in cyclic boundary points + ia=1 + ib=n*inc+1 +!dir$ ivdep + do L=1,lot + a(ia)=a(ib) + a(ib+inc)=a(ia+inc) + ia=ia+jump + ib=ib+jump + enddo + +! postprocessing (isign=-1): +! -------------------------- + return + end subroutine fft99 + +!########################################################################## + + subroutine fft99a (a,work,trigs,inc,jump,n,lot) + implicit none + integer, intent(in) :: inc,jump,n,lot + real, intent(in) :: trigs(:) + real, intent(inout) :: a(*),work(*) + +! dimension a(n),work(n),trigs(n) +! +! subroutine fft99a - preprocessing step for fft99, isign=+1 +! (spectral to gridpoint transform) + + integer :: nh, nx, ink, k, L + integer :: ia, ib, ja, jb, iabase, ibbase, jabase, jbbase + real :: c, s + + nh=n/2 + nx=n+1 + ink=inc+inc + +! a(0) and a(n/2) + ia=1 + ib=n*inc+1 + ja=1 + jb=2 +!dir$ ivdep + do L=1,lot + work(ja)=a(ia)+a(ib) + work(jb)=a(ia)-a(ib) + ia=ia+jump + ib=ib+jump + ja=ja+nx + jb=jb+nx + enddo + +! remaining wavenumbers + iabase=2*inc+1 + ibbase=(n-2)*inc+1 + jabase=3 + jbbase=n-1 + + do k=3,nh,2 + ia=iabase + ib=ibbase + ja=jabase + jb=jbbase + c=trigs(n+k) + s=trigs(n+k+1) +!dir$ ivdep + do L=1,lot + work(ja)=(a(ia)+a(ib))- & + (s*(a(ia)-a(ib))+c*(a(ia+inc)+a(ib+inc))) + work(jb)=(a(ia)+a(ib))+ & + (s*(a(ia)-a(ib))+c*(a(ia+inc)+a(ib+inc))) + work(ja+1)=(c*(a(ia)-a(ib))-s*(a(ia+inc)+a(ib+inc)))+ & + (a(ia+inc)-a(ib+inc)) + work(jb+1)=(c*(a(ia)-a(ib))-s*(a(ia+inc)+a(ib+inc)))- & + (a(ia+inc)-a(ib+inc)) + ia=ia+jump + ib=ib+jump + ja=ja+nx + jb=jb+nx + enddo + iabase=iabase+ink + ibbase=ibbase-ink + jabase=jabase+2 + jbbase=jbbase-2 + enddo + +! wavenumber n/4 (if it exists) + if (iabase.eq.ibbase) then + ia=iabase + ja=jabase +!dir$ ivdep + do L=1,lot + work(ja)=2.0*a(ia) + work(ja+1)=-2.0*a(ia+inc) + ia=ia+jump + ja=ja+nx + enddo + endif + + end subroutine fft99a + +!########################################################################## + + subroutine fft99b (work,a,trigs,inc,jump,n,lot) + implicit none + integer, intent(in) :: inc,jump,n,lot + real, intent(in) :: trigs(:) + real, intent(inout) :: a(*),work(*) + +! dimension work(n),a(n),trigs(n) +! +! subroutine fft99b - postprocessing step for fft99, isign=-1 +! (gridpoint to spectral transform) + + integer :: nh, nx, ink, k, L + integer :: ia, ib, ja, jb, iabase, ibbase, jabase, jbbase + real :: scale, c, s + + nh=n/2 + nx=n+1 + ink=inc+inc + +! a(0) and a(n/2) + scale=1.0/real(n) + ia=1 + ib=2 + ja=1 + jb=n*inc+1 +!dir$ ivdep + do L=1,lot + a(ja)=scale*(work(ia)+work(ib)) + a(jb)=scale*(work(ia)-work(ib)) + a(ja+inc)=0.0 + a(jb+inc)=0.0 + ia=ia+nx + ib=ib+nx + ja=ja+jump + jb=jb+jump + enddo + +! remaining wavenumbers + scale=0.5*scale + iabase=3 + ibbase=n-1 + jabase=2*inc+1 + jbbase=(n-2)*inc+1 + + do k=3,nh,2 + ia=iabase + ib=ibbase + ja=jabase + jb=jbbase + c=trigs(n+k) + s=trigs(n+k+1) +!dir$ ivdep + do L=1,lot + a(ja)=scale*((work(ia)+work(ib)) & + +(c*(work(ia+1)+work(ib+1))+s*(work(ia)-work(ib)))) + a(jb)=scale*((work(ia)+work(ib)) & + -(c*(work(ia+1)+work(ib+1))+s*(work(ia)-work(ib)))) + a(ja+inc)=scale*((c*(work(ia)-work(ib))-s*(work(ia+1)+work(ib+1)))& + +(work(ib+1)-work(ia+1))) + a(jb+inc)=scale*((c*(work(ia)-work(ib))-s*(work(ia+1)+work(ib+1)))& + -(work(ib+1)-work(ia+1))) + ia=ia+nx + ib=ib+nx + ja=ja+jump + jb=jb+jump + enddo + iabase=iabase+2 + ibbase=ibbase-2 + jabase=jabase+ink + jbbase=jbbase-ink + enddo + +! wavenumber n/4 (if it exists) + if (iabase.eq.ibbase) then + ia=iabase + ja=jabase + scale=2.0*scale + !dir$ ivdep + do L=1,lot + a(ja)=scale*work(ia) + a(ja+inc)=-scale*work(ia+1) + ia=ia+nx + ja=ja+jump + enddo + endif + + end subroutine fft99b + +!########################################################################## + + subroutine fft991(a,work,trigs,ifax,inc,jump,n,lot,isign) + implicit none + integer, intent(in) :: inc,jump,n,lot,isign + integer, intent(inout) :: ifax(:) + real, intent(in) :: trigs(:) + real, intent(inout) :: a(*),work((n+1)*lot) + +! dimension a(n),work(n),trigs(n),ifax(1) +! +! subroutine "fft991" - multiple real/half-complex periodic +! fast fourier transform +! +! same as fft99 except that ordering of data corresponds to +! that in mrfft2 +! +! procedure used to convert to half-length complex transform +! is given by cooley, lewis and welch (j. sound vib., vol. 12 +! (1970), 315-337) +! +! a is the array containing input and output data +! work is an area of size (n+1)*lot +! trigs is a previously prepared list of trig function values +! ifax is a previously prepared list of factors of n/2 +! inc is the increment within each data 'vector' +! (e.g. inc=1 for consecutively stored data) +! jump is the increment between the start of each data vector +! n is the length of the data vectors +! lot is the number of data vectors +! isign = +1 for transform from spectral to gridpoint +! = -1 for transform from gridpoint to spectral +! +! ordering of coefficients: +! a(0),b(0),a(1),b(1),a(2),b(2),...,a(n/2),b(n/2) +! where b(0)=b(n/2)=0; (n+2) locations required +! +! ordering of data: +! x(0),x(1),x(2),...,x(n-1) +! +! vectorization is achieved on cray by doing the transforms in +! parallel +! +! *** n.b. n is assumed to be an even number +! +! definition of transforms: +! ------------------------- +! +! isign=+1: x(j)=sum(k=0,...,n-1)(c(k)*exp(2*i*j*k*pi/n)) +! where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k) +! +! isign=-1: a(k)=(1/n)*sum(j=0,...,n-1)(x(j)*cos(2*j*k*pi/n)) +! b(k)=-(1/n)*sum(j=0,...,n-1)(x(j)*sin(2*j*k*pi/n)) +! + + integer :: nfax, nx, nh, ink, igo, ibase, jbase + integer :: i, j, k, L, m, ia, la, ib + integer ind40,ind60 + + nfax=ifax(1) + nx=n+1 + nh=n/2 + ink=inc+inc + if (.NOT.(isign.eq.+1)) then + +! if necessary, transfer data to work area + igo=50 + if (.NOT.(mod(nfax,2).eq.1)) then + ibase=1 + jbase=1 + do L=1,lot + i=ibase + j=jbase + !dir$ ivdep + do m=1,n + work(j)=a(i) + i=i+inc + j=j+1 + enddo + ibase=ibase+jump + jbase=jbase+nx + enddo + ! + igo=60 + ind40=1 + else + ind40=1 + endif +! +! preprocessing (isign=+1) +! ------------------------ +! + endif + if(ind40.ne.1) then + call fft99a(a,work,trigs,inc,jump,n,lot) + igo=60 + endif +! +! complex transform +! ----------------- +! + ia=1 + la=1 + do k=1,nfax + if (.NOT.(igo.eq.60)) then + call vpassm (a(ia),a(ia+inc),work(1),work(2),trigs, & + ink,2,jump,nx,lot,nh,ifax(k+1),la) + igo=60 + ind60=1 + endif + if(ind60.ne.1) then + call vpassm (work(1),work(2),a(ia),a(ia+inc),trigs, & + 2,ink,nx,jump,lot,nh,ifax(k+1),la) + igo=50 + endif + la=la*ifax(k+1) + enddo + + if (isign.eq.-1) then + call fft99b (work,a,trigs,inc,jump,n,lot) + return + endif + +! if necessary, transfer data from work area + if (mod(nfax,2).ne.1) then + ibase=1 + jbase=1 + do L=1,lot + i=ibase + j=jbase +!dir$ ivdep + do m=1,n + a(j)=work(i) + i=i+1 + j=j+inc + enddo + ibase=ibase+nx + jbase=jbase+jump + enddo + endif + +! fill in zeros at end + ib=n*inc+1 +!dir$ ivdep + do L=1,lot + a(ib)=0.0 + a(ib+inc)=0.0 + ib=ib+jump + enddo + +! postprocessing (isign=-1): +! -------------------------- + + return + + end subroutine fft991 + +!########################################################################## + + subroutine set99 (trigs, ifax, n) + implicit none + integer, intent(in) :: n + integer, intent(out) :: ifax(:) + real, intent(out) :: trigs(:) + +! dimension ifax(13),trigs(1) +! +! mode 3 is used for real/half-complex transforms. it is possible +! to do complex/complex transforms with other values of mode, but +! documentation of the details were not available when this routine +! was written. +! + integer :: mode = 3 + integer :: i + + call fax (ifax, n, mode) + i = ifax(1) + if (ifax(i+1) .gt. 5 .or. n .le. 4) ifax(1) = -99 + if (ifax(1) .le. 0 ) then +! call mpp_error(FATAL,'fft99_mod: in routine set99 -- invalid n') + print*,'fft error' + endif + call fftrig (trigs, n, mode) + + return + end subroutine set99 + +!########################################################################## + + subroutine fax (ifax,n,mode) + implicit none + integer, intent(out) :: ifax(:) + integer, intent(in) :: n, mode + + integer :: nn, k, L, inc, nfax, ii, istop, i, item + integer ind28,ind38,ind48 + + nn=n + if (iabs(mode).eq.1) then + if (iabs(mode).eq.8) then + nn=n/2 + if ((nn+nn).eq.n) then + ifax(1)=-99 + return + endif + endif + endif + 10 k=1 +! test for factors of 4 + do !20 + 20 if (mod(nn,4).ne.0) exit + k=k+1 + ifax(k)=4 + nn=nn/4 + if (nn.eq.1) then + ind28=1 + exit + endif + enddo !20 +! test for extra factor of 2 + if (ind28.ne.1) then + if (.NOT.(mod(nn,2).ne.0)) then + k=k+1 + ifax(k)=2 + nn=nn/2 + if (nn.eq.1) then + ind38=1 + endif + endif + + if(ind38.ne.1) then + ! test for factors of 3 + do !40 + if (mod(nn,3).ne.0) exit + k=k+1 + ifax(k)=3 + nn=nn/3 + if (nn.eq.1) then + ind48=1 + exit + endif + enddo !40 + ! now find remaining factors + if (ind48.ne.1) then + L=5 + inc=2 + ! inc alternately takes on values 2 and 4 + + do + if (.NOT.(mod(nn,L).ne.0)) then + k=k+1 + ifax(k)=L + nn=nn/L + if (nn.eq.1) exit + cycle + endif + L=L+inc + inc=6-inc + enddo !6080 + + endif !ind48 + endif !ind38 + endif !ind28 + + ifax(1)=k-1 +! ifax(1) contains number of factors + nfax=ifax(1) +! sort factors into ascending order + if (nfax.eq.1) return + do ii=2,nfax !100 + istop=nfax+2-ii + do i=2,istop !90 + if (ifax(i+1).ge.ifax(i)) cycle + item=ifax(i) + ifax(i)=ifax(i+1) + ifax(i+1)=item + enddo !90 + enddo !100 + return + + end subroutine fax + +!########################################################################## + + subroutine fftrig (trigs,n,mode) + implicit none + real, intent(out) :: trigs(:) + integer, intent(in) :: n, mode + real, parameter :: PI = 3.14159265358979323846 + real :: del, angle + integer :: imode, nn, nh, i, L, la + + imode=iabs(mode) + nn=n + if (imode.gt.1.and.imode.lt.6) nn=n/2 + del=(pi+pi)/real(nn) + L=nn+nn + do i=1,L,2 + angle=0.5*real(i-1)*del + trigs(i)=cos(angle) + trigs(i+1)=sin(angle) + enddo + if (imode.eq.1) return + if (imode.eq.8) return + + del=0.5*del + nh=(nn+1)/2 + L=nh+nh + la=nn+nn + do i=1,L,2 + angle=0.5*real(i-1)*del + trigs(la+i)=cos(angle) + trigs(la+i+1)=sin(angle) + enddo + if (imode.le.3) return + + del=0.5*del + la=la+nn + if (mode.ne.5) then + do i=2,nn + angle=real(i-1)*del + trigs(la+i)=2.0*sin(angle) + enddo + return + endif + + del=0.5*del + do i=2,n + angle=real(i-1)*del + trigs(la+i)=sin(angle) + enddo + + return + end subroutine fftrig + +!########################################################################## + + subroutine vpassm (a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la) + implicit none + integer, intent(in) :: inc1, inc2, inc3, inc4, lot, n, ifac, la + real, intent(in) :: a(*),b(*),trigs(*) + real, intent(out) :: c(*),d(*) +! +! subroutine "vpassm" - multiple version of "vpassa" +! performs one pass through data +! as part of multiple complex fft routine +! a is first real input vector +! b is first imaginary input vector +! c is first real output vector +! d is first imaginary output vector +! trigs is precalculated table of sines " cosines +! inc1 is addressing increment for a and b +! inc2 is addressing increment for c and d +! inc3 is addressing increment between a"s & b"s +! inc4 is addressing increment between c"s & d"s +! lot is the number of vectors +! n is length of vectors +! ifac is current factor of n +! la is product of previous factors +! + + real :: sin36=0.587785252292473 + real :: cos36=0.809016994374947 + real :: sin72=0.951056516295154 + real :: cos72=0.309016994374947 + real :: sin60=0.866025403784437 + + integer :: i, j, k, L, m, iink, jink, jump, ibase, jbase, igo, ijk,la1 + integer :: ia, ja, ib, jb, kb, ic, jc, kc, id, jd, kd, ie, je, ke + real :: c1, s1, c2, s2, c3, s3, c4, s4 + + m=n/ifac + iink=m*inc1 + jink=la*inc2 + jump=(ifac-1)*jink + ibase=0 + jbase=0 + igo=ifac-1 + if (igo.gt.4) return +!del go to (10,50,90,130),igo + + select case (igo) + +! coding for factor 2 + + case (1) + ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + do L=1,la !20 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot !15 + c(ja+j)=a(ia+i)+a(ib+i) + d(ja+j)=b(ia+i)+b(ib+i) + c(jb+j)=a(ia+i)-a(ib+i) + d(jb+j)=b(ia+i)-b(ib+i) + i=i+inc3 + j=j+inc4 + enddo !15 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !20 + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do k=la1,m,la !40 + kb=k+k-2 + c1=trigs(kb+1) + s1=trigs(kb+2) + do L=1,la !30 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot !25 + c(ja+j)=a(ia+i)+a(ib+i) + d(ja+j)=b(ia+i)+b(ib+i) + c(jb+j)=c1*(a(ia+i)-a(ib+i))-s1*(b(ia+i)-b(ib+i)) + d(jb+j)=s1*(a(ia+i)-a(ib+i))+c1*(b(ia+i)-b(ib+i)) + i=i+inc3 + j=j+inc4 + enddo !25 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !30 + jbase=jbase+jump + enddo !40 + ! return + + ! coding for factor 3 + + case (2) + 50 ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + ic=ib+iink + jc=jb+jink + do L=1,la !60 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot !55 + c(ja+j)=a(ia+i)+(a(ib+i)+a(ic+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ic+i)) + c(jb+j)=(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i))) + c(jc+j)=(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i))) + d(jb+j)=(b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i))) + d(jc+j)=(b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i))) + i=i+inc3 + j=j+inc4 + enddo !55 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !60 + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do k=la1,m,la !80 + kb=k+k-2 + kc=kb+kb + c1=trigs(kb+1) + s1=trigs(kb+2) + c2=trigs(kc+1) + s2=trigs(kc+2) + do L=1,la !70 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot !65 + c(ja+j)=a(ia+i)+(a(ib+i)+a(ic+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ic+i)) + c(jb+j)=& + c1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i))))& + -s1*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i)))) + d(jb+j)=& + s1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i))))& + +c1*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i)))) + c(jc+j)=& + c2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i))))& + -s2*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i)))) + d(jc+j)=& + s2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i))))& + +c2*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i)))) + i=i+inc3 + j=j+inc4 + enddo !65 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !70 + jbase=jbase+jump + enddo !80 + ! return + + ! coding for factor 4 + + case (3) + 90 ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + ic=ib+iink + jc=jb+jink + id=ic+iink + jd=jc+jink + do L=1,la !100 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot + c(ja+j)=(a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)) + c(jc+j)=(a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i)) + d(ja+j)=(b(ia+i)+b(ic+i))+(b(ib+i)+b(id+i)) + d(jc+j)=(b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i)) + c(jb+j)=(a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i)) + c(jd+j)=(a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i)) + d(jb+j)=(b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i)) + d(jd+j)=(b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i)) + i=i+inc3 + j=j+inc4 + enddo !95 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !100 + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do k=la1,m,la !120 + kb=k+k-2 + kc=kb+kb + kd=kc+kb + c1=trigs(kb+1) + s1=trigs(kb+2) + c2=trigs(kc+1) + s2=trigs(kc+2) + c3=trigs(kd+1) + s3=trigs(kd+2) + do L=1,la !110 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot !105 + c(ja+j)=(a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)) + d(ja+j)=(b(ia+i)+b(ic+i))+(b(ib+i)+b(id+i)) + c(jc+j)= & + c2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) & + -s2*((b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i))) + d(jc+j)= & + s2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) & + +c2*((b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i))) + c(jb+j)= & + c1*((a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i))) & + -s1*((b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i))) + d(jb+j)= & + s1*((a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i))) & + +c1*((b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i))) + c(jd+j)= & + c3*((a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i))) & + -s3*((b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i))) + d(jd+j)= & + s3*((a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i))) & + +c3*((b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i))) + i=i+inc3 + j=j+inc4 + enddo !105 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !110 + jbase=jbase+jump + enddo !120 + ! return + + ! coding for factor 5 + + case (4) + 130 ia=1 + ja=1 + ib=ia+iink + jb=ja+jink + ic=ib+iink + jc=jb+jink + id=ic+iink + jd=jc+jink + ie=id+iink + je=jd+jink + do L=1,la !140 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot !135 + c(ja+j)=a(ia+i)+(a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ie+i))+(b(ic+i)+b(id+i)) + c(jb+j)=(a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i)))& + -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))) + c(je+j)=(a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i)))& + +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))) + d(jb+j)=(b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i)))& + +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i))) + d(je+j)=(b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i)))& + -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i))) + c(jc+j)=(a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i)))& + -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))) + c(jd+j)=(a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i)))& + +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))) + d(jc+j)=(b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i)))& + +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i))) + d(jd+j)=(b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i)))& + -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i))) + i=i+inc3 + j=j+inc4 + enddo !135 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !140 + if (la.eq.m) return + la1=la+1 + jbase=jbase+jump + do k=la1,m,la !160 + kb=k+k-2 + kc=kb+kb + kd=kc+kb + ke=kd+kb + c1=trigs(kb+1) + s1=trigs(kb+2) + c2=trigs(kc+1) + s2=trigs(kc+2) + c3=trigs(kd+1) + s3=trigs(kd+2) + c4=trigs(ke+1) + s4=trigs(ke+2) + do L=1,la !150 + i=ibase + j=jbase + !dir$ ivdep + do ijk=1,lot !145 + c(ja+j)=a(ia+i)+(a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)) + d(ja+j)=b(ia+i)+(b(ib+i)+b(ie+i))+(b(ic+i)+b(id+i)) + c(jb+j)=& + c1*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i)))& + -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))))& + -s1*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i)))& + +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + d(jb+j)=& + s1*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i)))& + -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))))& + +c1*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i)))& + +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + c(je+j)=& + c4*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i)))& + +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))))& + -s4*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i)))& + -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + d(je+j)=& + s4*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i)))& + +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))))& + +c4*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i)))& + -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) + c(jc+j)=& + c2*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i)))& + -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))))& + -s2*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i)))& + +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + d(jc+j)=& + s2*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i)))& + -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))))& + +c2*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i)))& + +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + c(jd+j)=& + c3*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i)))& + +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))))& + -s3*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i)))& + -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + d(jd+j)=& + s3*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i)))& + +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))))& + +c3*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i)))& + -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) + i=i+inc3 + j=j+inc4 + enddo !145 + ibase=ibase+inc1 + jbase=jbase+inc2 + enddo !150 + jbase=jbase+jump + enddo !160 + + end select + return + end subroutine vpassm + +!########################################################################## + +end module fft99_mod + + diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/landcmsk.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/landcmsk.f deleted file mode 100644 index 19298a4df..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/landcmsk.f +++ /dev/null @@ -1,39 +0,0 @@ - subroutine landcmsk(IK,JK,GLON,GLAT,ZDATG,IFLAG,lsflag,kst) -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -c -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -c parameter (IK=384,JK=190,ijdim=IK*JK,NSG=2000,NST=10) - parameter (NSG=50000,NST=10) - DIMENSION ZDATG(IK,JK),GLON(IK,JK),GLAT(IK,JK) - DIMENSION ING(NSG),JNG(NSG) - CHARACTER ST_NAME(NST)*3 - COMMON /TR/ING,JNG,IB - COMMON /NHC2/MDX,MDY - COMMON /NHC3/AMDX,AMDY - COMMON /STNAME/ST_NAME - COMMON /CHEN/KUNIT,ITIM -c - lsflag = 1 - - DO I = 1,IB - IW = ING(I) - JW = JNG(I) - IF(ZDATG(IW,JW).gt.500.)then - iflag = 1 -cnew MDX=0 -cnew MDY=0 -cnew AMDX=0. -cnew AMDY=0. - print*,' Filter domain topography height > 500 m' - 1 ,', storm name = ', ST_NAME(KST), - 2 ', forecast time = ',ITIM,'h', - 3 ', only wind field is relocated' - go to 50 - END IF - END DO - - 50 continue - - - end - diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/landcmsk.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/landcmsk.f90 new file mode 100644 index 000000000..2da2e4d58 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/landcmsk.f90 @@ -0,0 +1,33 @@ +subroutine landcmsk(IK,JK,GLON,GLAT,ZDATG,IFLAG,lsflag,kst) +use tr, only: ING, JNG, IB +use nhc2 +use nhc3 +use stname +use fileconst +implicit none +integer,intent(in)::IK,JK +integer::lsflag,iflag,i,j,iw,jw,kst +real,DIMENSION(ik,jk):: ZDATG,GLON,GLAT + +lsflag = 1 + +DO I = 1,IB + IW = ING(I) + JW = JNG(I) + IF(ZDATG(IW,JW).gt.500.)then + iflag = 1 +!cnew MDX=0 +!cnew MDY=0 +!cnew AMDX=0. +!cnew AMDY=0. + print*,' Filter domain topography height > 500 m' & + ,', storm name = ', ST_NAME(KST), & + ', forecast time = ',ITIM,'h', & + ', only wind field is relocated' + exit + END IF +END DO + +return +end subroutine landcmsk + diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/modules.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/modules.f deleted file mode 100644 index 92b6d910e..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/modules.f +++ /dev/null @@ -1,6 +0,0 @@ - module setparms - integer :: real_single, real_double - integer :: int_single, int_double - parameter (real_single = 4, real_double = real_single * 2) - parameter (int_single = 4, int_double = int_single * 2) - end module setparms diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/modules.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/modules.f90 new file mode 100644 index 000000000..452fefe17 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/modules.f90 @@ -0,0 +1,89 @@ + module setparms + implicit none + integer, parameter:: real_single = 4, real_double = real_single * 2 + integer, parameter:: int_single = 4, int_double = int_single * 2 + end module setparms + + module fileconst + integer kunit,itim + end module fileconst + + module tcvit + implicit none + integer,parameter :: nst=10 + character,save :: TCVT(NST)*95 + end module tcvit + + module stname + implicit none + integer,parameter :: nst=10 + character,save :: ST_NAME(NST)*3,STMNAME(NST)*3 + end module stname + + module rsfc + implicit none + integer,parameter :: nst=10 + real,save:: STRPSF(NST),STVMAX(NST),STRPSF_06(NST) + end module rsfc + + module nhc + implicit none + integer,parameter :: nst=10 + integer,save:: KSTM,IC_N(NST),JC_N(NST) + end module nhc + + module nhc1 + implicit none + integer,parameter :: nst=10 + real,save:: SLON_N(NST),SLAT_N(NST),CLON_N(NST),CLAT_N(NST) + end module nhc1 + + module nhc2 + implicit none + integer,save:: MDX,MDY + end module nhc2 + + module nhc3 + implicit none + real,save:: AMDX,AMDY + end module nhc3 + + module mcoef3 + implicit none + real*4,save:: FHOUR,DUMMY(245) + end module mcoef3 + + module tr + implicit none + integer, parameter:: nsg=720000 + integer,save:: IB,ING(NSG),JNG(NSG) + end module tr + + module matrix + implicit none + integer, parameter :: nmx=24 + real,save::a(nmx,nmx),capd2 + end module matrix + + module posit + implicit none + real,save:: XOLD,YOLD,XCORN,YCORN + real,save:: CLON_NEW,CLAT_NEW,SLON,SLAT,CLON,CLAT,RAD + equivalence(XOLD,CLON_NEW) + equivalence(YOLD,CLAT_NEW) + equivalence(SLON,XCORN) + equivalence(SLAT,YCORN) + end module posit + + module xxx + implicit none + integer, parameter :: imx=41, jmx=41 + real,save:: XF(IMX,JMX),XC,YC,DX,DY + end module xxx + + module vect + implicit none + integer, parameter:: nmx=24 + real,save:: R0(nmx),rovect(nmx),xvect(nmx),yvect(nmx) + equivalence(R0,rovect) + end module vect diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/rodist.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/rodist.f deleted file mode 100644 index 5706b186d..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/rodist.f +++ /dev/null @@ -1,25 +0,0 @@ - subroutine rodist - parameter(nmx=24) - common /vect/rovect(nmx),xvect(nmx),yvect(nmx) - COMMON /POSIT/ XOLD,YOLD,XCORN,YCORN -c -c print*,'rovect',rovect - pi=4.0*atan(1.0) - PI180 = 4.*ATAN(1.0)/180. - yo=yold*pi180 -c qliu fact=cos(yo) - fact=1.0 - xc=xold-xcorn - yc=yold-ycorn -c - do 10 ip=1,nmx -c - theta=float(ip-1)/float(nmx)*2.*pi - r=rovect(ip) -c - xvect(ip)=r*cos(theta)/fact +xc - yvect(ip)=r*sin(theta) +yc -10 continue -c - return - end diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/rodist.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/rodist.f90 new file mode 100644 index 000000000..e945c4955 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/rodist.f90 @@ -0,0 +1,27 @@ + subroutine rodist + use vect,only:rovect,xvect,yvect,nmx + use posit, only: xold,yold,xcorn,ycorn + implicit none + real:: theta + integer::ip + real:: r,yo,pi,pi180,xc,yc,fact + +!c + pi=4.0*atan(1.0) + PI180 = 4.*ATAN(1.0)/180. + yo=yold*pi180 +!c qliu fact=cos(yo) + fact=1.0 + xc=xold-xcorn + yc=yold-ycorn +!c + do ip=1,nmx + theta=float(ip-1)/float(nmx)*2.*pi + r=rovect(ip) + xvect(ip)=r*cos(theta)/fact +xc + yvect(ip)=r*sin(theta) +yc + enddo +!c + + return + end subroutine rodist diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/sig_p_convt.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/sig_p_convt.f deleted file mode 100644 index 69b5619f6..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/sig_p_convt.f +++ /dev/null @@ -1,599 +0,0 @@ - - SUBROUTINE SIG2P(KMAX,MTV2,MTV3,HDAT,PDAT,PSFCM,H,HP,KST) -c -c subprogram: -c prgmmr: Qingfu Liu org: date: 2000-04-25 -c -c abstract: -c Convert data from SIG surface to P surface. -c -c usage: call -c Input: HDAT - DATA at SIG surface -c KST: not used -C Ouput: PDAT - DATA at P surface - - PARAMETER (IX=41, JX=41) - - REAL HDAT(IX,JX,MTV2),PDAT(IX,JX,MTV3) - REAL ZS(IX,JX),PS(IX,JX),APS(IX,JX) - REAL H(IX,JX,KMAX),HP(IX,JX,2*KMAX+1) - -c REAL(4) FHOUR,X(160),SI(KMAX+1),SL(KMAX) - REAL*4 FHOUR,DUMMY(245) - COMMON /COEF3/FHOUR,DUMMY - - REAL, ALLOCATABLE :: TV(:,:,:),DIV(:,:,:),VORT(:,:,:), - & U(:,:,:),V(:,:,:),SH(:,:,:) - REAL, ALLOCATABLE :: PSIG(:,:,:),RH(:,:,:), - & APG(:,:,:),T(:,:,:) - REAL, ALLOCATABLE :: P(:),AP(:) - REAL, ALLOCATABLE :: DIVP(:,:,:),VORTP(:,:,:),UP(:,:,:), - & VP(:,:,:),RHP(:,:,:),SHP(:,:,:),TP(:,:,:) - - REAL, ALLOCATABLE :: SI(:),SL(:) - - KMAX1=KMAX+1 - NMAX=2*KMAX+1 - - ALLOCATE ( SI(KMAX1),SL(KMAX) ) - - DO K=1,KMAX1 - SI(K)=DUMMY(K) - END DO - DO K=1,KMAX - SL(K)=DUMMY(KMAX1+K) - END DO - - ALLOCATE ( TV(IX,JX,KMAX), DIV(IX,JX,KMAX), - & VORT(IX,JX,KMAX),U(IX,JX,KMAX), - & V(IX,JX,KMAX),SH(IX,JX,KMAX) ) - - ALLOCATE ( PSIG(IX,JX,KMAX),RH(IX,JX,KMAX), - & APG(IX,JX,KMAX),T(IX,JX,KMAX) ) - - ALLOCATE ( P(NMAX),AP(NMAX) ) - ALLOCATE ( DIVP(IX,JX,NMAX),VORTP(IX,JX,NMAX), - & UP(IX,JX,NMAX), VP(IX,JX,NMAX), - & RHP(IX,JX,NMAX),SHP(IX,JX,NMAX), - & TP(IX,JX,NMAX) ) - - COEF1=461.5/287.05-1. - COEF2=287.05/9.8 - -c Surface Height and Surface Press - DO J=1,JX - DO I=1,IX - ZS(I,J)=HDAT(I,J,1) - PS(I,J)=EXP(HDAT(I,J,2))*1000. - APS(I,J)=ALOG(PS(I,J)) - END DO - END DO - -c DIV, VORT, U, V, T and Specific Humidity at Sigma Level - DO K=1,KMAX - DO J=1,JX - DO I=1,IX - DIV(I,J,K)=HDAT(I,J,KMAX+4+4*(K-1)) - VORT(I,J,K)=HDAT(I,J,KMAX+5+4*(K-1)) - U(I,J,K)=HDAT(I,J,KMAX+6+4*(K-1)) - V(I,J,K)=HDAT(I,J,KMAX+7+4*(K-1)) - SH(I,J,K)=HDAT(I,J,KMAX*5+3+K) - TV(I,J,K)=HDAT(I,J,3+K) - T(I,J,K)=TV(I,J,K)/(1.+COEF1*SH(I,J,K)) - END DO - END DO - END DO - -c Press at Sigma-Level - DO K=1,KMAX - DO J=1,JX - DO I=1,IX - PSIG(I,J,K)=SL(K)*PS(I,J) - APG(I,J,K)=ALOG(PSIG(I,J,K)) - END DO - END DO - END DO - - DO J=1,JX - DO I=1,IX - TVD=TV(I,J,1) - H(I,J,1)=ZS(I,J)- - & COEF2*TVD*(APG(I,J,1)-APS(I,J)) - DO K=2,KMAX - TVU=TV(I,J,K) - H(I,J,K)=H(I,J,K-1)- - & COEF2*0.5*(TVD+TVU)*(APG(I,J,K)-APG(I,J,K-1)) - TVD=TVU - END DO - END DO - END DO - -c Const. P-Level - DO K=1,KMAX - P(2*K-1)=SI(K)*PSFCM - P(2*K)=SL(K)*PSFCM - END DO - P(NMAX)=SL(KMAX)*0.5*PSFCM - DO N=1,NMAX - AP(N)=ALOG(P(N)) - END DO - - GAMA=6.5E-3 - COEF3=COEF2*GAMA - DO J=1,JX - DO I=1,IX - HP(I,J,1)=H(I,J,1)+ - & T(I,J,1)/GAMA*(1.-(P(1)/PSIG(I,J,1))**COEF3) - HP(I,J,NMAX)=H(I,J,KMAX)+ - & T(I,J,KMAX)/GAMA*(1.-(P(NMAX)/PSIG(I,J,KMAX))**COEF3) - DO N=2,NMAX-1 - K=(N-1)/2+1 - HP(I,J,N)=H(I,J,K)+ - & T(I,J,K)/GAMA*(1.-(P(N)/PSIG(I,J,K))**COEF3) - END DO - END DO - END DO - - DO N=1,NMAX - K=(N-1)/2+1 -c PRINT*,'Press=',N,P(N)/100. -! PRINT*,'Press1=',N,K,P(N),HP(20,20,N),H(20,20,K) - END DO - -c RH at K=1 (Sigma=0.995) -! DO K=1,KMAX - K=1 - DO J=1,JX - DO I=1,IX - DTEMP=T(I,J,K)-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - SHS=0.622*ES/(PSIG(I,J,K)-0.378*ES) - RH(I,J,K)=MIN(MAX(SH(I,J,K)/SHS,0.),1.0) - END DO - END DO -! END DO - -! Interpolate to Const. Press Level. - DO J=1,JX - DO I=1,IX - DO N=1,NMAX - IF(P(N).GE.PSIG(I,J,1))THEN -! below SIGMA K=1 - DIVP(I,J,N)=DIV(I,J,1) - VORTP(I,J,N)=VORT(I,J,1) - UP(I,J,N)=U(I,J,1) - VP(I,J,N)=V(I,J,1) - RHP(I,J,N)=RH(I,J,1) ! RH at SIGMA K=1 - TDRY=T(I,J,1)-GAMA*(HP(I,J,N)-H(I,J,1)) - DTEMP=TDRY-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - SHS=0.622*ES/(P(N)-0.378*ES) - SHP(I,J,N)=RHP(I,J,N)*SHS - TP(I,J,N)=TDRY*(1.+COEF1*SHP(I,J,N)) -! within domain - ELSE IF((P(N).LT.PSIG(I,J,1)).AND. - & (P(N).GT.PSIG(I,J,KMAX)))THEN - DO L=1,KMAX - IF((P(N).LT.PSIG(I,J,L)).AND. - & (P(N).GE.PSIG(I,J,L+1)))THEN - W=(AP(N)-APG(I,J,L))/(APG(I,J,L+1)-APG(I,J,L)) -c W1=(P(N)-PSIG(I,J,L))/(PSIG(I,J,L+1)-PSIG(I,J,L)) - DIVP(I,J,N)=DIV(I,J,L)+ - & W*(DIV(I,J,L+1)-DIV(I,J,L)) - VORTP(I,J,N)=VORT(I,J,L)+ - & W*(VORT(I,J,L+1)-VORT(I,J,L)) - UP(I,J,N)=U(I,J,L)+W*(U(I,J,L+1)-U(I,J,L)) - VP(I,J,N)=V(I,J,L)+W*(V(I,J,L+1)-V(I,J,L)) - TP(I,J,N)=TV(I,J,L)+W*(TV(I,J,L+1)-TV(I,J,L)) - SHP(I,J,N)=SH(I,J,L)+W*(SH(I,J,L+1)-SH(I,J,L)) - GO TO 123 - END IF - END DO - 123 CONTINUE -! above top - ELSE IF(P(N).LE.PSIG(I,J,KMAX))THEN - DIVP(I,J,N)=DIV(I,J,KMAX) - VORTP(I,J,N)=VORT(I,J,KMAX) - UP(I,J,N)=U(I,J,KMAX) - VP(I,J,N)=V(I,J,KMAX) - TDRY=T(I,J,KMAX)-GAMA*(HP(I,J,N)-H(I,J,KMAX)) - SHP(I,J,N)=SH(I,J,KMAX) - TP(I,J,N)=TDRY*(1.+COEF1*SHP(I,J,N)) - ELSE - PRINT*,'SOMETHING IS WRONG' - END IF - - END DO - END DO - END DO - - DO J=1,JX - DO I=1,IX - PDAT(I,J,1)=HDAT(I,J,1) - PDAT(I,J,2)=HDAT(I,J,2) - PDAT(I,J,3)=HDAT(I,J,3) - DO N=1,NMAX - PDAT(I,J,NMAX+4+4*(N-1))=DIVP(I,J,N) - PDAT(I,J,NMAX+5+4*(N-1))=VORTP(I,J,N) - PDAT(I,J,NMAX+6+4*(N-1))=UP(I,J,N) - PDAT(I,J,NMAX+7+4*(N-1))=VP(I,J,N) - PDAT(I,J,NMAX*5+3+N)=SHP(I,J,N) - PDAT(I,J,3+N)=TP(I,J,N) - END DO - END DO - END DO - - DEALLOCATE ( SI,SL ) - - DEALLOCATE ( T, TV, DIV, VORT, U, V, SH ) - - DEALLOCATE ( PSIG, RH, APG ) - - DEALLOCATE ( P, AP ) - DEALLOCATE ( DIVP, VORTP, UP, VP, RHP, SHP, TP ) - - - END - - - SUBROUTINE P2SIG(KMAX,MTV2,MTV3,HDPB,PDPB,PDAT,HDAT, - & PSFCM,H,HP,KST) - -c P to SIG conversion -c -c Input: HDPB (perturbation part), PDPB (perturbation part) -c Input: PDAT (total field), PDPB+PDAT = ENV part -C Ouput: HDPB (the value at the top most level kmax is not changed) -c KST: not used - - PARAMETER (IX=41, JX=41) - - REAL HDPB(IX,JX,MTV2),HDAT(IX,JX,MTV2) - REAL PDPB(IX,JX,MTV3),PDAT(IX,JX,MTV3) - REAL ZS(IX,JX),PS(IX,JX),APS(IX,JX) - REAL H(IX,JX,KMAX),HP(IX,JX,2*KMAX+1) - -c REAL(4) FHOUR,X(160),SI(KMAX+1),SL(KMAX) - REAL*4 FHOUR,DUMMY(245) - COMMON /COEF3/FHOUR,DUMMY - - REAL, ALLOCATABLE :: TV(:,:,:),DIV(:,:,:),VORT(:,:,:), - & U(:,:,:),V(:,:,:),SH(:,:,:) - REAL, ALLOCATABLE :: PSIG(:,:,:),RH(:,:,:), - & APG(:,:,:) - REAL, ALLOCATABLE :: P(:),AP(:) - REAL, ALLOCATABLE :: DIVP(:,:,:),VORTP(:,:,:),UP(:,:,:), - & VP(:,:,:),RHP(:,:,:) - REAL, ALLOCATABLE :: TVP(:,:,:),TVP_E(:,:,:) - REAL, ALLOCATABLE :: TP_E(:,:,:) - REAL, ALLOCATABLE :: SHP(:,:,:),SHP_E(:,:,:) - REAL, ALLOCATABLE :: HT_T(:,:,:),HSH_T(:,:,:) - - REAL, ALLOCATABLE :: SI(:),SL(:) - - KMAX1=KMAX+1 - NMAX=2*KMAX+1 - - ALLOCATE ( SI(KMAX1),SL(KMAX) ) - - DO K=1,KMAX1 - SI(K)=DUMMY(K) - END DO - DO K=1,KMAX - SL(K)=DUMMY(KMAX1+K) - END DO - - ALLOCATE ( TV(IX,JX,KMAX), DIV(IX,JX,KMAX), - & VORT(IX,JX,KMAX),U(IX,JX,KMAX), - & V(IX,JX,KMAX),SH(IX,JX,KMAX) ) - - ALLOCATE ( PSIG(IX,JX,KMAX),RH(IX,JX,KMAX), - & APG(IX,JX,KMAX) ) - - ALLOCATE ( HT_T(IX,JX,KMAX),HSH_T(IX,JX,KMAX) ) - - ALLOCATE ( TVP(IX,JX,NMAX),TVP_E(IX,JX,NMAX), - & SHP(IX,JX,NMAX),SHP_E(IX,JX,NMAX), - & TP_E(IX,JX,NMAX) ) - - ALLOCATE ( P(NMAX),AP(NMAX) ) - ALLOCATE ( DIVP(IX,JX,NMAX),VORTP(IX,JX,NMAX), - & UP(IX,JX,NMAX), VP(IX,JX,NMAX), - & RHP(IX,JX,NMAX) ) - - COEF1=461.5/287.05-1. - COEF2=287.05/9.8 - -c Surface Height and Surface Press - DO J=1,JX - DO I=1,IX - ZS(I,J)=PDPB(I,J,1) ! Full field - PS(I,J)=EXP(PDPB(I,J,2))*1000. ! FULL field - APS(I,J)=ALOG(PS(I,J)) - END DO - END DO - -c DIV, VORT, U, V, T and Specific Humidity at P-Level - DO J=1,JX - DO I=1,IX - DO N=1,NMAX - DIVP(I,J,N)=PDPB(I,J,NMAX+4+4*(N-1)) - VORTP(I,J,N)=PDPB(I,J,NMAX+5+4*(N-1)) - UP(I,J,N)=PDPB(I,J,NMAX+6+4*(N-1)) - VP(I,J,N)=PDPB(I,J,NMAX+7+4*(N-1)) - SHP(I,J,N)=PDPB(I,J,NMAX*5+3+N) - SHP_E(I,J,N)=SHP(I,J,N)+PDAT(I,J,NMAX*5+3+N) - TVP(I,J,N)=PDPB(I,J,3+N) - TVP_E(I,J,N)=TVP(I,J,N)+PDAT(I,J,3+N) - TP_E(I,J,N)=TVP_E(I,J,N)/(1.+COEF1*SHP_E(I,J,N)) - END DO - END DO - END DO - - DO J=1,JX - DO I=1,IX - DO K=1,KMAX-1 - HSH_T(I,J,K)=HDAT(I,J,KMAX*5+3+K) ! Specific Hum. - HT_T(I,J,K)=HDAT(I,J,3+K) - END DO - END DO - END DO - -c Const. P-Level - DO K=1,KMAX - P(2*K-1)=SI(K)*PSFCM - P(2*K)=SL(K)*PSFCM - END DO - P(NMAX)=SL(KMAX)*0.5*PSFCM - DO N=1,NMAX - AP(N)=ALOG(P(N)) - END DO - - GAMA=6.5E-3 - COEF3=COEF2*GAMA -! DO J=1,JX -! DO I=1,IX -! TVD=TVP_E(I,J,1) -! HP(I,J,1)=ZS(I,J)- -! & TP_E(I,J,1)/GAMA*(1.-(PS(I,J)/P(1))**COEF3) -! DO N=2,NMAX -! TVU=TVP_E(I,J,N) -! HP(I,J,N)=HP(I,J,N-1)- -! & COEF2*0.5*(TVD+TVU)*(AP(N)-AP(N-1)) -! TVD=TVU -! END DO -! END DO -! END DO - -c Press at Sigma-Level - DO K=1,KMAX - DO J=1,JX - DO I=1,IX - PSIG(I,J,K)=SL(K)*PS(I,J) - APG(I,J,K)=ALOG(PSIG(I,J,K)) - END DO - END DO - END DO - - -! DO K=1,KMAX -! N=2*K -! DO J=1,JX -! DO I=1,IX -! H(I,J,K)=HP(I,J,N)+ -! & TP_E(I,J,N)/GAMA*(1.-(PSIG(I,J,K)/P(N))**COEF3) -! END DO -! END DO -! END DO - - DO N=1,NMAX - K=(N-1)/2+1 -c PRINT*,'Press=',N,P(N)/100. -c PRINT*,'Press2=',N,K,P(N),HP(20,20,N),H(20,20,K) - END DO - -c RH at Press level -! DO N=1,NMAX - N=1 - DO J=1,JX - DO I=1,IX - DTEMP=TP_E(I,J,N)-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - SHS=0.622*ES/(P(N)-0.378*ES) - RHP(I,J,N)=MIN(MAX(SHP_E(I,J,N)/SHS,0.),1.0) - END DO - END DO -! END DO - -! Interpolate to Sigma Level. - DO J=1,JX - DO I=1,IX - DO K=1,KMAX - IF(PSIG(I,J,K).GE.P(1))THEN -! below Press K=1 - DIV(I,J,K)=DIVP(I,J,1) - VORT(I,J,K)=VORTP(I,J,1) - U(I,J,K)=UP(I,J,1) - V(I,J,K)=VP(I,J,1) - RH(I,J,K)=RHP(I,J,1) ! RH at SIGMA K=1 - TDRY=TP_E(I,J,1)-GAMA*(H(I,J,K)-HP(I,J,1)) - DTEMP=TDRY-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - SHS=0.622*ES/(PSIG(I,J,K)-0.378*ES) - SH_E=RH(I,J,K)*SHS - SH(I,J,K)=SH_E-HSH_T(I,J,K) ! Pert. Part - TV(I,J,K)=TDRY*(1.+COEF1*SH_E)-HT_T(I,J,K) -! PRINT*,'LLL2=',SHP(I,J,1),SHP_E(I,J,K) -! PRINT*,' ',SH(I,J,K),SH_E -! within domain - ELSE IF((PSIG(I,J,K).LT.P(1)).AND. - & (PSIG(I,J,K).GT.P(NMAX)))THEN - DO L=1,NMAX-1 - IF((PSIG(I,J,K).LT.P(L)).AND. - & (PSIG(I,J,K).GE.P(L+1)))THEN - W=(APG(I,J,K)-AP(L))/(AP(L+1)-AP(L)) -c W1=(PSIG(I,J,K)-P(L))/(P(L+1)-P(L)) - DIV(I,J,K)=DIVP(I,J,L)+ - & W*(DIVP(I,J,L+1)-DIVP(I,J,L)) - VORT(I,J,K)=VORTP(I,J,L)+ - & W*(VORTP(I,J,L+1)-VORTP(I,J,L)) - U(I,J,K)=UP(I,J,L)+W*(UP(I,J,L+1)-UP(I,J,L)) - V(I,J,K)=VP(I,J,L)+W*(VP(I,J,L+1)-VP(I,J,L)) - TV(I,J,K)=TVP(I,J,L)+W*(TVP(I,J,L+1)-TVP(I,J,L)) - SH(I,J,K)=SHP(I,J,L)+W*(SHP(I,J,L+1)-SHP(I,J,L)) - GO TO 123 - END IF - END DO - 123 CONTINUE -! above top - ELSE IF(PSIG(I,J,K).LE.P(NMAX))THEN - DIV(I,J,K)=DIVP(I,J,NMAX) - VORT(I,J,K)=VORTP(I,J,NMAX) - U(I,J,K)=UP(I,J,NMAX) - V(I,J,K)=VP(I,J,NMAX) - TDRY=TP_E(I,J,NMAX)-GAMA*(H(I,J,K)-HP(I,J,NMAX)) - SH(I,J,K)=SHP(I,J,NMAX) - SH_E=SH(I,J,K)+HSH_T(I,J,K) - TV(I,J,K)=TDRY*(1.+COEF1*SH_E)-HT_T(I,J,K) - ELSE - PRINT*,'SOMETHING IS WRONG' - END IF - - END DO - END DO - END DO - - DO J=1,JX - DO I=1,IX - HDPB(I,J,1)=PDPB(I,J,1) - HDPB(I,J,2)=PDPB(I,J,2) - HDPB(I,J,3)=PDPB(I,J,3) - DO K=1,KMAX-1 - HDPB(I,J,KMAX+4+4*(K-1))=DIV(I,J,K) - HDPB(I,J,KMAX+5+4*(K-1))=VORT(I,J,K) - HDPB(I,J,KMAX+6+4*(K-1))=U(I,J,K) - HDPB(I,J,KMAX+7+4*(K-1))=V(I,J,K) - HDPB(I,J,KMAX*5+3+K)=SH(I,J,K) - HDPB(I,J,3+K)=TV(I,J,K) - END DO - END DO - END DO - - DEALLOCATE ( SI,SL ) - - DEALLOCATE ( TV, DIV, VORT, U, V, SH ) - - DEALLOCATE ( PSIG, RH, APG ) - - DEALLOCATE ( P, AP ) - DEALLOCATE ( DIVP, VORTP, UP, VP, RHP, SHP ) - - DEALLOCATE ( TVP, TVP_E, TP_E, SHP_E, HT_T, HSH_T) - - END - -C - SUBROUTINE FIND_NEWCT1(UD,VD) - PARAMETER (IR=15,IT=24,IX=41,JX=41) - PARAMETER (ID=41,JD=41,DTX=0.2,DTY=0.2) ! Search x-Domain (ID-1)*DTX - DIMENSION TNMX(ID,JD),UD(IX,JX),VD(IX,JX) - DIMENSION WTM(IR),R0(IT) - COMMON /POSIT/CLON_NEW,CLAT_NEW,SLON,SLAT,CLON,CLAT,RAD - - COMMON /vect/R0,XVECT(IT),YVECT(IT) -c COMMON /CT/SLON,SLAT,CLON,CLAT,RAD -c COMMON /GA/CLON_NEW,CLAT_NEW,R0 -C - PI=ASIN(1.)*2. - RAD=PI/180. -C - XLAT = CLAT-(JD-1)*DTY/2. - XLON = CLON-(ID-1)*DTX/2. -c print *,'STARTING LAT, LON AT FIND NEW CENTER ',XLAT,XLON -C - DO I=1,ID - DO J=1,JD - TNMX(I,J) = 0. - BLON = XLON + (I-1)*DTX - BLAT = XLAT + (J-1)*DTY -C -C.. CALCULATE TANGENTIAL WIND EVERY 1 deg INTERVAL -C.. 10*10 deg AROUND 1ST 1ST GUESS VORTEX CENTER -C - DO 10 JL=1,IR - WTS= 0. - DO 20 IL=1,IT - DR = JL - DD = (IL-1)*15*RAD - DLON = DR*COS(DD) - DLAT = DR*SIN(DD) - TLON = BLON + DLON - TLAT = BLAT + DLAT -C.. INTERPOLATION U, V AT TLON,TLAT AND CLACULATE TANGENTIAL WIND - IDX = floor(TLON) - SLON + 1 - IDY = floor(TLAT) - SLAT + 1 - DXX = TLON - floor(TLON) - DYY = TLAT - floor(TLAT) -C - X1 = UD(IDX ,IDY+1)*DYY + UD(IDX ,IDY)*(1-DYY) - X2 = UD(IDX+1,IDY+1)*DYY + UD(IDX+1,IDY)*(1-DYY) - Y1 = UD(IDX+1,IDY )*DXX + UD(IDX,IDY )*(1-DXX) - Y2 = UD(IDX+1,IDY+1)*DXX + UD(IDX,IDY+1)*(1-DXX) - UT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. - IF(IL.EQ.0.OR.IL.EQ.13) UT = Y1 - IF(IL.EQ.7.OR.IL.EQ.19) UT = X1 -C - X1 = VD(IDX ,IDY+1)*DYY + VD(IDX ,IDY)*(1-DYY) - X2 = VD(IDX+1,IDY+1)*DYY + VD(IDX+1,IDY)*(1-DYY) - Y1 = VD(IDX+1,IDY )*DXX + VD(IDX,IDY )*(1-DXX) - Y2 = VD(IDX+1,IDY+1)*DXX + VD(IDX,IDY+1)*(1-DXX) - VT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. - IF(IL.EQ.0.OR.IL.EQ.13) VT = Y1 - IF(IL.EQ.7.OR.IL.EQ.19) VT = X1 -C.. TANGENTIAL WIND - WT = -SIN(DD)*UT + COS(DD)*VT - WTS = WTS+WT -20 CONTINUE - WTM(JL) = WTS/24. -10 CONTINUE -C -C Southern Hemisphere - IF(CLAT_NEW.LT.0)THEN - DO JL=1,IR - WTM(JL)=-WTM(JL) - END DO - END IF -C EnD SH - - TX = -10000000. - DO KL = 1,IR - IF(WTM(KL).GE.TX) THEN - TX = WTM(KL) - ENDIF - ENDDO -C - TNMX(I,J) = TX - ENDDO - ENDDO -C.. FIND NEW CENTER - TTX = -1000000. - DO I=1,ID - DO J=1,JD - IF(TNMX(I,J).GE.TTX) THEN - TTX = TNMX(I,J) - NIC = I - NJC = J - ENDIF - ENDDO - ENDDO -C - CLAT_NEW = XLAT + (NJC-1)*DTY - CLON_NEW = XLON + (NIC-1)*DTX -C - print *,'NEW CENTER, I, J IS ',NIC,NJC - print *,'NEW CENTER, LAT,LON IS ',CLAT_NEW,CLON_NEW - print *,'MAX TAN. WIND AT NEW CENTER IS ',TTX -C - RETURN - END - diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/sig_p_convt.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/sig_p_convt.f90 new file mode 100644 index 000000000..b08bddb09 --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/sig_p_convt.f90 @@ -0,0 +1,588 @@ + SUBROUTINE SIG2P(KMAX,MTV2,MTV3,HDAT,PDAT,PSFCM,H,HP,KST) + use mcoef3 + implicit none +!c +!c subprogram: +!c prgmmr: Qingfu Liu org: date: 2000-04-25 +!c +!c abstract: +!c Convert data from SIG surface to P surface. +!c +!c usage: call +!c Input: HDAT - DATA at SIG surface +!c KST: not used +!C Ouput: PDAT - DATA at P surface + + integer,PARAMETER:: IX=41, JX=41 + + REAL HDAT(IX,JX,MTV2),PDAT(IX,JX,MTV3) + REAL ZS(IX,JX),PS(IX,JX),APS(IX,JX) + REAL H(IX,JX,KMAX),HP(IX,JX,2*KMAX+1) + + REAL, ALLOCATABLE :: TV(:,:,:),DIV(:,:,:),VORT(:,:,:),U(:,:,:) + REAL, ALLOCATABLE :: V(:,:,:),SH(:,:,:) + REAL, ALLOCATABLE :: PSIG(:,:,:),RH(:,:,:), APG(:,:,:),T(:,:,:) + REAL, ALLOCATABLE :: P(:),AP(:) + REAL, ALLOCATABLE :: DIVP(:,:,:),VORTP(:,:,:),UP(:,:,:) + REAL, ALLOCATABLE :: VP(:,:,:),RHP(:,:,:),SHP(:,:,:),TP(:,:,:) + + REAL, ALLOCATABLE :: SI(:),SL(:) + + integer:: i,j,l,kmax1,nmax,k,n,kmax,kst + real:: coef1,coef3,coef2,gama + real:: w,w1,es,dtemp,shs,tdry,psfcm,tvu,tvd + integer:: mtv2,mtv3 + + + KMAX1=KMAX+1 + NMAX=2*KMAX+1 + + ALLOCATE ( SI(KMAX1),SL(KMAX) ) + + DO K=1,KMAX1 + SI(K)=DUMMY(K) + END DO + DO K=1,KMAX + SL(K)=DUMMY(KMAX1+K) + END DO + + ALLOCATE ( TV(IX,JX,KMAX), DIV(IX,JX,KMAX)) + ALLOCATE (VORT(IX,JX,KMAX),U(IX,JX,KMAX)) + ALLOCATE (V(IX,JX,KMAX),SH(IX,JX,KMAX) ) + + ALLOCATE (PSIG(IX,JX,KMAX),RH(IX,JX,KMAX)) + ALLOCATE (APG(IX,JX,KMAX),T(IX,JX,KMAX) ) + + ALLOCATE (P(NMAX),AP(NMAX) ) + ALLOCATE (DIVP(IX,JX,NMAX),VORTP(IX,JX,NMAX)) + ALLOCATE(UP(IX,JX,NMAX), VP(IX,JX,NMAX)) + ALLOCATE(RHP(IX,JX,NMAX),SHP(IX,JX,NMAX)) + ALLOCATE (TP(IX,JX,NMAX) ) + + COEF1=461.5/287.05-1. + COEF2=287.05/9.8 + +!c Surface Height and Surface Press + DO J=1,JX + DO I=1,IX + ZS(I,J)=HDAT(I,J,1) + PS(I,J)=EXP(HDAT(I,J,2))*1000. + APS(I,J)=ALOG(PS(I,J)) + END DO + END DO + +!c DIV, VORT, U, V, T and Specific Humidity at Sigma Level + DO K=1,KMAX + DO J=1,JX + DO I=1,IX + DIV(I,J,K)=HDAT(I,J,KMAX+4+4*(K-1)) + VORT(I,J,K)=HDAT(I,J,KMAX+5+4*(K-1)) + U(I,J,K)=HDAT(I,J,KMAX+6+4*(K-1)) + V(I,J,K)=HDAT(I,J,KMAX+7+4*(K-1)) + SH(I,J,K)=HDAT(I,J,KMAX*5+3+K) + TV(I,J,K)=HDAT(I,J,3+K) + T(I,J,K)=TV(I,J,K)/(1.+COEF1*SH(I,J,K)) + END DO + END DO + END DO + +!c Press at Sigma-Level + DO K=1,KMAX + DO J=1,JX + DO I=1,IX + PSIG(I,J,K)=SL(K)*PS(I,J) + APG(I,J,K)=ALOG(PSIG(I,J,K)) + END DO + END DO + END DO + + DO J=1,JX + DO I=1,IX + TVD=TV(I,J,1) + H(I,J,1)=ZS(I,J)-COEF2*TVD*(APG(I,J,1)-APS(I,J)) + DO K=2,KMAX + TVU=TV(I,J,K) + H(I,J,K)=H(I,J,K-1)-COEF2*0.5*(TVD+TVU)*(APG(I,J,K)-APG(I,J,K-1)) + TVD=TVU + END DO + END DO + END DO + +!c Const. P-Level + DO K=1,KMAX + P(2*K-1)=SI(K)*PSFCM + P(2*K)=SL(K)*PSFCM + END DO + P(NMAX)=SL(KMAX)*0.5*PSFCM + DO N=1,NMAX + AP(N)=ALOG(P(N)) + END DO + + GAMA=6.5E-3 + COEF3=COEF2*GAMA + DO J=1,JX + DO I=1,IX + HP(I,J,1)=H(I,J,1)+T(I,J,1)/GAMA*(1.-(P(1)/PSIG(I,J,1))**COEF3) + HP(I,J,NMAX)=H(I,J,KMAX)+T(I,J,KMAX)/GAMA*(1.-(P(NMAX)/PSIG(I,J,KMAX))**COEF3) + DO N=2,NMAX-1 + K=(N-1)/2+1 + HP(I,J,N)=H(I,J,K)+T(I,J,K)/GAMA*(1.-(P(N)/PSIG(I,J,K))**COEF3) + END DO + END DO + END DO + + DO N=1,NMAX + K=(N-1)/2+1 +!c PRINT*,'Press=',N,P(N)/100. +! PRINT*,'Press1=',N,K,P(N),HP(20,20,N),H(20,20,K) + END DO + +!c RH at K=1 (Sigma=0.995) +! DO K=1,KMAX + K=1 + DO J=1,JX + DO I=1,IX + DTEMP=T(I,J,K)-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + SHS=0.622*ES/(PSIG(I,J,K)-0.378*ES) + RH(I,J,K)=MIN(MAX(SH(I,J,K)/SHS,0.),1.0) + END DO + END DO +! END DO + +! Interpolate to Const. Press Level. + DO J=1,JX + DO I=1,IX + DO N=1,NMAX + IF(P(N).GE.PSIG(I,J,1))THEN +! below SIGMA K=1 + DIVP(I,J,N)=DIV(I,J,1) + VORTP(I,J,N)=VORT(I,J,1) + UP(I,J,N)=U(I,J,1) + VP(I,J,N)=V(I,J,1) + RHP(I,J,N)=RH(I,J,1) ! RH at SIGMA K=1 + TDRY=T(I,J,1)-GAMA*(HP(I,J,N)-H(I,J,1)) + DTEMP=TDRY-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + SHS=0.622*ES/(P(N)-0.378*ES) + SHP(I,J,N)=RHP(I,J,N)*SHS + TP(I,J,N)=TDRY*(1.+COEF1*SHP(I,J,N)) +! within domain + ELSE IF((P(N).LT.PSIG(I,J,1)).AND.(P(N).GT.PSIG(I,J,KMAX)))THEN + DO L=1,KMAX + IF((P(N).LT.PSIG(I,J,L)).AND.(P(N).GE.PSIG(I,J,L+1)))THEN + W=(AP(N)-APG(I,J,L))/(APG(I,J,L+1)-APG(I,J,L)) +!c W1=(P(N)-PSIG(I,J,L))/(PSIG(I,J,L+1)-PSIG(I,J,L)) + DIVP(I,J,N)=DIV(I,J,L)+W*(DIV(I,J,L+1)-DIV(I,J,L)) + VORTP(I,J,N)=VORT(I,J,L)+W*(VORT(I,J,L+1)-VORT(I,J,L)) + UP(I,J,N)=U(I,J,L)+W*(U(I,J,L+1)-U(I,J,L)) + VP(I,J,N)=V(I,J,L)+W*(V(I,J,L+1)-V(I,J,L)) + TP(I,J,N)=TV(I,J,L)+W*(TV(I,J,L+1)-TV(I,J,L)) + SHP(I,J,N)=SH(I,J,L)+W*(SH(I,J,L+1)-SH(I,J,L)) + exit + END IF + END DO +! above top + ELSE IF(P(N).LE.PSIG(I,J,KMAX))THEN + DIVP(I,J,N)=DIV(I,J,KMAX) + VORTP(I,J,N)=VORT(I,J,KMAX) + UP(I,J,N)=U(I,J,KMAX) + VP(I,J,N)=V(I,J,KMAX) + TDRY=T(I,J,KMAX)-GAMA*(HP(I,J,N)-H(I,J,KMAX)) + SHP(I,J,N)=SH(I,J,KMAX) + TP(I,J,N)=TDRY*(1.+COEF1*SHP(I,J,N)) + ELSE + PRINT*,'SOMETHING IS WRONG' + END IF + + END DO + END DO + END DO + + DO J=1,JX + DO I=1,IX + PDAT(I,J,1)=HDAT(I,J,1) + PDAT(I,J,2)=HDAT(I,J,2) + PDAT(I,J,3)=HDAT(I,J,3) + DO N=1,NMAX + PDAT(I,J,NMAX+4+4*(N-1))=DIVP(I,J,N) + PDAT(I,J,NMAX+5+4*(N-1))=VORTP(I,J,N) + PDAT(I,J,NMAX+6+4*(N-1))=UP(I,J,N) + PDAT(I,J,NMAX+7+4*(N-1))=VP(I,J,N) + PDAT(I,J,NMAX*5+3+N)=SHP(I,J,N) + PDAT(I,J,3+N)=TP(I,J,N) + END DO + END DO + END DO + + DEALLOCATE ( SI,SL ) + + DEALLOCATE ( T, TV, DIV, VORT, U, V, SH ) + + DEALLOCATE ( PSIG, RH, APG ) + + DEALLOCATE ( P, AP ) + DEALLOCATE ( DIVP, VORTP, UP, VP, RHP, SHP, TP ) + + + END SUBROUTINE SIG2P + + + SUBROUTINE P2SIG(KMAX,MTV2,MTV3,HDPB,PDPB,PDAT,HDAT,PSFCM,H,HP,KST) + +!c P to SIG conversion +!c +!c Input: HDPB (perturbation part), PDPB (perturbation part) +!c Input: PDAT (total field), PDPB+PDAT = ENV part +!C Ouput: HDPB (the value at the top most level kmax is not changed) +!c KST: not used + use mcoef3 + implicit none + integer,PARAMETER:: IX=41, JX=41 + + REAL HDPB(IX,JX,MTV2),HDAT(IX,JX,MTV2) + REAL PDPB(IX,JX,MTV3),PDAT(IX,JX,MTV3) + REAL ZS(IX,JX),PS(IX,JX),APS(IX,JX) + REAL H(IX,JX,KMAX),HP(IX,JX,2*KMAX+1) + + REAL, ALLOCATABLE :: TV(:,:,:),DIV(:,:,:),VORT(:,:,:) + REAL, ALLOCATABLE :: U(:,:,:),V(:,:,:),SH(:,:,:) + REAL, ALLOCATABLE :: PSIG(:,:,:),RH(:,:,:) + REAL, ALLOCATABLE :: APG(:,:,:) + REAL, ALLOCATABLE :: P(:),AP(:) + REAL, ALLOCATABLE :: DIVP(:,:,:),VORTP(:,:,:),UP(:,:,:) + REAL, ALLOCATABLE :: VP(:,:,:),RHP(:,:,:) + REAL, ALLOCATABLE :: TVP(:,:,:),TVP_E(:,:,:) + REAL, ALLOCATABLE :: TP_E(:,:,:) + REAL, ALLOCATABLE :: SHP(:,:,:),SHP_E(:,:,:) + REAL, ALLOCATABLE :: HT_T(:,:,:),HSH_T(:,:,:) + + REAL, ALLOCATABLE :: SI(:),SL(:) + integer:: i,j,l,kmax1,nmax,k,n,kmax,kst + real:: coef1,coef3,coef2,gama + real:: w,w1,es,dtemp,shs,tdry,psfcm,tvu,tvd,sh_e + integer:: mtv2,mtv3 + + + KMAX1=KMAX+1 + NMAX=2*KMAX+1 + + ALLOCATE ( SI(KMAX1),SL(KMAX) ) + + DO K=1,KMAX1 + SI(K)=DUMMY(K) + END DO + DO K=1,KMAX + SL(K)=DUMMY(KMAX1+K) + END DO + + ALLOCATE ( TV(IX,JX,KMAX), DIV(IX,JX,KMAX)) + ALLOCATE (VORT(IX,JX,KMAX),U(IX,JX,KMAX)) + ALLOCATE (V(IX,JX,KMAX),SH(IX,JX,KMAX) ) + ALLOCATE (PSIG(IX,JX,KMAX),RH(IX,JX,KMAX)) + ALLOCATE (APG(IX,JX,KMAX) ) + ALLOCATE (HT_T(IX,JX,KMAX),HSH_T(IX,JX,KMAX) ) + ALLOCATE (TVP(IX,JX,NMAX),TVP_E(IX,JX,NMAX)) + ALLOCATE (SHP(IX,JX,NMAX),SHP_E(IX,JX,NMAX)) + ALLOCATE (TP_E(IX,JX,NMAX) ) + ALLOCATE (P(NMAX),AP(NMAX) ) + ALLOCATE (DIVP(IX,JX,NMAX),VORTP(IX,JX,NMAX)) + ALLOCATE (UP(IX,JX,NMAX), VP(IX,JX,NMAX)) + ALLOCATE (RHP(IX,JX,NMAX) ) + + COEF1=461.5/287.05-1. + COEF2=287.05/9.8 + +!c Surface Height and Surface Press + DO J=1,JX + DO I=1,IX + ZS(I,J)=PDPB(I,J,1) ! Full field + PS(I,J)=EXP(PDPB(I,J,2))*1000. ! FULL field + APS(I,J)=ALOG(PS(I,J)) + END DO + END DO + +!c DIV, VORT, U, V, T and Specific Humidity at P-Level + DO J=1,JX + DO I=1,IX + DO N=1,NMAX + DIVP(I,J,N)=PDPB(I,J,NMAX+4+4*(N-1)) + VORTP(I,J,N)=PDPB(I,J,NMAX+5+4*(N-1)) + UP(I,J,N)=PDPB(I,J,NMAX+6+4*(N-1)) + VP(I,J,N)=PDPB(I,J,NMAX+7+4*(N-1)) + SHP(I,J,N)=PDPB(I,J,NMAX*5+3+N) + SHP_E(I,J,N)=SHP(I,J,N)+PDAT(I,J,NMAX*5+3+N) + TVP(I,J,N)=PDPB(I,J,3+N) + TVP_E(I,J,N)=TVP(I,J,N)+PDAT(I,J,3+N) + TP_E(I,J,N)=TVP_E(I,J,N)/(1.+COEF1*SHP_E(I,J,N)) + END DO + END DO + END DO + + DO J=1,JX + DO I=1,IX + DO K=1,KMAX-1 + HSH_T(I,J,K)=HDAT(I,J,KMAX*5+3+K) ! Specific Hum. + HT_T(I,J,K)=HDAT(I,J,3+K) + END DO + END DO + END DO + +!c Const. P-Level + DO K=1,KMAX + P(2*K-1)=SI(K)*PSFCM + P(2*K)=SL(K)*PSFCM + END DO + P(NMAX)=SL(KMAX)*0.5*PSFCM + DO N=1,NMAX + AP(N)=ALOG(P(N)) + END DO + + GAMA=6.5E-3 + COEF3=COEF2*GAMA +! DO J=1,JX +! DO I=1,IX +! TVD=TVP_E(I,J,1) +! HP(I,J,1)=ZS(I,J)- +! & TP_E(I,J,1)/GAMA*(1.-(PS(I,J)/P(1))**COEF3) +! DO N=2,NMAX +! TVU=TVP_E(I,J,N) +! HP(I,J,N)=HP(I,J,N-1)- +! & COEF2*0.5*(TVD+TVU)*(AP(N)-AP(N-1)) +! TVD=TVU +! END DO +! END DO +! END DO + +!c Press at Sigma-Level + DO K=1,KMAX + DO J=1,JX + DO I=1,IX + PSIG(I,J,K)=SL(K)*PS(I,J) + APG(I,J,K)=ALOG(PSIG(I,J,K)) + END DO + END DO + END DO + + +! DO K=1,KMAX +! N=2*K +! DO J=1,JX +! DO I=1,IX +! H(I,J,K)=HP(I,J,N)+ +! & TP_E(I,J,N)/GAMA*(1.-(PSIG(I,J,K)/P(N))**COEF3) +! END DO +! END DO +! END DO + + DO N=1,NMAX + K=(N-1)/2+1 +!c PRINT*,'Press=',N,P(N)/100. +!c PRINT*,'Press2=',N,K,P(N),HP(20,20,N),H(20,20,K) + END DO + +!c RH at Press level +! DO N=1,NMAX + N=1 + DO J=1,JX + DO I=1,IX + DTEMP=TP_E(I,J,N)-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + SHS=0.622*ES/(P(N)-0.378*ES) + RHP(I,J,N)=MIN(MAX(SHP_E(I,J,N)/SHS,0.),1.0) + END DO + END DO +! END DO + +! Interpolate to Sigma Level. + DO J=1,JX + DO I=1,IX + DO K=1,KMAX + IF(PSIG(I,J,K).GE.P(1))THEN +! below Press K=1 + DIV(I,J,K)=DIVP(I,J,1) + VORT(I,J,K)=VORTP(I,J,1) + U(I,J,K)=UP(I,J,1) + V(I,J,K)=VP(I,J,1) + RH(I,J,K)=RHP(I,J,1) ! RH at SIGMA K=1 + TDRY=TP_E(I,J,1)-GAMA*(H(I,J,K)-HP(I,J,1)) + DTEMP=TDRY-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + SHS=0.622*ES/(PSIG(I,J,K)-0.378*ES) + SH_E=RH(I,J,K)*SHS + SH(I,J,K)=SH_E-HSH_T(I,J,K) ! Pert. Part + TV(I,J,K)=TDRY*(1.+COEF1*SH_E)-HT_T(I,J,K) +! PRINT*,'LLL2=',SHP(I,J,1),SHP_E(I,J,K) +! PRINT*,' ',SH(I,J,K),SH_E +! within domain + ELSE IF((PSIG(I,J,K).LT.P(1)).AND.(PSIG(I,J,K).GT.P(NMAX)))THEN + DO L=1,NMAX-1 + IF((PSIG(I,J,K).LT.P(L)).AND.(PSIG(I,J,K).GE.P(L+1)))THEN + W=(APG(I,J,K)-AP(L))/(AP(L+1)-AP(L)) +! c W1=(PSIG(I,J,K)-P(L))/(P(L+1)-P(L)) + DIV(I,J,K)=DIVP(I,J,L)+W*(DIVP(I,J,L+1)-DIVP(I,J,L)) + VORT(I,J,K)=VORTP(I,J,L)+W*(VORTP(I,J,L+1)-VORTP(I,J,L)) + U(I,J,K)=UP(I,J,L)+W*(UP(I,J,L+1)-UP(I,J,L)) + V(I,J,K)=VP(I,J,L)+W*(VP(I,J,L+1)-VP(I,J,L)) + TV(I,J,K)=TVP(I,J,L)+W*(TVP(I,J,L+1)-TVP(I,J,L)) + SH(I,J,K)=SHP(I,J,L)+W*(SHP(I,J,L+1)-SHP(I,J,L)) + exit + END IF + END DO +! above top + ELSE IF(PSIG(I,J,K).LE.P(NMAX))THEN + DIV(I,J,K)=DIVP(I,J,NMAX) + VORT(I,J,K)=VORTP(I,J,NMAX) + U(I,J,K)=UP(I,J,NMAX) + V(I,J,K)=VP(I,J,NMAX) + TDRY=TP_E(I,J,NMAX)-GAMA*(H(I,J,K)-HP(I,J,NMAX)) + SH(I,J,K)=SHP(I,J,NMAX) + SH_E=SH(I,J,K)+HSH_T(I,J,K) + TV(I,J,K)=TDRY*(1.+COEF1*SH_E)-HT_T(I,J,K) + ELSE + PRINT*,'SOMETHING IS WRONG' + END IF + END DO + END DO + END DO + + DO J=1,JX + DO I=1,IX + HDPB(I,J,1)=PDPB(I,J,1) + HDPB(I,J,2)=PDPB(I,J,2) + HDPB(I,J,3)=PDPB(I,J,3) + DO K=1,KMAX-1 + HDPB(I,J,KMAX+4+4*(K-1))=DIV(I,J,K) + HDPB(I,J,KMAX+5+4*(K-1))=VORT(I,J,K) + HDPB(I,J,KMAX+6+4*(K-1))=U(I,J,K) + HDPB(I,J,KMAX+7+4*(K-1))=V(I,J,K) + HDPB(I,J,KMAX*5+3+K)=SH(I,J,K) + HDPB(I,J,3+K)=TV(I,J,K) + END DO + END DO + END DO + + DEALLOCATE ( SI,SL ) + + DEALLOCATE ( TV, DIV, VORT, U, V, SH ) + + DEALLOCATE ( PSIG, RH, APG ) + + DEALLOCATE ( P, AP ) + DEALLOCATE ( DIVP, VORTP, UP, VP, RHP, SHP ) + + DEALLOCATE ( TVP, TVP_E, TP_E, SHP_E, HT_T, HSH_T) + + END SUBROUTINE P2SIG + + SUBROUTINE FIND_NEWCT1(UD,VD) + use vect + use posit + implicit none + integer,PARAMETER::IR=15,IT=24,IX=41,JX=41 + integer,PARAMETER::ID=41,JD=41 + real,parameter:: DTX=0.2,DTY=0.2 ! Search x-Domain (ID-1)*DTX + real:: TNMX(ID,JD),UD(IX,JX),VD(IX,JX) + real:: WTM(IR) + + integer:: i,j,l,kmax1,nmax,k,n,kmax,kst,il,jl,kl + integer:: mtv2,mtv3 + integer dr,idx,idy,nic,njc + real:: coef1,coef3,coef2,gama,pi + real blon,blat,xlon,xlat,tlon,tlat,dlon,dlat + real:: w,w1,es,dtemp,shs,tdry,psfcm,tvu,tvd + real tx,ttx,wts,dd,dxx,dyy,x1,x2,y1,y2,vt,ut,wt + +!C + PI=ASIN(1.)*2. + RAD=PI/180. + XLAT = CLAT-(JD-1)*DTY/2. + XLON = CLON-(ID-1)*DTX/2. +!c print *,'STARTING LAT, LON AT FIND NEW CENTER ',XLAT,XLON +!C + DO I=1,ID + DO J=1,JD + TNMX(I,J) = 0. + BLON = XLON + (I-1)*DTX + BLAT = XLAT + (J-1)*DTY +!C +!C.. CALCULATE TANGENTIAL WIND EVERY 1 deg INTERVAL +!C.. 10*10 deg AROUND 1ST 1ST GUESS VORTEX CENTER +!C + DO JL=1,IR + WTS= 0. + DO IL=1,IT + DR = JL + DD = (IL-1)*15*RAD + DLON = DR*COS(DD) + DLAT = DR*SIN(DD) + TLON = BLON + DLON + TLAT = BLAT + DLAT +!C.. INTERPOLATION U, V AT TLON,TLAT AND CLACULATE TANGENTIAL WIND + IDX = floor(TLON) - SLON + 1 + IDY = floor(TLAT) - SLAT + 1 + DXX = TLON - floor(TLON) + DYY = TLAT - floor(TLAT) +!C + X1 = UD(IDX ,IDY+1)*DYY + UD(IDX ,IDY)*(1-DYY) + X2 = UD(IDX+1,IDY+1)*DYY + UD(IDX+1,IDY)*(1-DYY) + Y1 = UD(IDX+1,IDY )*DXX + UD(IDX,IDY )*(1-DXX) + Y2 = UD(IDX+1,IDY+1)*DXX + UD(IDX,IDY+1)*(1-DXX) + UT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. + IF(IL.EQ.0.OR.IL.EQ.13) UT = Y1 + IF(IL.EQ.7.OR.IL.EQ.19) UT = X1 +!C + X1 = VD(IDX ,IDY+1)*DYY + VD(IDX ,IDY)*(1-DYY) + X2 = VD(IDX+1,IDY+1)*DYY + VD(IDX+1,IDY)*(1-DYY) + Y1 = VD(IDX+1,IDY )*DXX + VD(IDX,IDY )*(1-DXX) + Y2 = VD(IDX+1,IDY+1)*DXX + VD(IDX,IDY+1)*(1-DXX) + VT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. + IF(IL.EQ.0.OR.IL.EQ.13) VT = Y1 + IF(IL.EQ.7.OR.IL.EQ.19) VT = X1 +!C.. TANGENTIAL WIND + WT = -SIN(DD)*UT + COS(DD)*VT + WTS = WTS+WT + enddo + WTM(JL) = WTS/24. + enddo +!C +!C Southern Hemisphere + IF(CLAT_NEW.LT.0)THEN + DO JL=1,IR + WTM(JL)=-WTM(JL) + END DO + END IF +!C EnD SH + + TX = -10000000. + DO KL = 1,IR + IF(WTM(KL).GE.TX) THEN + TX = WTM(KL) + ENDIF + ENDDO +!C + TNMX(I,J) = TX + ENDDO + ENDDO +!C.. FIND NEW CENTER + TTX = -1000000. + DO I=1,ID + DO J=1,JD + IF(TNMX(I,J).GE.TTX) THEN + TTX = TNMX(I,J) + NIC = I + NJC = J + ENDIF + ENDDO + ENDDO +!C + CLAT_NEW = XLAT + (NJC-1)*DTY + CLON_NEW = XLON + (NIC-1)*DTX +!C + print *,'NEW CENTER, I, J IS ',NIC,NJC + print *,'NEW CENTER, LAT,LON IS ',CLAT_NEW,CLON_NEW + print *,'MAX TAN. WIND AT NEW CENTER IS ',TTX +!C + RETURN + END SUBROUTINE FIND_NEWCT1 + diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/split.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/split.f90 similarity index 50% rename from sorc/hafs_tools.fd/sorc/hafs_vi/split/split.f rename to sorc/hafs_tools.fd/sorc/hafs_vi/split/split.f90 index 25ca6991e..c941cd181 100644 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/split.f +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/split.f90 @@ -1,3 +1,4 @@ + program split !?????????????????????????????????????????????????????????? ! ! ABSTRACT: Split the vortex into environment flow and vortex perturbation @@ -8,15 +9,21 @@ ! ! DECLARE VARIABLES ! + use nhc, only: KSTM,IC_N,JC_N,NST + use nhc1, only: SLON_N,SLAT_N,CLON_N,CLAT_N + use stname,only: ST_NAME,STMNAME + use tcvit, only: TCVT + use rsfc, only: STRPSF,STVMAX,STRPSF_06 + implicit none INTEGER I,J,K,NX,NY,NZ,IBGS,IVOBS INTEGER KK ! REAL(4) DX_R,DY_R,PT,PDTOP,GAMMA - REAL(4) LON1,LAT1,LON2,LAT2,GAMMA + REAL(4) LON1,LAT1,LON2,LAT2 REAL(4) crfactor ! ! PARAMETER (NX=215,NY=431,NZ=42) - PARAMETER (NST=10) - PARAMETER (GAMMA=6.5E-3,G=9.8,GI=1./G,D608=0.608) + real, PARAMETER:: G=9.8,GI=1./G,D608=0.608 + real(4),PARAMETER:: GAMMA=6.5E-3 ! ! Variables on hybrid coordinate @@ -52,21 +59,21 @@ REAL(4),ALLOCATABLE :: UVTQ(:,:,:,:) REAL(4),ALLOCATABLE :: work_1(:),work_2(:) - real(4) SLON_N,SLAT_N,CLON_N,CLAT_N - REAL(4) CENTRAL_LON,CENTRAL_LAT,WBD,SBD - COMMON /NHC/ KSTM,IC_N(NST),JC_N(NST) - COMMON /NHC1/ SLON_N(NST),SLAT_N(NST),CLON_N(NST),CLAT_N(NST) - CHARACTER ST_NAME(NST)*3,STMNAME(NST)*3,TCVT(NST)*95 - COMMON /STNAME/ST_NAME,STMNAME - COMMON /TCVIT/TCVT - COMMON /RSFC/STRPSF(NST),STVMAX(NST),STRPSF_06(NST) integer, external :: omp_get_max_threads integer :: ICLAT,ICLON,CLAT_VIT,CLON_VIT character :: SN,EW + integer KMX,KS850,JCT1,ICT1,NZ1,NY1,NX1,KMAX,I360 + integer KUNIT,IUNIT,IFLAG_COLD,ITIM,N,JPX,IPX,NCHT + integer L,KST + + real COEF3,COEF2,PI,PI_DEG + real SDT,SDIF,PT,PDTOP,PSFX,DTEMP,ES,QS1,QSK,W1,W + real ZSFC,PSFC,TSFC,A,DP1 + 333 format('Have ',I0,' OpenMP threads.') print 333,omp_get_max_threads() ! @@ -99,7 +106,7 @@ ! end if ! For HAFS, I360 is newly defined to handle the storms in eastern/western hemisphere 2022 July IF(EW.eq.'W') I360=180 ! Western hemisphere TC - IF(EW.eq.'E') I360=360 ! Eastern hemisphere TC + IF(EW.eq.'E') I360=360 ! Eastern hemisphere TC READ(IUNIT) NX,NY,NZ @@ -153,39 +160,39 @@ CLOSE(IUNIT) ! - DO J=1,NY - DO I=1,NX - GLON(I,J)=HLON(I,J) ! LON & LAT at T,Q P Z (H) points - GLAT(I,J)=HLAT(I,J) - END DO + DO J=1,NY + DO I=1,NX + GLON(I,J)=HLON(I,J) ! LON & LAT at T,Q P Z (H) points + GLAT(I,J)=HLAT(I,J) END DO + END DO print*,'CENTRAL_LON,CENTRAL_LAT=',CENTRAL_LON,CENTRAL_LAT write(*,*)'K,T1,Q1,U1,V1,Z1,P1=' do k=1,nz - write(*,32)K,T1(9,9,K), - & Q1(9,9,K),U1(9,9,K),V1(9,9,K),Z1(9,9,K),P1(9,9,K) + write(*,32)K,T1(9,9,K), & + Q1(9,9,K),U1(9,9,K),V1(9,9,K),Z1(9,9,K),P1(9,9,K) end do - write(*,*) + write(*,*) ICT1=1+(NX-1)/2 JCT1=1+(NY-1)/2 SDT=1.E20 DO K=1,NZ - SDIF=abs(P1(ICT1,JCT1,K)/P1(ICT1,JCT1,1)-0.85) - IF(SDIF.LT.SDT)THEN - KS850=K - SDT=SDIF - END IF + SDIF=abs(P1(ICT1,JCT1,K)/P1(ICT1,JCT1,1)-0.85) + IF(SDIF.LT.SDT)THEN + KS850=K + SDT=SDIF + END IF END DO DO J=1,NY - DO I=1,NX - US850(I,J)=U1(I,J,KS850) - VS850(I,J)=V1(I,J,KS850) - END DO + DO I=1,NX + US850(I,J)=U1(I,J,KS850) + VS850(I,J)=V1(I,J,KS850) + END DO END DO 32 format(I3,6F12.2) @@ -195,8 +202,8 @@ do k=1,nz1 write(*,*)'K,ETA1,ETA2=',K,ETA1(k),ETA2(k) end do - print*,'CLON,CLAT=',GLON(1+(NX-1)/2,1+(NY-1)/2), - & GLAT(1+(NX-1)/2,1+(NY-1)/2) + print*,'CLON,CLAT=',GLON(1+(NX-1)/2,1+(NY-1)/2), & + GLAT(1+(NX-1)/2,1+(NY-1)/2) ! write(77,33)HLON ! write(77,*) ! write(77,33)HLAT @@ -235,33 +242,33 @@ ! Surface at K=1, top at K=NZ -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k) DO K=1,NZ - DO J=1,NY - DO I=1,NX - TV1(I,J,K)=T1(I,J,K)*(1.+D608*Q1(I,J,K)) - END DO - END DO + DO J=1,NY + DO I=1,NX + TV1(I,J,K)=T1(I,J,K)*(1.+D608*Q1(I,J,K)) + END DO + END DO END DO -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k) DO K=1,NZ - DO J=1,NY - DO I=1,NX - ZM1(I,J,K)=(Z1(I,J,K)+Z1(I,J,K+1))*0.5+ - & 0.5*TV1(I,J,K)/GAMMA*(2.-(P1(I,J,K)/PM1(I,J,K))**COEF3- - & (P1(I,J,K+1)/PM1(I,J,K))**COEF3) -! ZM1(I,J,K)=(Z1(I,J,K)+Z1(I,J,K+1))*0.5 -! PM1(I,J,K)=EXP((ALOG(1.*P1(I,J,K))+ALOG(1.*P1(I,J,K+1)))*0.5) - END DO - END DO + DO J=1,NY + DO I=1,NX + ZM1(I,J,K)=(Z1(I,J,K)+Z1(I,J,K+1))*0.5+ & + 0.5*TV1(I,J,K)/GAMMA*(2.-(P1(I,J,K)/PM1(I,J,K))**COEF3- & + (P1(I,J,K+1)/PM1(I,J,K))**COEF3) +! ZM1(I,J,K)=(Z1(I,J,K)+Z1(I,J,K+1))*0.5 +! PM1(I,J,K)=EXP((ALOG(1.*P1(I,J,K))+ALOG(1.*P1(I,J,K+1)))*0.5) + END DO + END DO END DO ZMV1=ZM1 PMV1=PM1 -!!$omp parallel do +!!$omp parallel do & !1$omp& private(i,j,k) ! DO J=2,NY-1 ! IF(MOD(J,2).NE.0.)THEN @@ -286,12 +293,12 @@ ! END DO DO J=1,NY - DO I=1,NX - TMV1(I,J)=TV1(I,J,1) - END DO + DO I=1,NX + TMV1(I,J)=TV1(I,J,1) + END DO END DO ! K=1 -!!$omp parallel do +!!$omp parallel do & !!$omp& private(i,j) ! DO J=2,NY-1 ! IF(MOD(J,2).NE.0.)THEN @@ -311,13 +318,13 @@ ! MAX Surface P PSFX=0. DO J=1,NY - DO I=1,NX - IF(PSFX.LT.P1(I,J,1))THEN - PSFX=P1(I,J,1) - IPX=I - JPX=J - END IF - END DO + DO I=1,NX + IF(PSFX.LT.P1(I,J,1))THEN + PSFX=P1(I,J,1) + IPX=I + JPX=J + END IF + END DO END DO PRINT*,'IPX,JPX,PSFX=',IPX,JPX,PSFX @@ -342,33 +349,33 @@ END DO ! Height at P2 grids -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,n) DO J=1,NY - DO I=1,NX - CYC_10: DO K=1,KMX - IF(P2(K).GE.PM1(I,J,1))THEN - HP(I,J,K)=ZM1(I,J,1)+ - & TV1(I,J,1)/GAMMA*(1.-(P2(K)/PM1(I,J,1))**COEF3) - ELSE IF(P2(K).LE.PM1(I,J,NZ))THEN - HP(I,J,K)=ZM1(I,J,NZ)+ - & TV1(I,J,NZ)/GAMMA*(1.-(P2(K)/PM1(I,J,NZ))**COEF3) - ELSE - DO N=1,NZ-1 - IF(P2(K).LE.PM1(I,J,N).and.P2(K).GT.PM1(I,J,N+1))THEN - HP(I,J,K)=ZM1(I,J,N)+ - & TV1(I,J,N)/GAMMA*(1.-(P2(K)/PM1(I,J,N))**COEF3) - CYCLE CYC_10 + DO I=1,NX + CYC_10: DO K=1,KMX + IF(P2(K).GE.PM1(I,J,1))THEN + HP(I,J,K)=ZM1(I,J,1)+ & + TV1(I,J,1)/GAMMA*(1.-(P2(K)/PM1(I,J,1))**COEF3) + ELSE IF(P2(K).LE.PM1(I,J,NZ))THEN + HP(I,J,K)=ZM1(I,J,NZ)+ & + TV1(I,J,NZ)/GAMMA*(1.-(P2(K)/PM1(I,J,NZ))**COEF3) + ELSE + DO N=1,NZ-1 + IF(P2(K).LE.PM1(I,J,N).and.P2(K).GT.PM1(I,J,N+1))THEN + HP(I,J,K)=ZM1(I,J,N)+ & + TV1(I,J,N)/GAMMA*(1.-(P2(K)/PM1(I,J,N))**COEF3) + CYCLE CYC_10 + END IF + END DO END IF - END DO - END IF - END DO CYC_10 - END DO + END DO CYC_10 + END DO END DO HV=HP -!!$omp parallel do +!!$omp parallel do & !!$omp& private(i,j,k) ! DO J=2,NY-1 ! IF(MOD(J,2).NE.0.)THEN @@ -389,85 +396,85 @@ ! END DO K=1 -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,DTEMP,ES,QS1) DO J=1,NY - DO I=1,NX - DTEMP=T1(I,J,K)-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - QS1=0.622*ES/(PM1(I,J,K)-0.378*ES) - RH(I,J)=MIN(MAX(Q1(I,J,K)/QS1,0.),1.0) -! IF(I*J.LT.20)print*,'ES,PM1=',I,J,ES,PM1(I,J,K),QS1,RH(I,J) - END DO + DO I=1,NX + DTEMP=T1(I,J,K)-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + QS1=0.622*ES/(PM1(I,J,K)-0.378*ES) + RH(I,J)=MIN(MAX(Q1(I,J,K)/QS1,0.),1.0) +! IF(I*J.LT.20)print*,'ES,PM1=',I,J,ES,PM1(I,J,K),QS1,RH(I,J) + END DO END DO ! Iterpolation to constant P -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,N,DTEMP,ES,QSK,W1,W) DO J=1,NY - DO I=1,NX - CYC_12: DO K=1,KMX - IF(P2(K).GE.PM1(I,J,1))THEN ! Below PM1(I,J,1) - T2(I,J,K)=T1(I,J,1)-GAMMA*(HP(I,J,K)-ZM1(I,J,1)) - DTEMP=T2(I,J,K)-273.15 - ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) - QSK=0.622*ES/(P2(K)-0.378*ES) - Q2(I,J,K)=RH(I,J)*QSK ! constant RH below Nz=1 - ELSE IF(P2(K).LE.PM1(I,J,NZ))THEN - T2(I,J,K)=T1(I,J,NZ)-GAMMA*(HP(I,J,K)-ZM1(I,J,NZ)) - Q2(I,J,K)=Q1(I,J,NZ) ! very small - ELSE - DO N=1,NZ-1 - IF(P2(K).LE.PM1(I,J,N).and.P2(K).GT.PM1(I,J,N+1))THEN - W1=ALOG(1.*PM1(I,J,N+1))-ALOG(1.*PM1(I,J,N)) - W=(ALOG(1.*P2(K))-ALOG(1.*PM1(I,J,N)))/W1 - T2(I,J,K)=T1(I,J,N)+(T1(I,J,N+1)-T1(I,J,N))*W - Q2(I,J,K)=Q1(I,J,N)+(Q1(I,J,N+1)-Q1(I,J,N))*W - CYCLE CYC_12 - END IF - END DO - END IF - END DO CYC_12 - END DO + DO I=1,NX + CYC_12: DO K=1,KMX + IF(P2(K).GE.PM1(I,J,1))THEN ! Below PM1(I,J,1) + T2(I,J,K)=T1(I,J,1)-GAMMA*(HP(I,J,K)-ZM1(I,J,1)) + DTEMP=T2(I,J,K)-273.15 + ES=611.2*EXP(17.67*DTEMP/(DTEMP+243.5)) + QSK=0.622*ES/(P2(K)-0.378*ES) + Q2(I,J,K)=RH(I,J)*QSK ! constant RH below Nz=1 + ELSE IF(P2(K).LE.PM1(I,J,NZ))THEN + T2(I,J,K)=T1(I,J,NZ)-GAMMA*(HP(I,J,K)-ZM1(I,J,NZ)) + Q2(I,J,K)=Q1(I,J,NZ) ! very small + ELSE + DO N=1,NZ-1 + IF(P2(K).LE.PM1(I,J,N).and.P2(K).GT.PM1(I,J,N+1))THEN + W1=ALOG(1.*PM1(I,J,N+1))-ALOG(1.*PM1(I,J,N)) + W=(ALOG(1.*P2(K))-ALOG(1.*PM1(I,J,N)))/W1 + T2(I,J,K)=T1(I,J,N)+(T1(I,J,N+1)-T1(I,J,N))*W + Q2(I,J,K)=Q1(I,J,N)+(Q1(I,J,N+1)-Q1(I,J,N))*W + CYCLE CYC_12 + END IF + END DO + END IF + END DO CYC_12 + END DO END DO -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,N,W1,W) DO J=1,NY - DO I=1,NX - CYC_14: DO K=1,KMX - IF(P2(K).GE.PMV1(I,J,1))THEN ! Below PMV1(I,J,1) -! U2(I,J,K)=U1(I,J,1)*(1.-(P2(K)-PMV1(I,J,1))*1.4E-5) -! V2(I,J,K)=V1(I,J,1)*(1.-(P2(K)-PMV1(I,J,1))*1.4E-5) - U2(I,J,K)=U1(I,J,1) - V2(I,J,K)=V1(I,J,1) - ELSE IF(P2(K).LE.PMV1(I,J,NZ))THEN - U2(I,J,K)=U1(I,J,NZ) - V2(I,J,K)=V1(I,J,NZ) - ELSE - DO N=1,NZ-1 - IF(P2(K).LE.PMV1(I,J,N).and.P2(K).GT.PMV1(I,J,N+1))THEN - W1=ALOG(1.*PMV1(I,J,N+1))-ALOG(1.*PMV1(I,J,N)) - W=(ALOG(1.*P2(K))-ALOG(1.*PMV1(I,J,N)))/W1 - U2(I,J,K)=U1(I,J,N)+(U1(I,J,N+1)-U1(I,J,N))*W - V2(I,J,K)=V1(I,J,N)+(V1(I,J,N+1)-V1(I,J,N))*W - CYCLE CYC_14 - END IF - END DO - END IF - END DO CYC_14 - END DO + DO I=1,NX + CYC_14: DO K=1,KMX + IF(P2(K).GE.PMV1(I,J,1))THEN ! Below PMV1(I,J,1) +! U2(I,J,K)=U1(I,J,1)*(1.-(P2(K)-PMV1(I,J,1))*1.4E-5) +! V2(I,J,K)=V1(I,J,1)*(1.-(P2(K)-PMV1(I,J,1))*1.4E-5) + U2(I,J,K)=U1(I,J,1) + V2(I,J,K)=V1(I,J,1) + ELSE IF(P2(K).LE.PMV1(I,J,NZ))THEN + U2(I,J,K)=U1(I,J,NZ) + V2(I,J,K)=V1(I,J,NZ) + ELSE + DO N=1,NZ-1 + IF(P2(K).LE.PMV1(I,J,N).and.P2(K).GT.PMV1(I,J,N+1))THEN + W1=ALOG(1.*PMV1(I,J,N+1))-ALOG(1.*PMV1(I,J,N)) + W=(ALOG(1.*P2(K))-ALOG(1.*PMV1(I,J,N)))/W1 + U2(I,J,K)=U1(I,J,N)+(U1(I,J,N+1)-U1(I,J,N))*W + V2(I,J,K)=V1(I,J,N)+(V1(I,J,N+1)-V1(I,J,N))*W + CYCLE CYC_14 + END IF + END DO + END IF + END DO CYC_14 + END DO END DO write(*,*)'IPX,JPX,PSFX=',IPX,JPX,PSFX do k=1,kmx write(*,*)'K,P2,SIG=',K,P2(K),SIG(K) end do - write(*,*) - write(*,*)'K,T2,Q2,U2,V2,Z2,P2=' + write(*,*) + write(*,*)'K,T2,Q2,U2,V2,Z2,P2=' do k=1,kmx - write(*,32)K,T2(9,9,K), - & Q2(9,9,K),U2(9,9,K),V2(9,9,K),HP(9,9,K),P2(K) + write(*,32)K,T2(9,9,K), & + Q2(9,9,K),U2(9,9,K),V2(9,9,K),HP(9,9,K),P2(K) end do ! DO K=1,KMX @@ -480,72 +487,72 @@ ! save for later use DO J=1,NY - DO I=1,NX - DO K=1,KMX - UVTQ(I,J,K,1)=U2(I,J,K) - UVTQ(I,J,K,2)=V2(I,J,K) - UVTQ(I,J,K,3)=T2(I,J,K) - UVTQ(I,J,K,4)=Q2(I,J,K) - END DO - END DO + DO I=1,NX + DO K=1,KMX + UVTQ(I,J,K,1)=U2(I,J,K) + UVTQ(I,J,K,2)=V2(I,J,K) + UVTQ(I,J,K,3)=T2(I,J,K) + UVTQ(I,J,K,4)=Q2(I,J,K) + END DO + END DO END DO !C MSLP: LOOP OVER HORIZONTAL GRID. !C - DO J=1,NY - DO I=1,NX - ZSFC = Z1(I,J,1) - PSFC = P1(I,J,1) - TSFC = TV1(I,J,1)+GAMMA*(ZM1(I,J,1)-Z1(I,J,1)) + DO J=1,NY + DO I=1,NX + ZSFC = Z1(I,J,1) + PSFC = P1(I,J,1) + TSFC = TV1(I,J,1)+GAMMA*(ZM1(I,J,1)-Z1(I,J,1)) !C -!C COMPUTE SEA LEVEL PRESSURE. - A = (GAMMA * ZSFC) / TSFC - SLP(I,J) = PSFC*(1+A)**COEF2 - Z2(I,J)=Z1(I,J,1) - ENDDO +!C COMPUTE SEA LEVEL PRESSURE. + A = (GAMMA * ZSFC) / TSFC + SLP(I,J) = PSFC*(1+A)**COEF2 + Z2(I,J)=Z1(I,J,1) + ENDDO ENDDO - print*,'call before HURR_MESS' + print*,'call before HURR_MESS' - CALL HURR_MESS(ITIM,IBGS,NX,NY,GLON,GLAT,I360) + CALL HURR_MESS(ITIM,IBGS,NX,NY,GLON,GLAT,I360) - print*,'call after HURR_MESS' + print*,'call after HURR_MESS' - NCHT=71 - WRITE(NCHT)KSTM + NCHT=71 + WRITE(NCHT)KSTM - WRITE(NCHT)HLAT,HLON - WRITE(NCHT)VLAT,VLON + WRITE(NCHT)HLAT,HLON + WRITE(NCHT)VLAT,VLON - WRITE(NCHT)P2 - WRITE(NCHT)HP + WRITE(NCHT)P2 + WRITE(NCHT)HP !C Relocate Hurricane ! DO KST=1,KSTM - DO KST=1,1 + DO KST=1,1 - print*,'KST=',KST + print*,'KST=',KST - CALL wrf_move(ITIM,KST,GLON,GLAT,US850,VS850, - & KS850,P2, - & Z2,T2,Q2,U2,V2,SLP,SIG,HLAT,HLON,VLAT,VLON, - & KMX,1,NX,1,NY,IBGS,IVOBS,iflag_cold,I360,crfactor) + CALL wrf_move(ITIM,KST,GLON,GLAT,US850,VS850, & + KS850,P2, & + Z2,T2,Q2,U2,V2,SLP,SIG,HLAT,HLON,VLAT,VLON, & + KMX,1,NX,1,NY,IBGS,IVOBS,iflag_cold,I360,crfactor) - END DO + END DO - print*,'test7' + print*,'test7' - DO J=1,NY - DO I=1,NX - ZSFC = Z1(I,J,1) - TSFC = T2(I,J,1)*(1.+D608*Q2(I,J,1)) - A = (GAMMA * ZSFC) / TSFC - P1(I,J,1) = SLP(I,J)*(1-A)**COEF2 - PD(I,J)=P1(I,J,1) - ENDDO + DO J=1,NY + DO I=1,NX + ZSFC = Z1(I,J,1) + TSFC = T2(I,J,1)*(1.+D608*Q2(I,J,1)) + A = (GAMMA * ZSFC) / TSFC + P1(I,J,1) = SLP(I,J)*(1-A)**COEF2 + PD(I,J)=P1(I,J,1) + ENDDO ENDDO @@ -566,17 +573,17 @@ deallocate (work_1,work_2) do j = 1,ny - do i = 1,nx -! Z1(I,J,1)=ZS1(I,J) - DO L=2,nz+1 - Z1(I,J,L)=Z1(I,J,L-1)+T1(I,J,L-1)* - & (Q1(I,J,L-1)*0.608+1.0)*287.04* - & (ALOG(1.*P1(I,J,L-1))-ALOG(1.*P1(I,J,L)))/G + do i = 1,nx +! Z1(I,J,1)=ZS1(I,J) + DO L=2,nz+1 + Z1(I,J,L)=Z1(I,J,L-1)+T1(I,J,L-1)* & + (Q1(I,J,L-1)*0.608+1.0)*287.04* & + (ALOG(1.*P1(I,J,L-1))-ALOG(1.*P1(I,J,L)))/G + ENDDO ENDDO - ENDDO END DO - print*,'test8' + print*,'test8' ! PD(I,J)=P1(I,J,1)-PDTOP-PT=PSFC(I,J)-PDTOP-PT ! DO K=1,NZ+1 @@ -600,14 +607,14 @@ ! CONVERT OTHER VARIABLES TO Hybrid Coordinate from Constant P DO J=1,NY - DO I=1,NX - DO K=1,KMX - UVTQ(I,J,K,1)=U2(I,J,K)-UVTQ(I,J,K,1) - UVTQ(I,J,K,2)=V2(I,J,K)-UVTQ(I,J,K,2) - UVTQ(I,J,K,3)=T2(I,J,K)-UVTQ(I,J,K,3) - UVTQ(I,J,K,4)=Q2(I,J,K)-UVTQ(I,J,K,4) - END DO - END DO + DO I=1,NX + DO K=1,KMX + UVTQ(I,J,K,1)=U2(I,J,K)-UVTQ(I,J,K,1) + UVTQ(I,J,K,2)=V2(I,J,K)-UVTQ(I,J,K,2) + UVTQ(I,J,K,3)=T2(I,J,K)-UVTQ(I,J,K,3) + UVTQ(I,J,K,4)=Q2(I,J,K)-UVTQ(I,J,K,4) + END DO + END DO END DO ! DO K=1,KMX @@ -617,63 +624,61 @@ ! WRITE(82)((V2(I,J,K),I=1,NX),J=1,NY,2) ! END DO -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,N,W1,W) DO J=1,NY - DO I=1,NX - DO N=1,NZ - IF(PM1(I,J,N).GE.P2(1))THEN ! Below PM1(I,J,1) - T1(I,J,N)=T1(I,J,N)+UVTQ(I,J,1,3) - Q1(I,J,N)=Q1(I,J,N)+UVTQ(I,J,1,4) - ELSE IF(PM1(I,J,N).LE.P2(KMX))THEN - T1(I,J,N)=T1(I,J,N)+UVTQ(I,J,KMX,3) - Q1(I,J,N)=Q1(I,J,N)+UVTQ(I,J,KMX,4) - ELSE - DO K=1,KMX-1 - IF(PM1(I,J,N).LE.P2(K).and.PM1(I,J,N).GT.P2(K+1))THEN - W1=ALOG(1.*P2(K+1))-ALOG(1.*P2(K)) - W=(ALOG(1.*PM1(I,J,N))-ALOG(1.*P2(K)))/W1 - T1(I,J,N)=T1(I,J,N)+UVTQ(I,J,K,3)+ - & (UVTQ(I,J,K+1,3)-UVTQ(I,J,K,3))*W - Q1(I,J,N)=Q1(I,J,N)+UVTQ(I,J,K,4)+ - & (UVTQ(I,J,K+1,4)-UVTQ(I,J,K,4))*W - GO TO 22 - END IF - END DO - END IF - 22 CONTINUE + DO I=1,NX + nloop: DO N=1,NZ + IF(PM1(I,J,N).GE.P2(1))THEN ! Below PM1(I,J,1) + T1(I,J,N)=T1(I,J,N)+UVTQ(I,J,1,3) + Q1(I,J,N)=Q1(I,J,N)+UVTQ(I,J,1,4) + ELSE IF(PM1(I,J,N).LE.P2(KMX))THEN + T1(I,J,N)=T1(I,J,N)+UVTQ(I,J,KMX,3) + Q1(I,J,N)=Q1(I,J,N)+UVTQ(I,J,KMX,4) + ELSE + DO K=1,KMX-1 + IF(PM1(I,J,N).LE.P2(K).and.PM1(I,J,N).GT.P2(K+1))THEN + W1=ALOG(1.*P2(K+1))-ALOG(1.*P2(K)) + W=(ALOG(1.*PM1(I,J,N))-ALOG(1.*P2(K)))/W1 + T1(I,J,N)=T1(I,J,N)+UVTQ(I,J,K,3)+ & + (UVTQ(I,J,K+1,3)-UVTQ(I,J,K,3))*W + Q1(I,J,N)=Q1(I,J,N)+UVTQ(I,J,K,4)+ & + (UVTQ(I,J,K+1,4)-UVTQ(I,J,K,4))*W + cycle nloop + END IF + END DO + END IF + END DO nloop END DO END DO - END DO -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,N,W1,W) DO J=1,NY - DO I=1,NX - DO N=1,NZ - IF(PMV1(I,J,N).GE.P2(1))THEN ! Below PMV1(I,J,1) - U1(I,J,N)=U1(I,J,N)+UVTQ(I,J,1,1) - V1(I,J,N)=V1(I,J,N)+UVTQ(I,J,1,2) - ELSE IF(PMV1(I,J,N).LE.P2(KMX))THEN - U1(I,J,N)=U1(I,J,N)+UVTQ(I,J,KMX,1) - V1(I,J,N)=V1(I,J,N)+UVTQ(I,J,KMX,2) - ELSE - DO K=1,KMX-1 - IF(PMV1(I,J,N).LE.P2(K).and.PMV1(I,J,N).GT.P2(K+1))THEN - W1=ALOG(1.*P2(K+1))-ALOG(1.*P2(K)) - W=(ALOG(1.*PMV1(I,J,N))-ALOG(1.*P2(K)))/W1 - U1(I,J,N)=U1(I,J,N)+UVTQ(I,J,K,1)+ - & (UVTQ(I,J,K+1,1)-UVTQ(I,J,K,1))*W - V1(I,J,N)=V1(I,J,N)+UVTQ(I,J,K,2)+ - & (UVTQ(I,J,K+1,2)-UVTQ(I,J,K,2))*W - GO TO 24 - END IF - END DO - END IF - 24 CONTINUE + DO I=1,NX + nloop1: DO N=1,NZ + IF(PMV1(I,J,N).GE.P2(1))THEN ! Below PMV1(I,J,1) + U1(I,J,N)=U1(I,J,N)+UVTQ(I,J,1,1) + V1(I,J,N)=V1(I,J,N)+UVTQ(I,J,1,2) + ELSE IF(PMV1(I,J,N).LE.P2(KMX))THEN + U1(I,J,N)=U1(I,J,N)+UVTQ(I,J,KMX,1) + V1(I,J,N)=V1(I,J,N)+UVTQ(I,J,KMX,2) + ELSE + DO K=1,KMX-1 + IF(PMV1(I,J,N).LE.P2(K).and.PMV1(I,J,N).GT.P2(K+1))THEN + W1=ALOG(1.*P2(K+1))-ALOG(1.*P2(K)) + W=(ALOG(1.*PMV1(I,J,N))-ALOG(1.*P2(K)))/W1 + U1(I,J,N)=U1(I,J,N)+UVTQ(I,J,K,1)+ & + (UVTQ(I,J,K+1,1)-UVTQ(I,J,K,1))*W + V1(I,J,N)=V1(I,J,N)+UVTQ(I,J,K,2)+ & + (UVTQ(I,J,K+1,2)-UVTQ(I,J,K,2))*W + cycle nloop1 + END IF + END DO + END IF + END DO nloop1 END DO END DO - END DO DO K=1,NZ+1 WRITE(61)((Z1(I,J,K),I=1,NX),J=1,NY,2) @@ -697,17 +702,17 @@ ! Compute USC and VSC at Z=0 DO J=1,NY - DO I=1,NX - IF(ZMV1(I,J,1).LT.0.)THEN ! Below SEA LEVEL - USC(I,J)=U1(I,J,1) - VSC(I,J)=V1(I,J,1) - ELSE -! DP1=PMV1(I,J,1)*((1.+GAMMA*ZMV1(I,J,1)/TMV1(I,J))**COEF2-1.) - DP1=0. - USC(I,J)=U1(I,J,1)*(1.-DP1*1.4E-5) - VSC(I,J)=V1(I,J,1)*(1.-DP1*1.4E-5) - END IF - END DO + DO I=1,NX + IF(ZMV1(I,J,1).LT.0.)THEN ! Below SEA LEVEL + USC(I,J)=U1(I,J,1) + VSC(I,J)=V1(I,J,1) + ELSE +! DP1=PMV1(I,J,1)*((1.+GAMMA*ZMV1(I,J,1)/TMV1(I,J))**COEF2-1.) + DP1=0. + USC(I,J)=U1(I,J,1)*(1.-DP1*1.4E-5) + VSC(I,J)=V1(I,J,1)*(1.-DP1*1.4E-5) + END IF + END DO END DO rewind KUNIT @@ -746,48 +751,57 @@ !C END OF ROUTINE. !C ! RETURN - END + END program split - SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, - & I360) + SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT,I360) ! all common blocks are output + use nhc, only: KSTM,IC_N,JC_N, NST + use nhc1, only: SLON_N,SLAT_N,CLON_N,CLAT_N + use stname,only: ST_NAME,STMNAME + use tcvit, only: TCVT + use rsfc, only: STRPSF,STVMAX,STRPSF_06 - PARAMETER (IRX=41,JRX=41,NST=10) - PARAMETER (MAXVIT=15) + implicit none + integer,PARAMETER:: IRX=41,JRX=41 + integer,PARAMETER:: MAXVIT=15 REAL(4) GLAT(IMAX,JMAX),GLON(IMAX,JMAX) - real(4) SLON_N,SLAT_N,CLON_N,CLAT_N - COMMON /NHC/ KSTM,IC_N(NST),JC_N(NST) - COMMON /NHC1/ SLON_N(NST),SLAT_N(NST),CLON_N(NST),CLAT_N(NST) DIMENSION STMDIR(NST),STMSPD(NST) - CHARACTER ST_NAME(NST)*3,STMNAME(NST)*3,TCVT(NST)*95 - COMMON /STNAME/ST_NAME,STMNAME - COMMON /TCVIT/TCVT - COMMON /RSFC/STRPSF(NST),STVMAX(NST),STRPSF_06(NST) - CHARACTER BUFIN(95)*1,BUFY2K(95)*1,STMNAM(NST)*12,STMNMZ*9 CHARACTER FMTVIT(MAXVIT)*6,BUFINZ*100,LATNS*1,LONEW*1 - DIMENSION IVTVAR(MAXVIT),VITVAR(MAXVIT),VITFAC(MAXVIT), - & ISTVAR(MAXVIT),IENVAR(MAXVIT) + DIMENSION IVTVAR(MAXVIT),VITVAR(MAXVIT),VITFAC(MAXVIT) + DIMENSION ISTVAR(MAXVIT),IENVAR(MAXVIT) DIMENSION ISTMCX1(7,NST),ISTMCY1(7,NST),STMCX(NST),STMCY(NST) + real VITFAC + real VITVAR DATA ISTVAR/20,29,34,39,45,49,53,58,63,68,71,75,80,85,90/ DATA IENVAR/27,32,36,42,47,51,56,61,66,69,73,78,83,88,93/ DATA VITFAC/2*1.0,2*0.1,1.0,0.1,9*1.0/ - DATA FMTVIT/'(I8.8)','(I4.4)','(I3.3)','(I4.4)',2*'(I3.3)', - & 3*'(I4.4)','(I2.2)','(I3.3)',4*'(I4.4)'/ + DATA FMTVIT/'(I8.8)','(I4.4)','(I3.3)','(I4.4)',2*'(I3.3)', & + 3*'(I4.4)','(I2.2)','(I3.3)',4*'(I4.4)'/ - EQUIVALENCE (BUFIN(37),LATNS),(BUFIN(43),LONEW), - & (BUFIN(10),STMNMZ),(BUFIN(1),BUFINZ) + integer ISTMCY1,ISTMCX1,IDATEZ,IUTCZ,IVTVAR,IENVAR,ISTVAR + + EQUIVALENCE (BUFIN(37),LATNS),(BUFIN(43),LONEW), & + (BUFIN(10),STMNMZ),(BUFIN(1),BUFINZ) EQUIVALENCE (IVTVAR(1),IDATEZ),(IVTVAR(2),IUTCZ) ! - EQUIVALENCE (VITVAR( 3),STMLTZ),(VITVAR( 4),STMLNZ), - & (VITVAR( 5),STMDRZ),(VITVAR( 6),STMSPZ), - 1 (VITVAR( 9),RMPSFZ),(VITVAR(10),STMVMX) + EQUIVALENCE (VITVAR( 3),STMLTZ),(VITVAR( 4),STMLNZ), & + (VITVAR( 5),STMDRZ),(VITVAR( 6),STMSPZ), & + (VITVAR( 9),RMPSFZ),(VITVAR(10),STMVMX) + + integer i,j,k,INDX1,iv,nch,i360,itim,K1STM + integer NERROR,KSTORM,KREC,ILA,ILO,IFWRT,imax,jmax,ic,jc + integer IBGS,IERDEC + real DXM1,DYM1,DXP1,DYP1,PI,PI180,DT,ONEDEG,FACT,AMN + real CLAT,CLON,VSTM,USTM,STMCX,STMCY,DMN,OMN,DISTC + real YDIST6H,XDIST6H,STMSPD,STMDIR,STMCY21,STMCX21,STMVMX + real STMDRZ,STMSPZ,STMLTZ,RMPSFZ,STMLNZ ! DO I=1,10 SLON_N(I)=0. @@ -810,47 +824,46 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, STMCX(I)=0. STMCY(I)=0. STMNAME(I)='NUL' - READ(30,442,end=436) - & (ISTMCY1(J,I),ISTMCX1(J,I),J=1,7),STMNAME(I) + READ(30,442,end=436)(ISTMCY1(J,I),ISTMCX1(J,I),J=1,7),STMNAME(I) ! Western hemisphere TCs, converts longitude into negative value - if(I360.eq.180)then - do j=1,7 - ISTMCX1(J,I)=-ISTMCX1(J,I) - end do - endif -!wpac if(I360.eq.180)then -!wpac do j=1,7 -!wpac IF(ISTMCX1(J,I).LT.-1800) -!wpac & ISTMCX1(J,I)=3600+ISTMCX1(J,I) -!wpac end do -!wpac end if - DYM1=0. - DXM1=0. - DYP1=0. - DXP1=0. - IF(ISTMCY1(1,I)*ISTMCY1(4,I).NE.0)THEN - DYM1=(ISTMCY1(4,I)-ISTMCY1(1,I))/3. - DXM1=(ISTMCX1(4,I)-ISTMCX1(1,I))/3. - END IF - IF(ISTMCY1(4,I)*ISTMCY1(7,I).NE.0)THEN - DYP1=(ISTMCY1(7,I)-ISTMCY1(4,I))/3. - DXP1=(ISTMCX1(7,I)-ISTMCX1(4,I))/3. - END IF - IF( ISTMCY1(2,I) == 999) ISTMCY1(2,I)=ISTMCY1(4,I)-DYM1*2. - IF( ISTMCY1(3,I) == 999) ISTMCY1(3,I)=ISTMCY1(4,I)-DYM1*1. - IF( ISTMCX1(2,I) == 999) ISTMCX1(2,I)=ISTMCX1(4,I)-DXM1*2. - IF( ISTMCX1(3,I) == 999) ISTMCX1(3,I)=ISTMCX1(4,I)-DXM1*1. - IF( ISTMCY1(5,I) == 999) ISTMCY1(5,I)=ISTMCY1(4,I)+DYP1*1. - IF( ISTMCY1(6,I) == 999) ISTMCY1(6,I)=ISTMCY1(4,I)+DYP1*2. - IF( ISTMCX1(5,I) == 999) ISTMCX1(5,I)=ISTMCX1(4,I)+DXP1*1 - IF( ISTMCX1(6,I) == 999) ISTMCX1(6,I)=ISTMCX1(4,I)+DXP1*2 + if(I360.eq.180)then + do j=1,7 + ISTMCX1(J,I)=-ISTMCX1(J,I) + end do + endif +!wpac if(I360.eq.180)then +!wpac do j=1,7 +!wpac IF(ISTMCX1(J,I).LT.-1800) +!wpac & ISTMCX1(J,I)=3600+ISTMCX1(J,I) +!wpac end do +!wpac end if + DYM1=0. + DXM1=0. + DYP1=0. + DXP1=0. + IF(ISTMCY1(1,I)*ISTMCY1(4,I).NE.0)THEN + DYM1=(ISTMCY1(4,I)-ISTMCY1(1,I))/3. + DXM1=(ISTMCX1(4,I)-ISTMCX1(1,I))/3. + END IF + IF(ISTMCY1(4,I)*ISTMCY1(7,I).NE.0)THEN + DYP1=(ISTMCY1(7,I)-ISTMCY1(4,I))/3. + DXP1=(ISTMCX1(7,I)-ISTMCX1(4,I))/3. + END IF + IF( ISTMCY1(2,I) == 999) ISTMCY1(2,I)=ISTMCY1(4,I)-DYM1*2. + IF( ISTMCY1(3,I) == 999) ISTMCY1(3,I)=ISTMCY1(4,I)-DYM1*1. + IF( ISTMCX1(2,I) == 999) ISTMCX1(2,I)=ISTMCX1(4,I)-DXM1*2. + IF( ISTMCX1(3,I) == 999) ISTMCX1(3,I)=ISTMCX1(4,I)-DXM1*1. + IF( ISTMCY1(5,I) == 999) ISTMCY1(5,I)=ISTMCY1(4,I)+DYP1*1. + IF( ISTMCY1(6,I) == 999) ISTMCY1(6,I)=ISTMCY1(4,I)+DYP1*2. + IF( ISTMCX1(5,I) == 999) ISTMCX1(5,I)=ISTMCX1(4,I)+DXP1*1 + IF( ISTMCX1(6,I) == 999) ISTMCX1(6,I)=ISTMCX1(4,I)+DXP1*2 ! -! STMCX(I)=360.-ISTMCX1(INDX1,I)*0.1 - STMCX(I)=ISTMCX1(INDX1,I)*0.1 - STMCY(I)=ISTMCY1(INDX1,I)*0.1 - K1STM=K1STM+1 - PRINT*,' CT STORM Model CENTER at ',ITIM,'h = ', - & STMNAME(I),STMCX(I),STMCY(I) +! STMCX(I)=360.-ISTMCX1(INDX1,I)*0.1 + STMCX(I)=ISTMCX1(INDX1,I)*0.1 + STMCY(I)=ISTMCY1(INDX1,I)*0.1 + K1STM=K1STM+1 + PRINT*,' CT STORM Model CENTER at ',ITIM,'h = ', & + STMNAME(I),STMCX(I),STMCY(I) END DO 442 FORMAT(14x,14i5,25x,A3) 436 CONTINUE @@ -866,48 +879,47 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, ! READ A RECORD INTO BUFFER - 100 CONTINUE + readcyc: do READ(11,101,ERR=990,END=200) (BUFIN(NCH),NCH=1,95) 101 FORMAT(95A1) if(BUFIN(35).eq.'N' .or. BUFIN(35).eq.'S') then - print *, ' ' - print *, '==> Read in RECORD from tcvitals file -- contains a', - & ' 2-digit year "' - print *, ' ' - - BUFY2K(1:19) = BUFIN(1:19) - IF(BUFIN(20)//BUFIN(21).GT.'20') THEN - BUFY2K(20) = '1' - BUFY2K(21) = '9' - ELSE - BUFY2K(20) = '2' - BUFY2K(21) = '0' - ENDIF - BUFY2K(22:95) = BUFIN(20:93) - BUFIN = BUFY2K - - print *, ' ' - print *, '==> 2-digit year converted to 4-digit year "' - print *, ' ' + print *, ' ' + print *, '==> Read in RECORD from tcvitals file -- contains a', & + ' 2-digit year "' + print *, ' ' + + BUFY2K(1:19) = BUFIN(1:19) + IF(BUFIN(20)//BUFIN(21).GT.'20') THEN + BUFY2K(20) = '1' + BUFY2K(21) = '9' + ELSE + BUFY2K(20) = '2' + BUFY2K(21) = '0' + ENDIF + BUFY2K(22:95) = BUFIN(20:93) + BUFIN = BUFY2K + + print *, ' ' + print *, '==> 2-digit year converted to 4-digit year "' + print *, ' ' else if(BUFIN(37).eq.'N' .or. BUFIN(37).eq.'S') then - print *, ' ' - print *, '==> Read in RECORD from tcvitals file -- contains a', - & ' 4-digit year "' - print *, ' ' + print *, ' ' + print *, '==> Read in RECORD from tcvitals file -- contains a', & + ' 4-digit year "' + print *, ' ' else - print *, ' ' - print *, '***** Cannot determine if this record contains ', - & 'a 2-digit year or a 4-digit year - skip it and try reading ', - & 'the next record' - print *, ' ' - go to 100 - + print *, ' ' + print *, '***** Cannot determine if this record contains ',& + 'a 2-digit year or a 4-digit year - skip it and try reading',& + 'the next record' + print *, ' ' + cycle readcyc end if KREC=KREC+1 @@ -921,17 +933,16 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, ! DECODE DATE AND TIME - DO 110 IV=1,2 - CALL DECVAR(ISTVAR(IV),IENVAR(IV),IVTVAR(IV),IERDEC, - & FMTVIT(IV),BUFINZ) - - 110 CONTINUE + do iv=1,2 + CALL DECVAR(ISTVAR(IV),IENVAR(IV),IVTVAR(IV),IERDEC, & + FMTVIT(IV),BUFINZ) + enddo - DO 140 IV=3,MAXVIT - CALL DECVAR(ISTVAR(IV),IENVAR(IV),IVTVAR(IV),IERDEC, - & FMTVIT(IV),BUFINZ) - VITVAR(IV)=REAL(IVTVAR(IV))*VITFAC(IV) - 140 CONTINUE + do IV=3,MAXVIT + CALL DECVAR(ISTVAR(IV),IENVAR(IV),IVTVAR(IV),IERDEC, & + FMTVIT(IV),BUFINZ) + VITVAR(IV)=REAL(IVTVAR(IV))*VITFAC(IV) + enddo ! ***************************************************** ! ***************************************************** @@ -951,12 +962,12 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, ! SIGN OF LATITUDE AND CONVERT LONGITUDE IF(LATNS .EQ. 'S') THEN - STMLTZ=-STMLTZ + STMLTZ=-STMLTZ ELSE IF(LATNS .NE. 'N') THEN - WRITE(6,153) STMLTZ,STMLNZ,LATNS - 153 FORMAT('******ERROR DECODING LATNS, ERROR RECOVERY NEEDED.', - & ' STMLTZ,STMLNZ,LATNS=',2F12.2,2X,A1) - GO TO 100 + WRITE(6,153) STMLTZ,STMLNZ,LATNS + 153 FORMAT('******ERROR DECODING LATNS, ERROR RECOVERY NEEDED.', & + ' STMLTZ,STMLNZ,LATNS=',2F12.2,2X,A1) + cycle readcyc ENDIF IF(LONEW .EQ. 'W') THEN @@ -966,9 +977,9 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, !wpac STMLNZ=-360+STMLNZ !wpac end if ELSE IF(LONEW .NE. 'E') THEN - WRITE(6,157) STMLTZ,STMLNZ,LATNS - 157 FORMAT('******ERROR DECODING LONEW, ERROR RECOVERY NEEDED.', - & ' STMLTZ,STMLNZ,LATNS=',2F12.2,2X,A1) + WRITE(6,157) STMLTZ,STMLNZ,LATNS + 157 FORMAT('******ERROR DECODING LONEW, ERROR RECOVERY NEEDED.', & + ' STMLTZ,STMLNZ,LATNS=',2F12.2,2X,A1) ENDIF PRINT*,'STMLTZ,STMLNZ,LATNS=',STMLTZ,STMLNZ,LATNS @@ -982,45 +993,41 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, STMCY21=STMCY(I) STMLTZ=STMCY(I) STMLNZ=STMCX(I) - go to 785 + exit END IF END DO - 785 continue - PRINT*,'STMCX21,STMCY21=',STMCX21,STMCY21 IF(KSTORM .LT. 10) THEN - KSTORM=KSTORM+1 - CLAT_N(KSTORM)=STMLTZ - CLON_N(KSTORM)=STMLNZ - STMDIR(KSTORM)=STMDRZ - STMSPD(KSTORM)=STMSPZ - STMNAM(KSTORM)=STMNMZ - STRPSF(KSTORM)=RMPSFZ - STVMAX(KSTORM)=STMVMX - GO TO 100 - + KSTORM=KSTORM+1 + CLAT_N(KSTORM)=STMLTZ + CLON_N(KSTORM)=STMLNZ + STMDIR(KSTORM)=STMDRZ + STMSPD(KSTORM)=STMSPZ + STMNAM(KSTORM)=STMNMZ + STRPSF(KSTORM)=RMPSFZ + STVMAX(KSTORM)=STMVMX + cycle readcyc ELSE - 300 WRITE(6,301) KSTORM - 301 FORMAT(/'******KSTORM EXCEEDS AVAILABLE SPACE, KSTORM=', - & I5,/,' Results may have serious problem') - GO TO 200 - + 300 WRITE(6,301) KSTORM + 301 FORMAT(/'******KSTORM EXCEEDS AVAILABLE SPACE, KSTORM=', & + I5,/,' Results may have serious problem') +! exit ENDIF 200 IF(KSTORM .GT. 0) THEN - WRITE(6,201)KSTORM,KREC - 201 FORMAT(/'...FOUND STORM IN VITALS FILE.',/,4X,I5, - & ' TOTAL NUMBER OF RECORDS READ=',I7) + WRITE(6,201)KSTORM,KREC + 201 FORMAT(/'...FOUND STORM IN VITALS FILE.',/,4X,I5, & + ' TOTAL NUMBER OF RECORDS READ=',I7) ELSE - WRITE(6,202) - 202 FORMAT(/'NO STORM FOUND IN VITALS FILE.') -! CALL W3TAGE('RELOCATE_MV_NVORTEX_T254L64') -! CALL ERREXIT(56) - STOP + WRITE(6,202) + 202 FORMAT(/'NO STORM FOUND IN VITALS FILE.') +! CALL W3TAGE('RELOCATE_MV_NVORTEX_T254L64') +! CALL ERREXIT(56) + STOP END IF ! Correct to the storm center position @@ -1035,14 +1042,14 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, DO I=1,KSTM - WRITE(*,430)STMNAM(I),CLAT_N(I),CLON_N(I),STMDIR(I),STMSPD(I) - 430 FORMAT(/' STORM NAME: ',A12,/, ' READIN STORM CENTER=',2F12.4, - & /,' STORM DIR and SPEED: ',2F12.4) + WRITE(*,430)STMNAM(I),CLAT_N(I),CLON_N(I),STMDIR(I),STMSPD(I) + 430 FORMAT(/' STORM NAME: ',A12,/, ' READIN STORM CENTER=',2F12.4, & + /,' STORM DIR and SPEED: ',2F12.4) - PRINT*,'RAD OUTMOST CLOSED ISOBAR= ',STRPSF(I),' km' - STRPSF(I)=STRPSF(I)*1000.*ONEDEG - PRINT*,'RAD OUTMOST CLOSED ISOBAR= ',STRPSF(I),' degree' - PRINT*,'MAX STORM WIND SPEED = ',STVMAX(I),' m/s' + PRINT*,'RAD OUTMOST CLOSED ISOBAR= ',STRPSF(I),' km' + STRPSF(I)=STRPSF(I)*1000.*ONEDEG + PRINT*,'RAD OUTMOST CLOSED ISOBAR= ',STRPSF(I),' degree' + PRINT*,'MAX STORM WIND SPEED = ',STVMAX(I),' m/s' END DO @@ -1059,9 +1066,9 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, IF(STMNAME(K).EQ.ST_NAME(I))THEN IFWRT=0 DO J=1,7 - IF(ISTMCY1(J,K).EQ.0.and.ISTMCX1(J,K).EQ.0)THEN - IFWRT=1 - END IF + IF(ISTMCY1(J,K).EQ.0.and.ISTMCX1(J,K).EQ.0)THEN + IFWRT=1 + END IF END DO IF(IFWRT.EQ.0)THEN XDIST6H=CLON_N(I)-ISTMCX1(4,K)*0.1 @@ -1074,67 +1081,67 @@ SUBROUTINE HURR_MESS(ITIM,IBGS,IMAX,JMAX,GLON,GLAT, CLON_N(I)=CLON_N(I)+USTM*FACT/COS(PI180*CLAT_N(I)) CLAT_N(I)=CLAT_N(I)+VSTM*FACT END IF - PRINT*, ' CT STORM OBS. CENTER at ',ITIM,'h = ', - & STMNAME(K),CLON_N(I),CLAT_N(I) + PRINT*, ' CT STORM OBS. CENTER at ',ITIM,'h = ', & + STMNAME(K),CLON_N(I),CLAT_N(I) END IF END DO END DO - DO 900 I=1,KSTM - - CLON=CLON_N(I) - CLAT=CLAT_N(I) - - AMN = 500. - DO ILA = 1,JMAX - DO ILO = 1,IMAX - DMN = GLAT(ILO,ILA) - CLAT - OMN = GLON(ILO,ILA) - CLON - DISTC=DMN*DMN+OMN*OMN - IF(ILA*ILO.LT.20)PRINT*,'GLON,GLAT=', - & GLON(ILO,ILA),GLAT(ILO,ILA),DISTC - IF (DISTC.LE.AMN) THEN - AMN = DISTC - JC = ILA - IC = ILO - ENDIF - END DO - END DO - - IC_N(I)=IC - JC_N(I)=JC + do i=1,kstm + CLON=CLON_N(I) + CLAT=CLAT_N(I) + + AMN = 500. + DO ILA = 1,JMAX + DO ILO = 1,IMAX + DMN = GLAT(ILO,ILA) - CLAT + OMN = GLON(ILO,ILA) - CLON + DISTC=DMN*DMN+OMN*OMN + IF(ILA*ILO.LT.20)PRINT*,'GLON,GLAT=', & + GLON(ILO,ILA),GLAT(ILO,ILA),DISTC + IF (DISTC.LE.AMN) THEN + AMN = DISTC + JC = ILA + IC = ILO + ENDIF + END DO + END DO - PRINT *,'CLON,CLAT=',CLON,CLAT - PRINT *,'IC,JC= ',IC,JC,GLON(IC,JC),GLAT(IC,JC) + IC_N(I)=IC + JC_N(I)=JC - SLON_N(I) = floor(GLON(IC,JC)+0.5 - IRX/2) - SLAT_N(I) = floor(GLAT(IC,JC)+0.5 - JRX/2) - PRINT *,' ' - PRINT *,'==========================================' - PRINT *,'SLON,SLAT=',SLON_N(I),SLAT_N(I) + PRINT *,'CLON,CLAT=',CLON,CLAT + PRINT *,'IC,JC= ',IC,JC,GLON(IC,JC),GLAT(IC,JC) + SLON_N(I) = floor(GLON(IC,JC)+0.5 - IRX/2) + SLAT_N(I) = floor(GLAT(IC,JC)+0.5 - JRX/2) + PRINT *,' ' + PRINT *,'==========================================' + PRINT *,'SLON,SLAT=',SLON_N(I),SLAT_N(I) - 900 CONTINUE + enddo RETURN 990 WRITE(6,991) BUFIN - 991 FORMAT('******ERROR READING STORM RECORD. BUFIN IS:',/, - & ' ******',A95,'******') - GO TO 100 + 991 FORMAT('******ERROR READING STORM RECORD. BUFIN IS:',/, & + ' ******',A95,'******') + cycle readcyc + enddo readcyc RETURN - END + END subroutine HURR_MESS SUBROUTINE DECVAR(ISTART,IEND,IVALUE,IERDEC,FMT,BUFF) + implicit none + integer, PARAMETER ::NCHLIN=130 - PARAMETER (NCHLIN=130) - - CHARACTER FMT*(*),BUFF*(*),OUTLIN*1 + CHARACTER FMT*(*),BUFF*(*),OUTLIN*1 !, IVALUE DIMENSION OUTLIN(NCHLIN) + integer ISTART, IEND, ICH1, IERDEC , IVALUE !c && 2 comments !CC WRITE(6,1) FMT,BUFF !CC 1 FORMAT(/'...FMT=',A10,/,' ...BUFF=',A100) @@ -1144,7 +1151,6 @@ SUBROUTINE DECVAR(ISTART,IEND,IVALUE,IERDEC,FMT,BUFF) RETURN 10 CONTINUE - OUTLIN=' ' IERDEC=10 @@ -1156,13 +1162,13 @@ SUBROUTINE DECVAR(ISTART,IEND,IVALUE,IERDEC,FMT,BUFF) 32 FORMAT(A130) RETURN - END + END subroutine DECVAR - subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, - & US850,VS850,KS850,P2,zwindow, - & twindow,qwindow,uwindow,vwindow,pwindow,SIG, - & HLAT,HLON,VLAT,VLON,lmeta,iswin,iewin, - & jswin,jewin,IBGS,IVOBS,iflag_cold,I360,crfactor) + subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, & + US850,VS850,KS850,P2,zwindow, & + twindow,qwindow,uwindow,vwindow,pwindow,SIG, & + HLAT,HLON,VLAT,VLON,lmeta,iswin,iewin, & + jswin,jewin,IBGS,IVOBS,iflag_cold,I360,crfactor) ! ! ITIM: Time level ! CLON_N,CLAT_N: observed storm center @@ -1173,13 +1179,16 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, ! iswin,iewin,jswin,jewin,lmeta: coordinate index range ! insert storm relocation code here + use nhc1, only: NST, SLON_N,SLAT_N,CLON_N,CLAT_N + use stname,only: ST_NAME,STMNAME + use tcvit, only: TCVT implicit none - integer(4) IRX,JRX,MTV4,MTV6,NST,IBGS,IVOBS + integer(4) MTV4,MTV6,IBGS,IVOBS integer iflag_cold,I360 - integer IST,IED,JST,JED,KS850,gd_dim3 - parameter (IRX=41,JRX=41,NST=10,gd_dim3=450) + integer IST,IED,JST,JED,KS850 + integer, parameter:: IRX=41,JRX=41,gd_dim3=450 integer(4) iswin,iewin,jswin,jewin,lmeta real(4) twindow(iswin:iewin,jswin:jewin,lmeta) @@ -1233,13 +1242,6 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, integer(4) KST - real(4) SLON_N,SLAT_N,CLON_N,CLAT_N - - CHARACTER ST_NAME(NST)*3,STMNAME(NST)*3,TCVT(NST)*95 - - COMMON /NHC1/ SLON_N(NST),SLAT_N(NST),CLON_N(NST),CLAT_N(NST) - COMMON /STNAME/ST_NAME,STMNAME - COMMON /TCVIT/TCVT inx=iewin-iswin+1 jnx=jewin-jswin+1 @@ -1263,18 +1265,18 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, ! rjac=cos(pi/jnx) do j=1,jnx - do i=1,inx - i1=iswin+i-1 - j1=jswin+j-1 -! coslat(i,j)=cos(grid_lat(i1,j1)*pi180) -! XLON1(i,j)=grid_lon(i1,j1) -! XLAT1(i,j)=grid_lat(i1,j1) - XLON1(i,j)=HLON(i1,j1) - XLAT1(i,j)=HLAT(i1,j1) - - XLON(i,j)=VLON(i1,j1) ! LON, LAT at U,V grids - XLAT(i,j)=VLAT(i1,j1) - end do + do i=1,inx + i1=iswin+i-1 + j1=jswin+j-1 +! coslat(i,j)=cos(grid_lat(i1,j1)*pi180) +! XLON1(i,j)=grid_lon(i1,j1) +! XLAT1(i,j)=grid_lat(i1,j1) + XLON1(i,j)=HLON(i1,j1) + XLAT1(i,j)=HLAT(i1,j1) + + XLON(i,j)=VLON(i1,j1) ! LON, LAT at U,V grids + XLAT(i,j)=VLAT(i1,j1) + end do end do do i=1,IRX @@ -1298,82 +1300,82 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, IF(YB2.GT.XLAT1(I,JNX-1))YB2=XLAT1(I,JNX-1) END DO - RDST=0.25 + RDST=0.25 - XB1=XB1+RDST - XB2=XB2-RDST - YB1=YB1+RDST - YB2=YB2-RDST + XB1=XB1+RDST + XB2=XB2-RDST + YB1=YB1+RDST + YB2=YB2-RDST - AB1=BLON(1) - AB2=BLON(IRX) - BB1=BLAT(1) - BB2=BLAT(JRX) + AB1=BLON(1) + AB2=BLON(IRX) + BB1=BLAT(1) + BB2=BLAT(JRX) - print*,'XB1,XB2,AB1,AB2=',XB1,XB2,AB1,AB2 - print*,'YB1,YB2,BB1,BB2=',YB1,YB2,BB1,BB2 + print*,'XB1,XB2,AB1,AB2=',XB1,XB2,AB1,AB2 + print*,'YB1,YB2,BB1,BB2=',YB1,YB2,BB1,BB2 - IF(AB1.LT.XB1.or.AB2.GT.XB2.or.BB1.LT.YB1.or.BB2.GT.YB2)THEN - CALL CREAT_41X41(ITIM,KST,KMX,MTV6,KS850,U850,V850,SDAT,P2) + IF(AB1.LT.XB1.or.AB2.GT.XB2.or.BB1.LT.YB1.or.BB2.GT.YB2)THEN + CALL CREAT_41X41(ITIM,KST,KMX,MTV6,KS850,U850,V850,SDAT,P2) ! RDST1=0.75 - IST=8 - IED=33 - JST=8 - JED=33 - print*,'using outer nest data' - ELSE + IST=8 + IED=33 + JST=8 + JED=33 + print*,'using outer nest data' + ELSE ! RDST1=0.06 - IST=1 - IED=IRX - JST=1 - JED=JRX - END IF - print*,'crfactor=',crfactor - RDST=0.05*crfactor - print*,'RDST=', RDST - RDST1=RDST*RDST + IST=1 + IED=IRX + JST=1 + JED=JRX + END IF + print*,'crfactor=',crfactor + RDST=0.05*crfactor + print*,'RDST=', RDST + RDST1=RDST*RDST - DO J=1,JNX - DO I=1,INX - i1=iswin+i-1 - j1=jswin+j-1 - DO K=1,KMX - vort(i,j,k)=uwindow(i1,j1,k) - divg(i,j,k)=vwindow(i1,j1,k) - END DO - END DO - END DO + DO J=1,JNX + DO I=1,INX + i1=iswin+i-1 + j1=jswin+j-1 + DO K=1,KMX + vort(i,j,k)=uwindow(i1,j1,k) + divg(i,j,k)=vwindow(i1,j1,k) + END DO + END DO + END DO !23456789012345678901234567890123456789012345678901234567890123456789012 - allocate (HDATN(inx,jnx,MTV4)) + allocate (HDATN(inx,jnx,MTV4)) - DO J=1,JNX - DO I=1,INX - i1=iswin+i-1 - j1=jswin+j-1 - HDATN(I,J,1)=zwindow(i1,j1) - HDATN(I,J,2)=pwindow(i1,j1) - END DO - END DO + DO J=1,JNX + DO I=1,INX + i1=iswin+i-1 + j1=jswin+j-1 + HDATN(I,J,1)=zwindow(i1,j1) + HDATN(I,J,2)=pwindow(i1,j1) + END DO + END DO - DO K=1,KMX - K1=K+2 - K2=2*(K-1)+1+KMX+2 ! div ==> u - K3=2*(K-1)+2+KMX+2 ! vor ==> v - K4=K+3*KMX+2 - DO J=1,JNX - DO I=1,INX - i1=iswin+i-1 - j1=jswin+j-1 - HDATN(I,J,K1)=twindow(i1,j1,K) - HDATN(I,J,K2)=vort(i,j,K) ! div ==> u - HDATN(I,J,K3)=divg(i,j,K) ! vor ==> v - HDATN(I,J,K4)=qwindow(i1,j1,K) - END DO - END DO - END DO + DO K=1,KMX + K1=K+2 + K2=2*(K-1)+1+KMX+2 ! div ==> u + K3=2*(K-1)+2+KMX+2 ! vor ==> v + K4=K+3*KMX+2 + DO J=1,JNX + DO I=1,INX + i1=iswin+i-1 + j1=jswin+j-1 + HDATN(I,J,K1)=twindow(i1,j1,K) + HDATN(I,J,K2)=vort(i,j,K) ! div ==> u + HDATN(I,J,K3)=divg(i,j,K) ! vor ==> v + HDATN(I,J,K4)=qwindow(i1,j1,K) + END DO + END DO + END DO ! do k=1,kmx @@ -1401,42 +1403,42 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, N_CHECK=0 -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,N,NGRID,COST2,DIST) DO J=JST,JED - DO I=IST,IED - NGRID=0 - NSUM(I,J)=0. - WSUM(I,J)=0. - DO N=1,JNX - DO K=1,INX - COST2=(COS((XLAT(K,N)+BLAT(J))*0.5*pi180))**2 - DIST=COST2*(XLON(K,N)-BLON(I))**2+ - & (XLAT(K,N)-BLAT(J))**2 - IF(DIST.LE.RDST1)THEN - NGRID=NGRID+1 - IGD(I,J,NGRID)=K - JGD(I,J,NGRID)=N - WGD(I,J,NGRID)=EXP(-DIST/RDST1) - WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) - NSUM(I,J)=NGRID - END IF - END DO + DO I=IST,IED + NGRID=0 + NSUM(I,J)=0. + WSUM(I,J)=0. + DO N=1,JNX + DO K=1,INX + COST2=(COS((XLAT(K,N)+BLAT(J))*0.5*pi180))**2 + DIST=COST2*(XLON(K,N)-BLON(I))**2+ & + (XLAT(K,N)-BLAT(J))**2 + IF(DIST.LE.RDST1)THEN + NGRID=NGRID+1 + IGD(I,J,NGRID)=K + JGD(I,J,NGRID)=N + WGD(I,J,NGRID)=EXP(-DIST/RDST1) + WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) + NSUM(I,J)=NGRID + END IF + END DO + END DO END DO END DO - END DO if(NGRID.GT.gd_dim3)STOP 12 DO J=JST,JED - DO I=IST,IED - IF(NSUM(I,J).GT.5)THEN - N_CHECK=1 - ELSE - print*,'QQQ I,J=',I,J,NSUM(I,J),WSUM(I,J),BLON(I),BLAT(J) + DO I=IST,IED + IF(NSUM(I,J).GT.5)THEN + N_CHECK=1 + ELSE + print*,'QQQ I,J=',I,J,NSUM(I,J),WSUM(I,J),BLON(I),BLAT(J) ! N_CHECK=0 - END IF - END DO + END IF + END DO END DO IF(N_CHECK.EQ.0)THEN @@ -1447,30 +1449,30 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, print*,'corners=',XLON(1,1),XLON(INX,JNX) print*,'corners=',XLAT(1,1),XLAT(INX,JNX) -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,N,i1,j1,SDAT1) - DO J=JST,JED + DO J=JST,JED DO I=IST,IED IF(NSUM(I,J).GT.5)THEN - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+US850(I1,J1)*WGD(I,J,N) - END DO - U850(I,J)=SDAT1/WSUM(I,J) - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+VS850(I1,J1)*WGD(I,J,N) - END DO - V850(I,J)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+US850(I1,J1)*WGD(I,J,N) + END DO + U850(I,J)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+VS850(I1,J1)*WGD(I,J,N) + END DO + V850(I,J)=SDAT1/WSUM(I,J) END IF ENDDO - ENDDO + ENDDO -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,N,K2,K3,K5,K6,SDAT1,I1,J1) DO K=1,KMX K2=4*(K-1)+3+KMX+2 @@ -1478,26 +1480,26 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, K5=4*(K-1)+1+KMX+2 ! div (here U,V, otherwise move to next loop) K6=4*(K-1)+2+KMX+2 ! vor DO J=JST,JED - DO I=IST,IED - IF(NSUM(I,J).GT.5)THEN - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+uwindow(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K2)=SDAT1/WSUM(I,J) - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+vwindow(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K3)=SDAT1/WSUM(I,J) - SDAT(I,J,K5)=SDAT(I,J,K2) - SDAT(I,J,K6)=SDAT(I,J,K3) - END IF - ENDDO + DO I=IST,IED + IF(NSUM(I,J).GT.5)THEN + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+uwindow(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K2)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+vwindow(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K3)=SDAT1/WSUM(I,J) + SDAT(I,J,K5)=SDAT(I,J,K2) + SDAT(I,J,K6)=SDAT(I,J,K3) + END IF + ENDDO ENDDO ENDDO @@ -1507,58 +1509,58 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, IGD=0 JGD=0 WGD=0 -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,k,N,NGRID,COST2,DIST) DO J=JST,JED - DO I=IST,IED - NGRID=0 - WSUM(I,J)=0. - DO N=1,JNX - DO K=1,INX - COST2=(COS((XLAT1(K,N)+BLAT(J))*0.5*pi180))**2 - DIST=COST2*(XLON1(K,N)-BLON(I))**2+ - & (XLAT1(K,N)-BLAT(J))**2 - IF(DIST.LE.RDST1)THEN - NGRID=NGRID+1 - IGD(I,J,NGRID)=K - JGD(I,J,NGRID)=N - WGD(I,J,NGRID)=EXP(-DIST/RDST1) - WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) - NSUM(I,J)=NGRID - END IF - END DO + DO I=IST,IED + NGRID=0 + WSUM(I,J)=0. + DO N=1,JNX + DO K=1,INX + COST2=(COS((XLAT1(K,N)+BLAT(J))*0.5*pi180))**2 + DIST=COST2*(XLON1(K,N)-BLON(I))**2+ & + (XLAT1(K,N)-BLAT(J))**2 + IF(DIST.LE.RDST1)THEN + NGRID=NGRID+1 + IGD(I,J,NGRID)=K + JGD(I,J,NGRID)=N + WGD(I,J,NGRID)=EXP(-DIST/RDST1) + WSUM(I,J)=WSUM(I,J)+WGD(I,J,NGRID) + NSUM(I,J)=NGRID + END IF + END DO + END DO END DO END DO - END DO -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,N,SDAT1,I1,J1) DO J=JST,JED - DO I=IST,IED - IF(NSUM(I,J).GT.5)THEN - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+zwindow(I1,J1)*WGD(I,J,N) - END DO - SDAT(I,J,1)=SDAT1/WSUM(I,J) - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+pwindow(I1,J1)*WGD(I,J,N) - END DO - SDAT(I,J,2)=SDAT1/WSUM(I,J) - END IF - END DO + DO I=IST,IED + IF(NSUM(I,J).GT.5)THEN + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+zwindow(I1,J1)*WGD(I,J,N) + END DO + SDAT(I,J,1)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+pwindow(I1,J1)*WGD(I,J,N) + END DO + SDAT(I,J,2)=SDAT1/WSUM(I,J) + END IF + END DO END DO ! WRITE(83)((SDAT(I,J,1),I=1,41),J=1,41) ! WRITE(83)((SDAT(I,J,2),I=1,41),J=1,41) -!$omp parallel do +!$omp parallel do & !$omp& private(i,j,K,K1,K4,N,SDAT1,I1,J1) DO K=1,KMX K1=K+2 @@ -1568,24 +1570,24 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, ! K5=4*(K-1)+1+KMX+2 ! div ! K6=4*(K-1)+2+KMX+2 ! vor DO J=JST,JED - DO I=IST,IED - IF(NSUM(I,J).GT.5)THEN - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+twindow(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K1)=SDAT1/WSUM(I,J) - SDAT1=0. - DO N=1,NSUM(I,J) - I1=IGD(I,J,N) - J1=JGD(I,J,N) - SDAT1=SDAT1+qwindow(I1,J1,K)*WGD(I,J,N) - END DO - SDAT(I,J,K4)=SDAT1/WSUM(I,J) - END IF - ENDDO + DO I=IST,IED + IF(NSUM(I,J).GT.5)THEN + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+twindow(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K1)=SDAT1/WSUM(I,J) + SDAT1=0. + DO N=1,NSUM(I,J) + I1=IGD(I,J,N) + J1=JGD(I,J,N) + SDAT1=SDAT1+qwindow(I1,J1,K)*WGD(I,J,N) + END DO + SDAT(I,J,K4)=SDAT1/WSUM(I,J) + END IF + ENDDO ENDDO ! WRITE(83)((SDAT(I,J,K1),I=1,41),J=1,41) @@ -1613,21 +1615,21 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, - CALL HURR_MOVE(ITIM,KST,INX,JNX,KMX,MTV6,MTV4,SDAT,HDATN, - & U850,V850,XLON1,XLAT1,XLON,XLAT,SIG,IBGS,IVOBS, - & iflag_cold,I360) + CALL HURR_MOVE(ITIM,KST,INX,JNX,KMX,MTV6,MTV4,SDAT,HDATN, & + U850,V850,XLON1,XLAT1,XLON,XLAT,SIG,IBGS,IVOBS, & + iflag_cold,I360) !23456789012345678901234567890123456789012345678901234567890123456789012 DO J=1,JNX - DO I=1,INX - i1=iswin+i-1 - j1=jswin+j-1 - zwindow(i1,j1)=HDATN(I,J,1) - pwindow(i1,j1)=HDATN(I,J,2) - END DO + DO I=1,INX + i1=iswin+i-1 + j1=jswin+j-1 + zwindow(i1,j1)=HDATN(I,J,1) + pwindow(i1,j1)=HDATN(I,J,2) + END DO END DO DO K=1,KMX @@ -1636,14 +1638,14 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, K3=2*(K-1)+2+KMX+2 ! vor ==> v K4=K+3*KMX+2 DO J=1,JNX - DO I=1,INX - i1=iswin+i-1 - j1=jswin+j-1 - twindow(i1,j1,K)=HDATN(I,J,K1) - vort(i,j,K)=HDATN(I,J,K2) ! div ==> u - divg(i,j,K)=HDATN(I,J,K3) ! vor ==> v - qwindow(i1,j1,K)=HDATN(I,J,K4) - END DO + DO I=1,INX + i1=iswin+i-1 + j1=jswin+j-1 + twindow(i1,j1,K)=HDATN(I,J,K1) + vort(i,j,K)=HDATN(I,J,K2) ! div ==> u + divg(i,j,K)=HDATN(I,J,K3) ! vor ==> v + qwindow(i1,j1,K)=HDATN(I,J,K4) + END DO END DO END DO @@ -1721,15 +1723,15 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, ! print*,'uv_diff=',uv_diff,uv_diff/uv_tt do j=1,jnx - do i=1,inx - i1=iswin+i-1 - j1=jswin+j-1 - do k=1,kmx - uwindow(i1,j1,k)=vort(i,j,k) - vwindow(i1,j1,k)=divg(i,j,k) + do i=1,inx + i1=iswin+i-1 + j1=jswin+j-1 + do k=1,kmx + uwindow(i1,j1,k)=vort(i,j,k) + vwindow(i1,j1,k)=divg(i,j,k) + end do end do end do - end do ! uwindow=SF1 ! vwindow=SF2 @@ -1752,15 +1754,19 @@ subroutine wrf_move(ITIM,KST,grid_lon,grid_lat, deallocate (XLON,XLAT) return - end + end subroutine wrf_move SUBROUTINE sor(a,b,c,d,e,f,u,jmax,rjac) - INTEGER jmax,MAXITS - real(4) a(jmax,jmax),b(jmax,jmax), - & c(jmax,jmax),d(jmax,jmax),e(jmax,jmax), - & f(jmax,jmax),u(jmax,jmax) - PARAMETER (MAXITS=1000,EPS=1.e-3) + implicit none + INTEGER jmax + real(4) a(jmax,jmax),b(jmax,jmax), & + c(jmax,jmax),d(jmax,jmax),e(jmax,jmax), & + f(jmax,jmax),u(jmax,jmax) + integer, PARAMETER:: MAXITS=1000 + real, parameter :: EPS=1.e-3 + + real anormf,omega,anorm,resid,rjac !! Successive overrelaxation solution of equation (19.5.25) !! with Chebyshev acceleration. a, b, c, d, e, andfare input @@ -1778,9 +1784,9 @@ SUBROUTINE sor(a,b,c,d,e,f,u,jmax,rjac) !! Compute initial norm of residual and terminate iteration !! when norm has been reduced by a factor EPS. do j=4,jmax-3 - do l=4,jmax-3 - anormf=anormf+abs(f(j,l)) !! Assumes initial u is zero. - enddo + do l=4,jmax-3 + anormf=anormf+abs(f(j,l)) !! Assumes initial u is zero. + enddo enddo print*,'test anormf=',anormf omega=1.d0 @@ -1792,14 +1798,14 @@ SUBROUTINE sor(a,b,c,d,e,f,u,jmax,rjac) ! do j=2,jmax-1 ! do l=lsw+1,jmax-1,2 do j=4,jmax-3 - do l=lsw+3,jmax-3,2 - resid=a(j,l)*u(j+1,l)+b(j,l)*u(j-1,l)+ - & c(j,l)*u(j,l+1)+d(j,l)*u(j,l-1)+ - & e(j,l)*u(j,l)-f(j,l) - anorm=anorm+abs(resid) - u(j,l)=u(j,l)-omega*resid/e(j,l) - enddo - lsw=3-lsw + do l=lsw+3,jmax-3,2 + resid=a(j,l)*u(j+1,l)+b(j,l)*u(j-1,l)+ & + c(j,l)*u(j,l+1)+d(j,l)*u(j,l-1)+ & + e(j,l)*u(j,l)-f(j,l) + anorm=anorm+abs(resid) + u(j,l)=u(j,l)-omega*resid/e(j,l) + enddo + lsw=3-lsw enddo jsw=3-jsw if(n.eq.1.and.ipass.eq.1) then @@ -1813,35 +1819,54 @@ SUBROUTINE sor(a,b,c,d,e,f,u,jmax,rjac) enddo print*,'n,anorm,anormf=',n,anorm,anormf print*,'MAXITS exceeded in sor' - END + END SUBROUTINE sor - SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, - & HDATN,U850,V850,XLON1,XLAT1,XLON,XLAT,SL,IBGS,IVOBS, - & iflag_cold,I360) + SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, & + HDATN,U850,V850,XLON1,XLAT1,XLON,XLAT,SL,IBGS,IVOBS, & + iflag_cold,I360) ! KST is the storm number - + use posit + use vect + use stname, only: ST_NAME,STMNAME + use tcvit + use nhc, only: KSTM,IC_N,JC_N + use nhc1, only: SLON_N,SLAT_N,CLON_N,CLAT_N + use nhc2 + use nhc3 + use rsfc, only: STRPSF,STVMAX,STRPSF_06 + use tr ! From WRF-NMM in R2 HWRF (WRF-NMM 3.2): + implicit none real, parameter :: deg2rad = 3.1415926/180. - PARAMETER (IX=41,JX=41,NF=11,IT=24,IR=120,IJ=IX*JX) - PARAMETER (NSG=720000,NST=10) - PARAMETER (NSG5=NSG/5) + integer i,j,k,kst,i360,kmax,NF1,IBGS,IVOBS,N + integer K850,K8501,ISTMCY1,ISTMCX1,ITIM,K1STM,INDX1,ICHEK + integer MNHC,KNHC,IFWRT,IFLAG_COLD,JC1,IC1 + integer M2,IC,JC,IB5,IB6,IBH,ING3,JNG3,ING6,JNG6 + integer IV,ISE,NRED1,IFLAG,KMP,KDIV1,KQ1,ING5,JNG5,IW,JW + integer M3,NCHT,IGU,JGU,IREM,MTV4,MTV6,JMAX,IMAX + integer KDIV2,KQ2 + + integer, PARAMETER:: IX=41,JX=41,NF=11,IT=24,IR=120,IJ=IX*JX + integer, PARAMETER:: NSG5=NSG/5 REAL(4) SDAT(IX,JX,MTV6),HDATN(IMAX,JMAX,MTV4),SL(KMAX) REAL(4) U850(IX,JX),V850(IX,JX) + real U,V,XTU,XTV,US,VS,YTU,YTV,UD,VD + DIMENSION U(IX,JX),V(IX,JX),US(IX,JX),VS(IX,JX) DIMENSION UD(IX,JX),VD(IX,JX),DKY(IX,JX),DKM(IX,JX) DIMENSION DKY1(IMAX,JMAX),DKM1(IMAX,JMAX) ! DIMENSION DKM1(IMAX,JMAX),SKIP(IX,JX) DIMENSION XTU(IX,NF),XTV(IX,NF),YTU(IX,JX),YTV(IX,JX) - DIMENSION RS(IT),R0(IT),RF(IT) + DIMENSION RS(IT),RF(IT) DIMENSION M(NF),FK(NF),TW(IT,IR) DIMENSION ALAT(JX),ALON(IX) - DIMENSION ING(NSG),JNG(NSG),RRIJ(NSG) + DIMENSION RRIJ(NSG) DIMENSION ING3(NSG),JNG3(NSG) DIMENSION ING5(NSG5),JNG5(NSG5) DIMENSION ING6(NSG5),JNG6(NSG5) @@ -1856,29 +1881,28 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, real(4) XLON1(IMAX,JMAX),XLAT1(IMAX,JMAX) real(4) XLON(IMAX,JMAX),XLAT(IMAX,JMAX) real(4) GLON(IMAX,JMAX),GLAT(IMAX,JMAX) - real(4) SLON_N,SLAT_N,CLON_N,CLAT_N + + !tested ok + real ALON,ALAT + real CLAT_NHC,CLON_NHC,A,B + real CLON_TIM,CLAT_TIM + real CLON_NHC_RAD,CLAT_NHC_RAD real(4) zmax real mindist,tmplat,tmplon,dist -! COMMON /egrid/GLON(IMAX,JMAX),GLAT(IMAX,JMAX) !input + integer M + DATA M/2,3,4,2,5,6,7,2,8,9,2/ - COMMON /NHC/ KSTM,IC_N(NST),JC_N(NST) - COMMON /NHC1/SLON_N(NST),SLAT_N(NST),CLON_N(NST),CLAT_N(NST) !input - COMMON /POSIT/CLON_NEW,CLAT_NEW,SLON,SLAT,CLON,CLAT,RAD - COMMON /vect/R0,XVECT(IT),YVECT(IT) + real TW + real R,RS, FACT,DIST2,DIST1,FK,ZMAX1,PI180,PI, RFAVG, RF + real RDIST2,CALC_DIST,STMCX,STMCY,DKM1,COEF3,COEF2,COEF1,DKY1 + integer JWMIN1,JWMAX1,IWMIN1,IWMAX1,JWMIN,JWMAX,IWMIN,IWMAX - CHARACTER ST_NAME(NST)*3,STMNAME(NST)*3,TCVT(NST)*95 - COMMON /STNAME/ST_NAME,STMNAME ! need storm name - COMMON /TCVIT/TCVT ! need TC vitals - COMMON /RSFC/STRPSF(NST),STVMAX(NST),STRPSF_06(NST) + real DKM,DKY + real TH,RRIJ,WT2 - COMMON /TR/ING,JNG,IB - COMMON /NHC2/MDX,MDY - COMMON /NHC3/AMDX,AMDY - - DATA M/2,3,4,2,5,6,7,2,8,9,2/ allocate (DATG(IMAX,JMAX),DATG2(IMAX,JMAX),DDAT(IMAX,JMAX)) allocate (ENV1(IMAX,JMAX,MTV4)) @@ -1919,14 +1943,14 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, zmax1=0. DO J=1,JMAX - DO I=1,IMAX - A = XLON1(I,J) - CLON_NHC - B = XLAT1(I,J) - CLAT_NHC - R = SQRT(A**2. + B**2.) - IF(R.LT.12.) THEN - if(zmax1.lt.HDATN(i,j,1))zmax1=HDATN(i,j,1) - ENDIF - END DO + DO I=1,IMAX + A = XLON1(I,J) - CLON_NHC + B = XLAT1(I,J) - CLAT_NHC + R = SQRT(A**2. + B**2.) + IF(R.LT.12.) THEN + if(zmax1.lt.HDATN(i,j,1))zmax1=HDATN(i,j,1) + ENDIF + END DO END DO PRINT*,'zmax1=',zmax1 @@ -1953,7 +1977,7 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, DO I=1,IX ALON(I)=SLON+(I-1) ! specify 41x41 lon and lat -! PRINT*,'ALON(I)=',I,ALON(I),XLON1(1,1),XLON1(IMAX,JMAX) + PRINT*,'ALON(I)=',I,ALON(I),XLON1(1,1),XLON1(IMAX,JMAX) END DO DO J=1,JX ALAT(J)=SLAT+(J-1) @@ -1972,8 +1996,8 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, STMCX(I)=0. STMCY(I)=0. STMNAME(I)='NUL' - READ(30,442,end=436) - & (ISTMCY1(J,I),ISTMCX1(J,I),J=1,7),STMNAME(I) + READ(30,442,end=436) & + (ISTMCY1(J,I),ISTMCX1(J,I),J=1,7),STMNAME(I) ! IF(I360.eq.180) STMCX(I)=-1*ISTMCX1(INDX1,I)*0.1 !Western hemisphere TC IF(I360.eq.360) STMCX(I)=ISTMCX1(INDX1,I)*0.1 !Eastern hemisphere TC @@ -2013,95 +2037,94 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, print*,SDAT(30,30,K850+3) DO J=1,JX - DO I=1,IX -! U(I,J)=SDAT(I,J,K850+2) -! V(I,J)=SDAT(I,J,K850+3) - U(I,J)=U850(I,J) - V(I,J)=V850(I,J) - END DO + DO I=1,IX +! U(I,J)=SDAT(I,J,K850+2) +! V(I,J)=SDAT(I,J,K850+3) + U(I,J)=U850(I,J) + V(I,J)=V850(I,J) + END DO END DO ! fact=cos(CLAT*rad) fact=1.0 do j=1,jx - do i=1,ix -! East-West wind in new coordinate (phi,theta) -! this conversion only affects Hurrican Center determination and R0 - U(I,J)=U(I,J)/fact - end do + do i=1,ix +! East-West wind in new coordinate (phi,theta) +! this conversion only affects Hurrican Center determination and R0 + U(I,J)=U(I,J)/fact + end do end do !.. DO ZONAL FILTER - DO 100 J=1,JX - DO N=1,NF1 - XTU(1,N) = U(1,J) - XTU(IX,N) = U(IX,J) - XTV(1,N) = V(1,J) - XTV(IX,N) = V(IX,J) - ENDDO + do j=1,jx + DO N=1,NF1 + XTU(1,N) = U(1,J) + XTU(IX,N) = U(IX,J) + XTV(1,N) = V(1,J) + XTV(IX,N) = V(IX,J) + ENDDO - DO I=2,IX-1 - XTU(I,1) = U(I,J)+FK(1)*(U(I-1,J)+U(I+1,J)-2.*U(I,J)) - XTV(I,1) = V(I,J)+FK(1)*(V(I-1,J)+V(I+1,J)-2.*V(I,J)) - ENDDO + DO I=2,IX-1 + XTU(I,1) = U(I,J)+FK(1)*(U(I-1,J)+U(I+1,J)-2.*U(I,J)) + XTV(I,1) = V(I,J)+FK(1)*(V(I-1,J)+V(I+1,J)-2.*V(I,J)) + ENDDO - DO N=2,NF1 - DO I=2,IX-1 - XTU(I,N)=XTU(I,N-1)+FK(N)*(XTU(I-1,N-1)+XTU(I+1,N-1)-2. - & *XTU(I,N-1)) - XTV(I,N)=XTV(I,N-1)+FK(N)*(XTV(I-1,N-1)+XTV(I+1,N-1)-2. - & *XTV(I,N-1)) - ENDDO - ENDDO + DO N=2,NF1 + DO I=2,IX-1 + XTU(I,N)=XTU(I,N-1)+FK(N)*(XTU(I-1,N-1)+XTU(I+1,N-1)-2. & + *XTU(I,N-1)) + XTV(I,N)=XTV(I,N-1)+FK(N)*(XTV(I-1,N-1)+XTV(I+1,N-1)-2. & + *XTV(I,N-1)) + ENDDO + ENDDO - DO I=1,IX - US(I,J) = XTU(I,NF1) - VS(I,J) = XTV(I,NF1) - ENDDO + DO I=1,IX + US(I,J) = XTU(I,NF1) + VS(I,J) = XTV(I,NF1) + ENDDO -100 CONTINUE + enddo !.. DO MERIDIONAL FILTER - DO 200 I=1,IX - - DO N=1,NF1 - YTU(1,N) = US(I,1) - YTU(JX,N) = US(I,JX) - YTV(1,N) = VS(I,1) - YTV(JX,N) = VS(I,JX) - ENDDO + do i=1,ix + DO N=1,NF1 + YTU(1,N) = US(I,1) + YTU(JX,N) = US(I,JX) + YTV(1,N) = VS(I,1) + YTV(JX,N) = VS(I,JX) + ENDDO - DO J = 2 , JX-1 - YTU(J,1) = US(I,J) + FK(1)*(US(I,J-1) + US(I,J+1) - & -2.*US(I,J)) - YTV(J,1) = VS(I,J) + FK(1)*(VS(I,J-1) + VS(I,J+1) - & -2.*VS(I,J)) - ENDDO + DO J = 2 , JX-1 + YTU(J,1) = US(I,J) + FK(1)*(US(I,J-1) + US(I,J+1) & + -2.*US(I,J)) + YTV(J,1) = VS(I,J) + FK(1)*(VS(I,J-1) + VS(I,J+1) & + -2.*VS(I,J)) + ENDDO - DO N = 2 , NF1 - DO J = 2 , JX-1 - YTU(J,N) = YTU(J,N-1) + FK(N)*(YTU(J-1,N-1) + - & YTU(J+1,N-1) - 2.*YTU(J,N-1)) - YTV(J,N) = YTV(J,N-1) + FK(N)*(YTV(J-1,N-1) + - & YTV(J+1,N-1) - 2.*YTV(J,N-1)) - ENDDO - ENDDO + DO N = 2 , NF1 + DO J = 2 , JX-1 + YTU(J,N) = YTU(J,N-1) + FK(N)*(YTU(J-1,N-1) + & + YTU(J+1,N-1) - 2.*YTU(J,N-1)) + YTV(J,N) = YTV(J,N-1) + FK(N)*(YTV(J-1,N-1) + & + YTV(J+1,N-1) - 2.*YTV(J,N-1)) + ENDDO + ENDDO - DO J = 1 , JX - US(I,J) = YTU(J,NF1) - VS(I,J) = YTV(J,NF1) - ENDDO - 200 CONTINUE + DO J = 1 , JX + US(I,J) = YTU(J,NF1) + VS(I,J) = YTV(J,NF1) + ENDDO + enddo !.. GET THE DISTURBANCE FIELD DO I=1,IX - DO J=1,JX - UD(I,J) = U(I,J) - US(I,J) - VD(I,J) = V(I,J) - VS(I,J) - ENDDO + DO J=1,JX + UD(I,J) = U(I,J) - US(I,J) + VD(I,J) = V(I,J) - VS(I,J) + ENDDO ENDDO !.. FIND NEW VORTEX CENTER @@ -2109,7 +2132,7 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, ICHEK=0 CLON_TIM=0. CLAT_TIM=0. - DO I=1,K1STM + iloop : DO I=1,K1STM IF(STMNAME(I).EQ.ST_NAME(KST))THEN CLON_TIM=STMCX(I) CLAT_TIM=STMCY(I) @@ -2119,10 +2142,9 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, ICHEK=0 END IF END DO - GO TO 446 + exit iloop END IF - END DO - 446 CONTINUE + END DO iloop print*,'ICHEK,CLON_TIM=',ICHEK,CLON_TIM IF((ICHEK.EQ.1).AND.(ABS(CLON_TIM).LT.359.5))THEN CLON_NEW=CLON_TIM @@ -2152,10 +2174,10 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, AMDY=CLAT_NHC-CLAT_NEW IF(ITIM.EQ.6)THEN - WRITE(52,65)TCVT(KST)(1:32), - & CLON_NHC,CLAT_NHC,CLON_NEW, - & CLAT_NEW,CLON_TIM,CLAT_TIM,AMDX,AMDY, - & SQRT(AMDX*AMDX+AMDY*AMDY) + WRITE(52,65)TCVT(KST)(1:32), & + CLON_NHC,CLAT_NHC,CLON_NEW, & + CLAT_NEW,CLON_TIM,CLAT_TIM,AMDX,AMDY, & + SQRT(AMDX*AMDX+AMDY*AMDY) DO I=1,K1STM IF(STMNAME(I).EQ.ST_NAME(KST))THEN IFWRT=0 @@ -2171,17 +2193,17 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, END IF 76 FORMAT(/' STORM: ',A32,10x,' is bogused') 77 FORMAT(/' STORM: ',A32,10x) - WRITE(52,79) - & (ISTMCY1(J,I),ISTMCX1(J,I),J=1,7),STMNAME(I) + WRITE(52,79) & + (ISTMCY1(J,I),ISTMCX1(J,I),J=1,7),STMNAME(I) 79 FORMAT(/' TRACKER OUTPUT: ',14i4,5x,A3) END IF END DO END IF - 65 FORMAT(/' STORM NAME: ',A32, - & /' OBSERVED CENTER POSITION: ',2F10.2 - & ,/' MODEL CENTER POSITION : ',2F10.2 - & ,/' MODEL CENTER POSITION (TIM): ',2F10.2 - & ,/' RELOCATION DISTANCE (DEGREE): ',3F10.2) + 65 FORMAT(/' STORM NAME: ',A32, & + /' OBSERVED CENTER POSITION: ',2F10.2 & + ,/' MODEL CENTER POSITION : ',2F10.2 & + ,/' MODEL CENTER POSITION (TIM): ',2F10.2 & + ,/' RELOCATION DISTANCE (DEGREE): ',3F10.2) ! test by qliu ! MDX=MDX+50 @@ -2191,74 +2213,74 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, MNHC=-99999 DO I=1,IMAX-1 - DO J=1,JMAX-1 - IF((CLAT_NHC.GE.GLAT(I,J).and. - & CLAT_NHC.LT.GLAT(I,J+1)).and. - & (CLON_NHC.GE.GLON(I,J).and. - & CLON_NHC.LT.GLON(I+1,J)))THEN - KNHC=I - MNHC=J - END IF - END DO + DO J=1,JMAX-1 + IF((CLAT_NHC.GE.GLAT(I,J).and. & + CLAT_NHC.LT.GLAT(I,J+1)).and. & + (CLON_NHC.GE.GLON(I,J).and. & + CLON_NHC.LT.GLON(I+1,J)))THEN + KNHC=I + MNHC=J + END IF + END DO END DO if( knhc==-99999 .or. mnhc==-99999 ) then - ! Should not get here, but it happens once in a blue moon. - ! The above search for the center point failed. - ! We'll try again by finding the nearest gridpoint. - ! This is much slower since it requires calculating great - ! circle distances. - - ! What we should do is replace this and the above loop with - ! code that uses the rot-lat-lon projection information. - ! That isn't available here so we have to use these - ! dirty tricks instead. - - write(6,*) 'COULD NOT FIND GRIDPOINT OF CENTER IN DOMAIN.' - write(6,*) 'REVERTING TO NEAREST GRIDPOINT METHOD.' - write(0,*) 'COULD NOT FIND GRIDPOINT OF CENTER IN DOMAIN.' - write(0,*) 'REVERTING TO NEAREST GRIDPOINT METHOD.' - - mindist=9e15 - clon_nhc_rad=clon_nhc*deg2rad - clat_nhc_rad=clat_nhc*deg2rad - DO I=1,IMAX-1 - DO J=1,JMAX-1 - tmplat=(glat(i,j)+glat(i,j+1))/2*deg2rad - tmplon=(glon(i,j)+glon(i+1,j))/2*deg2rad - dist=calc_dist(tmplat,tmplon, - & clat_nhc_rad,clon_nhc_rad) - if(dist100000) then - write(6,*) 'NEAREST GRIDPOINT IS AT LEAST', - & '100 KM FROM NHC POINT. GIVING UP.' - write(0,*) 'NEAREST GRIDPOINT IS AT LEAST', - & '100 KM FROM NHC POINT. GIVING UP.' - stop 47 - endif + if(mindist>100000) then + write(6,*) 'NEAREST GRIDPOINT IS AT LEAST', & + '100 KM FROM NHC POINT. GIVING UP.' + write(0,*) 'NEAREST GRIDPOINT IS AT LEAST', & + '100 KM FROM NHC POINT. GIVING UP.' + stop 47 + endif endif - if( knhc-7<=1 .or. knhc+7>=imax .or. - & mnhc-7<=1 .or. mnhc+7>=jmax) then - write(6,*) 'NHC GRIDPOINT WITHIN 8 POINTS OF EDGE. ABORT!!' - write(0,*) 'NHC GRIDPOINT WITHIN 8 POINTS OF EDGE. ABORT!!' - write(6,*) 'knhc,mnhc,imax,jmax: ',knhc,mnhc,imax,jmax - write(0,*) 'knhc,mnhc,imax,jmax: ',knhc,mnhc,imax,jmax - stop 49 + if( knhc-7<=1 .or. knhc+7>=imax .or. & + mnhc-7<=1 .or. mnhc+7>=jmax) then + write(6,*) 'NHC GRIDPOINT WITHIN 8 POINTS OF EDGE. ABORT!!' + write(0,*) 'NHC GRIDPOINT WITHIN 8 POINTS OF EDGE. ABORT!!' + write(6,*) 'knhc,mnhc,imax,jmax: ',knhc,mnhc,imax,jmax + write(0,*) 'knhc,mnhc,imax,jmax: ',knhc,mnhc,imax,jmax + stop 49 endif IC1=KNHC+1 JC1=MNHC+1 - MDX=IFIX((CLON_NHC-CLON_NEW)/(GLON(IC1,MNHC)-GLON(KNHC,MNHC))) - MDY=IFIX((CLAT_NHC-CLAT_NEW)/(GLAT(KNHC,JC1)-GLAT(KNHC,MNHC))) + + MDX=INT((CLON_NHC-CLON_NEW)/(GLON(IC1,MNHC)-GLON(KNHC,MNHC))) + MDY=INT((CLAT_NHC-CLAT_NEW)/(GLAT(KNHC,JC1)-GLAT(KNHC,MNHC))) !234567890123456789012345678901234567890123456789012345678901234567890 @@ -2282,71 +2304,74 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, JNG6=0 DO J=1,JMAX - DO I=1,IMAX - - A = GLON(I,J) - CLON_NEW - B = GLAT(I,J) - CLAT_NEW - R = SQRT(A**2. + B**2.) - IF(R.EQ.0.) GO TO 444 - TH = ACOS(A/R) / RAD - IF(B.LT.0.) TH = 360-TH - - IF(TH.LE.7.5 .OR. TH.GT.352.5 ) IC = 1 - DO M2=2,24 - IF((TH.GT.(15.*(M2-1)-7.5)).and. - & (TH.LE.(15.*M2-7.5)))IC=M2 - END DO + DO I=1,IMAX -! print*,'R,R0(IC),ic=',R,R0(IC),ic + A = GLON(I,J) - CLON_NEW + B = GLAT(I,J) - CLAT_NEW + R = SQRT(A**2. + B**2.) + IF(R.EQ.0.) then +444 IB = IB+1 + ING(IB) = I + JNG(IB) = J + cycle + endif + TH = ACOS(A/R) / RAD + IF(B.LT.0.) TH = 360-TH + + IF(TH.LE.7.5 .OR. TH.GT.352.5 ) IC = 1 + DO M2=2,24 + IF((TH.GT.(15.*(M2-1)-7.5)).and. & + (TH.LE.(15.*M2-7.5)))IC=M2 + END DO - IF(R.LT.R0(IC)) THEN - IB = IB+1 - ING(IB) = I - JNG(IB) = J +! print*,'R,R0(IC),ic=',R,R0(IC),ic -! RRIJ(IB)=1. -! IF(R.GT.0.75*R0(IC))THEN -! RRIJ(IB)=(4.*(R0(IC)-R)/R0(IC))**2 -! END IF + IF(R.LT.R0(IC)) THEN + IB = IB+1 + ING(IB) = I + JNG(IB) = J - ENDIF +! RRIJ(IB)=1. +! IF(R.GT.0.75*R0(IC))THEN +! RRIJ(IB)=(4.*(R0(IC)-R)/R0(IC))**2 +! END IF -! IF(R.LT.(R0(IC)))THEN -! IB5=IB5+1 -! ING5(IB5)=I -! JNG5(IB5)=J -! RRIJ(IB5)=1. -! IF(R.GT.(R0(IC)-0.5))THEN -! WT2=min(1.0,(R0(IC)-R)/0.5) -! RRIJ(IB5)=WT2*WT2*(3.-2.*WT2) -! END IF -! END IF + ENDIF - IF((R.LT.R0(IC)).and.R.GT.(R0(IC)-0.8))THEN - IB5=IB5+1 - ING5(IB5)=I - JNG5(IB5)=J - WT2=min(1.0,(R0(IC)-R)/0.8) - RRIJ(IB5)=WT2*WT2*(3.-2.*WT2) - END IF +! IF(R.LT.(R0(IC)))THEN +! IB5=IB5+1 +! ING5(IB5)=I +! JNG5(IB5)=J +! RRIJ(IB5)=1. +! IF(R.GT.(R0(IC)-0.5))THEN +! WT2=min(1.0,(R0(IC)-R)/0.5) +! RRIJ(IB5)=WT2*WT2*(3.-2.*WT2) +! END IF +! END IF - IF((R.LT.R0(IC)).and.R.GT.(R0(IC)-0.2))THEN - IB6=IB6+1 - ING6(IB6)=I - JNG6(IB6)=J - END IF + IF((R.LT.R0(IC)).and.R.GT.(R0(IC)-0.8))THEN + IB5=IB5+1 + ING5(IB5)=I + JNG5(IB5)=J + WT2=min(1.0,(R0(IC)-R)/0.8) + RRIJ(IB5)=WT2*WT2*(3.-2.*WT2) + END IF - GO TO 22 + IF((R.LT.R0(IC)).and.R.GT.(R0(IC)-0.2))THEN + IB6=IB6+1 + ING6(IB6)=I + JNG6(IB6)=J + END IF -444 IB = IB+1 - ING(IB) = I - JNG(IB) = J +! +!444 IB = IB+1 +! ING(IB) = I +! JNG(IB) = J -! RRIJ(IB)=1. +! RRIJ(IB)=1. -22 CONTINUE - ENDDO + ENDDO ENDDO @@ -2354,38 +2379,40 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, zmax=0. DO J=1,JMAX - DO I=1,IMAX - - A = XLON1(I,J) - CLON_NEW - B = XLAT1(I,J) - CLAT_NEW - R = SQRT(A**2. + B**2.) - IF(R.EQ.0.) GO TO 866 - TH = ACOS(A/R) / RAD - IF(B.LT.0.) TH = 360-TH - - IF(TH.LE.7.5 .OR. TH.GT.352.5 ) IC = 1 - DO M2=2,24 - IF((TH.GT.(15.*(M2-1)-7.5)).and. - & (TH.LE.(15.*M2-7.5)))IC=M2 - END DO + DO I=1,IMAX -! print*,'R,R0(IC),ic=',R,R0(IC),ic + A = XLON1(I,J) - CLON_NEW + B = XLAT1(I,J) - CLAT_NEW + R = SQRT(A**2. + B**2.) + IF(R.EQ.0.) then +866 IBH = IBH+1 + ING3(IBH) = I + JNG3(IBH) = J + cycle + endif + TH = ACOS(A/R) / RAD + IF(B.LT.0.) TH = 360-TH + + IF(TH.LE.7.5 .OR. TH.GT.352.5 ) IC = 1 + DO M2=2,24 + IF((TH.GT.(15.*(M2-1)-7.5)).and. & + (TH.LE.(15.*M2-7.5)))IC=M2 + END DO - IF(R.LT.R0(IC)) THEN - IBH = IBH+1 - ING3(IBH) = I - JNG3(IBH) = J - if(zmax.lt.HDATN(i,j,1))zmax=HDATN(i,j,1) - ENDIF +! print*,'R,R0(IC),ic=',R,R0(IC),ic - GO TO 877 + IF(R.LT.R0(IC)) THEN + IBH = IBH+1 + ING3(IBH) = I + JNG3(IBH) = J + if(zmax.lt.HDATN(i,j,1))zmax=HDATN(i,j,1) + ENDIF -866 IBH = IBH+1 - ING3(IBH) = I - JNG3(IBH) = J -877 CONTINUE - ENDDO +!866 IBH = IBH+1 +! ING3(IBH) = I +! JNG3(IBH) = J + ENDDO ENDDO print*,'IB,IBH=',IB,IBH,NSG @@ -2404,9 +2431,9 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, IF(STMNAME(I).EQ.ST_NAME(KST))THEN IFWRT=0 DO J=1,7 - IF(ISTMCY1(J,I).EQ.0.and.ISTMCX1(J,I).EQ.0)THEN - IFWRT=1 - END IF + IF(ISTMCY1(J,I).EQ.0.and.ISTMCX1(J,I).EQ.0)THEN + IFWRT=1 + END IF END DO IF(IFWRT.EQ.1)THEN WRITE(55,101) TCVT(KST) @@ -2438,13 +2465,12 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, ISE=1 - DO 777 IV = 1,MTV6 - + do iv=1,mtv6 IREM = -22 IF(IV.GT.KDIV1.AND.IV.LE.KQ1)IREM=MOD(IV-KDIV1,4) - IF((IV.GE.2.AND.IV.LE.KDIV1).OR.(IV.GT.KQ1).OR. - & (IREM.EQ.1.OR.IREM.EQ.2)) THEN + IF((IV.GE.2.AND.IV.LE.KDIV1).OR.(IV.GT.KQ1).OR. & + (IREM.EQ.1.OR.IREM.EQ.2)) THEN ! print *,'ORIGINAL VARIABLE # IS ',IV ! added by Qingfu Liu @@ -2453,69 +2479,68 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, ISE=ISE+1 DO J=1,JX - DO I=1,IX - U(I,J)=SDAT(I,J,IV) - END DO + DO I=1,IX + U(I,J)=SDAT(I,J,IV) + END DO END DO ! First smooth in east-west direction - DO 107 J=1,JX - DO N=1,NF1 - XTU(1,N) = U(1,J) - XTU(IX,N) = U(IX,J) - ENDDO + do j=1,jx + DO N=1,NF1 + XTU(1,N) = U(1,J) + XTU(IX,N) = U(IX,J) + ENDDO - DO I=2,IX-1 - XTU(I,1) = U(I,J)+FK(1)*(U(I-1,J)+U(I+1,J)-2.*U(I,J)) - ENDDO + DO I=2,IX-1 + XTU(I,1) = U(I,J)+FK(1)*(U(I-1,J)+U(I+1,J)-2.*U(I,J)) + ENDDO - DO N=2,NF1 - DO I=2,IX-1 - XTU(I,N)=XTU(I,N-1)+FK(N)*(XTU(I-1,N-1)+XTU(I+1,N-1) - & -2.*XTU(I,N-1)) - ENDDO - ENDDO + DO N=2,NF1 + DO I=2,IX-1 + XTU(I,N)=XTU(I,N-1)+FK(N)*(XTU(I-1,N-1)+XTU(I+1,N-1) & + -2.*XTU(I,N-1)) + ENDDO + ENDDO - DO I=1,IX - US(I,J) = XTU(I,NF1) - ENDDO + DO I=1,IX + US(I,J) = XTU(I,NF1) + ENDDO - 107 CONTINUE + enddo !.. DO MERIDIONAL FILTER - DO 207 I=1,IX - - DO N=1,NF1 - YTU(1,N) = US(I,1) - YTU(JX,N) = US(I,JX) - ENDDO + do i=1,ix + DO N=1,NF1 + YTU(1,N) = US(I,1) + YTU(JX,N) = US(I,JX) + ENDDO - DO J = 2 , JX-1 - YTU(J,1) = US(I,J) + FK(1)*(US(I,J-1) + US(I,J+1) - & -2.*US(I,J)) - ENDDO + DO J = 2 , JX-1 + YTU(J,1) = US(I,J) + FK(1)*(US(I,J-1) + US(I,J+1) & + -2.*US(I,J)) + ENDDO - DO N = 2 , NF1 - DO J = 2 , JX-1 - YTU(J,N) = YTU(J,N-1) + FK(N)*(YTU(J-1,N-1) + - & YTU(J+1,N-1) - 2.*YTU(J,N-1)) - ENDDO - ENDDO + DO N = 2 , NF1 + DO J = 2 , JX-1 + YTU(J,N) = YTU(J,N-1) + FK(N)*(YTU(J-1,N-1) + & + YTU(J+1,N-1) - 2.*YTU(J,N-1)) + ENDDO + ENDDO - DO J = 1 , JX - US(I,J) = YTU(J,NF1) - ENDDO - 207 CONTINUE + DO J = 1 , JX + US(I,J) = YTU(J,NF1) + ENDDO + enddo -C.. GET THE DISTURBANCE FIELD -C +!C.. GET THE DISTURBANCE FIELD +!C DO I=1,IX - DO J=1,JX - DKY(I,J) = U(I,J) - US(I,J) - ENDDO + DO J=1,JX + DKY(I,J) = U(I,J) - US(I,J) + ENDDO ENDDO ! print*,'before call SEPAR',ISE @@ -2529,22 +2554,22 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, ! print*,'qliu test1' DO J=1,JX - DO I=1,IX -! SKIP(I,J)=DKM(I,J) -c SKIP(I,J)=U(I,J) - DKY(I,J) = DKM(I,J) + US(I,J) -c DKY(I,J) = U(I,J) - ENDDO + DO I=1,IX +! SKIP(I,J)=DKM(I,J) +!c SKIP(I,J)=U(I,J) + DKY(I,J) = DKM(I,J) + US(I,J) +!c DKY(I,J) = U(I,J) + ENDDO ENDDO ! Interpolate DKY to high resolution model grids DO J=1,JMAX - DO I=1,IMAX - DKY1(I,J)=HDATN(I,J,ISE) - SAVE1(I,J)=DKY1(I,J) - ENDDO + DO I=1,IMAX + DKY1(I,J)=HDATN(I,J,ISE) + SAVE1(I,J)=DKY1(I,J) + ENDDO ENDDO ! write(33)((SAVE1(I,J),I=1,IMAX),J=1,JMAX,2) @@ -2556,127 +2581,120 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, ! DO N=1,JMAX ! DO K=1,IMAX - DO M3=1,IB - N=JNG(M3) - K=ING(M3) - DO J=1,JX-1 - IF(GLAT(K,N).GE.ALAT(J).and.GLAT(K,N).LT.ALAT(J+1))THEN - DO I=1,IX-1 - IF(GLON(K,N).GE.ALON(I).and.GLON(K,N).LT.ALON(I+1))THEN - COEF1=(GLON(K,N)-ALON(I))/(ALON(I+1)-ALON(I)) - COEF2=(GLAT(K,N)-ALAT(J))/(ALAT(J+1)-ALAT(J)) - COEF3=(1.-COEF1)*(1.-COEF2) - DKY1(K,N)=COEF3*DKY(I,J)+ - & COEF1*(1.-COEF2)*DKY(I+1,J)+ - & COEF1*COEF2*DKY(I+1,J+1)+ - & (1.-COEF1)*COEF2*DKY(I,J+1) - GO TO 193 - END IF - END DO - END IF + DO M3=1,IB + N=JNG(M3) + K=ING(M3) + jloop: DO J=1,JX-1 + IF(GLAT(K,N).GE.ALAT(J).and.GLAT(K,N).LT.ALAT(J+1))THEN + DO I=1,IX-1 + IF(GLON(K,N).GE.ALON(I).and.GLON(K,N).LT.ALON(I+1))THEN + COEF1=(GLON(K,N)-ALON(I))/(ALON(I+1)-ALON(I)) + COEF2=(GLAT(K,N)-ALAT(J))/(ALAT(J+1)-ALAT(J)) + COEF3=(1.-COEF1)*(1.-COEF2) + DKY1(K,N)=COEF3*DKY(I,J)+ & + COEF1*(1.-COEF2)*DKY(I+1,J)+ & + COEF1*COEF2*DKY(I+1,J+1)+ & + (1.-COEF1)*COEF2*DKY(I,J+1) + exit jloop + END IF + END DO + END IF + END DO jloop END DO - 193 CONTINUE - END DO -! END DO -! END DO - DKM1=DKY1 + DKM1=DKY1 - DO I = 1,IB6 - IW = ING6(I) - JW = JNG6(I) - IF(MOD(JW,2) .NE. 0)THEN - DKM1(IW,JW)=0.2*(DKY1(IW,JW)+DKY1(IW,JW-1)+DKY1(IW,JW+1) - 1 +DKY1(IW+1,JW-1)+DKY1(IW+1,JW+1)) - ELSE - DKM1(IW,JW)=0.2*(DKY1(IW-1,JW-1)+DKY1(IW-1,JW+1) - 1 +DKY1(IW,JW-1)+DKY1(IW,JW+1)+DKY1(IW,JW)) - END IF - END DO + DO I = 1,IB6 + IW = ING6(I) + JW = JNG6(I) + IF(MOD(JW,2) .NE. 0)THEN + DKM1(IW,JW)=0.2*(DKY1(IW,JW)+DKY1(IW,JW-1)+DKY1(IW,JW+1) & + +DKY1(IW+1,JW-1)+DKY1(IW+1,JW+1)) + ELSE + DKM1(IW,JW)=0.2*(DKY1(IW-1,JW-1)+DKY1(IW-1,JW+1) & + +DKY1(IW,JW-1)+DKY1(IW,JW+1)+DKY1(IW,JW)) + END IF + END DO - DKY1=DKM1 + DKY1=DKM1 - DO I = 1,IB5 - IW = ING5(I) - JW = JNG5(I) - DKY1(IW,JW)=DKM1(IW,JW)*RRIJ(I)+HDATN(IW,JW,ISE)*(1.-RRIJ(I)) - END DO + DO I = 1,IB5 + IW = ING5(I) + JW = JNG5(I) + DKY1(IW,JW)=DKM1(IW,JW)*RRIJ(I)+HDATN(IW,JW,ISE)*(1.-RRIJ(I)) + END DO - DO J=1,JMAX - DO I=1,IMAX - SAVE1(I,J)=DKY1(I,J) - ENDDO - ENDDO + DO J=1,JMAX + DO I=1,IMAX + SAVE1(I,J)=DKY1(I,J) + ENDDO + ENDDO -! write(34)((SAVE1(I,J),I=1,IMAX),J=1,JMAX,2) +! write(34)((SAVE1(I,J),I=1,IMAX),J=1,JMAX,2) -! print*,'qliu test3' +! print*,'qliu test3' -!.. GET THE DISTURBANCE FIELD (High Resolution) +!.. GET THE DISTURBANCE FIELD (High Resolution) -! DO I=1,IMAX -! DO J=1,JMAX -! DKM1(I,J) = HDATN(I,J,ISE)-DKY1(I,J) -! ENDDO -! ENDDO +! DO I=1,IMAX +! DO J=1,JMAX +! DKM1(I,J) = HDATN(I,J,ISE)-DKY1(I,J) +! ENDDO +! ENDDO - ELSE + ELSE -! print*,'qliu test4' -! DO N=1,JMAX -! DO K=1,IMAX - DO M3=1,IBH - N=JNG3(M3) - K=ING3(M3) - DO J=1,JX-1 - IF(XLAT1(K,N).GE.ALAT(J).and.XLAT1(K,N).LT.ALAT(J+1))THEN - DO I=1,IX-1 - IF(XLON1(K,N).GE.ALON(I).and.XLON1(K,N).LT.ALON(I+1))THEN - COEF1=(XLON1(K,N)-ALON(I))/(ALON(I+1)-ALON(I)) - COEF2=(XLAT1(K,N)-ALAT(J))/(ALAT(J+1)-ALAT(J)) - COEF3=(1.-COEF1)*(1.-COEF2) - DKY1(K,N)=COEF3*DKY(I,J)+ - & COEF1*(1.-COEF2)*DKY(I+1,J)+ - & COEF1*COEF2*DKY(I+1,J+1)+ - & (1.-COEF1)*COEF2*DKY(I,J+1) - - GO TO 293 - END IF +! print*,'qliu test4' +! DO N=1,JMAX +! DO K=1,IMAX + M3loop: DO M3=1,IBH + N=JNG3(M3) + K=ING3(M3) + DO J=1,JX-1 + IF(XLAT1(K,N).GE.ALAT(J).and.XLAT1(K,N).LT.ALAT(J+1))THEN + DO I=1,IX-1 + IF(XLON1(K,N).GE.ALON(I).and.XLON1(K,N).LT.ALON(I+1))THEN + COEF1=(XLON1(K,N)-ALON(I))/(ALON(I+1)-ALON(I)) + COEF2=(XLAT1(K,N)-ALAT(J))/(ALAT(J+1)-ALAT(J)) + COEF3=(1.-COEF1)*(1.-COEF2) + DKY1(K,N)=COEF3*DKY(I,J)+ & + COEF1*(1.-COEF2)*DKY(I+1,J)+ & + COEF1*COEF2*DKY(I+1,J+1)+ & + (1.-COEF1)*COEF2*DKY(I,J+1) + cycle M3loop + END IF + END DO + END IF END DO - END IF - END DO - 293 CONTINUE - END DO -! END DO -! END DO + END DO M3loop - DKM1=DKY1 + DKM1=DKY1 - DO I = 1,IB6 - IW = ING6(I) - JW = JNG6(I) - IF(MOD(JW,2) .NE. 0)THEN - DKM1(IW,JW)=0.2*(DKY1(IW,JW)+DKY1(IW,JW-1)+DKY1(IW,JW+1) - 1 +DKY1(IW+1,JW-1)+DKY1(IW+1,JW+1)) - ELSE - DKM1(IW,JW)=0.2*(DKY1(IW-1,JW-1)+DKY1(IW-1,JW+1) - 1 +DKY1(IW,JW-1)+DKY1(IW,JW+1)+DKY1(IW,JW)) - END IF - END DO + DO I = 1,IB6 + IW = ING6(I) + JW = JNG6(I) + IF(MOD(JW,2) .NE. 0)THEN + DKM1(IW,JW)=0.2*(DKY1(IW,JW)+DKY1(IW,JW-1)+DKY1(IW,JW+1) & + +DKY1(IW+1,JW-1)+DKY1(IW+1,JW+1)) + ELSE + DKM1(IW,JW)=0.2*(DKY1(IW-1,JW-1)+DKY1(IW-1,JW+1) & + +DKY1(IW,JW-1)+DKY1(IW,JW+1)+DKY1(IW,JW)) + END IF + END DO - DKY1=DKM1 + DKY1=DKM1 - DO I = 1,IB5 - IW = ING5(I) - JW = JNG5(I) - DKY1(IW,JW)=DKM1(IW,JW)*RRIJ(I)+HDATN(IW,JW,ISE)*(1.-RRIJ(I)) - END DO + DO I = 1,IB5 + IW = ING5(I) + JW = JNG5(I) + DKY1(IW,JW)=DKM1(IW,JW)*RRIJ(I)+HDATN(IW,JW,ISE)*(1.-RRIJ(I)) + END DO - DO J=1,JMAX - DO I=1,IMAX - SAVE1(I,J)=DKY1(I,J) - ENDDO - ENDDO + DO J=1,JMAX + DO I=1,IMAX + SAVE1(I,J)=DKY1(I,J) + ENDDO + ENDDO ! print*,'qliu test5' @@ -2694,50 +2712,55 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, DO J=1,JMAX - DO I=1,IMAX - ENV1(I,J,ISE) = DKY1(I,J) - ENDDO + DO I=1,IMAX + ENV1(I,J,ISE) = DKY1(I,J) + ENDDO ENDDO DO J=1,JMAX - DO I=1,IMAX - SAVE1(I,J)=ENV1(I,J,ISE) - ENDDO + DO I=1,IMAX + SAVE1(I,J)=ENV1(I,J,ISE) + ENDDO ENDDO ! write(29)((SAVE1(I,J),I=1,IMAX),J=1,JMAX,2) ENDIF - - 777 CONTINUE + enddo !777 ! print*,'qliu test3' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - NCHT=71 - WRITE(NCHT)ST_NAME(KST) - - WRITE(NCHT)CLON_NEW,CLAT_NEW,CLON_NHC,CLAT_NHC - WRITE(NCHT)zmax - - IWMAX=0. - IWMIN=1000. - JWMAX=0. - JWMIN=1000. - DO I = 1,IB - IW = ING(I) - JW = JNG(I) - IF(IWMAX.LT.IW)IWMAX=IW - IF(IWMIN.GT.IW)IWMIN=IW - IF(JWMAX.LT.JW)JWMAX=JW - IF(JWMIN.GT.JW)JWMIN=JW - END DO - IWMAX1=IWMAX+4 - IWMIN1=IWMIN-4 - JWMAX1=JWMAX+4 - JWMIN1=JWMIN-4 + NCHT=71 + WRITE(NCHT)ST_NAME(KST) + + WRITE(NCHT)CLON_NEW,CLAT_NEW,CLON_NHC,CLAT_NHC + WRITE(NCHT)zmax + +! IWMAX=0. +! IWMIN=1000. +! JWMAX=0. +! JWMIN=1000. + + IWMAX=0 + IWMIN=1000 + JWMAX=0 + JWMIN=1000 + + DO I = 1,IB + IW = ING(I) + JW = JNG(I) + IF(IWMAX.LT.IW)IWMAX=IW + IF(IWMIN.GT.IW)IWMIN=IW + IF(JWMAX.LT.JW)JWMAX=JW + IF(JWMIN.GT.JW)JWMIN=JW + END DO + IWMAX1=IWMAX+4 + IWMIN1=IWMIN-4 + JWMAX1=JWMAX+4 + JWMIN1=JWMIN-4 IGU=IMAX @@ -2747,42 +2770,42 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, KQ2=KDIV2+4*KMAX ISE = 1 - DO 781 IV = 1,MTV6 + do iv=1,mtv6 + IREM = -22 - IREM = -22 + IF(IV.GT.KDIV2.AND.IV.LE.KQ2)IREM=MOD(IV-KDIV2,4) + IF((IV.GE.2.AND.IV.LE.KDIV2).OR.(IV.GT.KQ2).OR. & + (IREM.EQ.1.OR.IREM.EQ.2)) THEN + ISE = ISE+1 - IF(IV.GT.KDIV2.AND.IV.LE.KQ2)IREM=MOD(IV-KDIV2,4) - IF((IV.GE.2.AND.IV.LE.KDIV2).OR.(IV.GT.KQ2).OR. - & (IREM.EQ.1.OR.IREM.EQ.2)) THEN - ISE = ISE+1 + print*,'ISE,IV=',ISE,IV - print*,'ISE,IV=',ISE,IV + DDAT=0. - DDAT=0. - - DO J=1,JMAX - DO I=1,IMAX - DATG(I,J)=ENV1(I,J,ISE) - DATG2(I,J)=HDATN(I,J,ISE) - ENDDO - ENDDO + DO J=1,JMAX + DO I=1,IMAX + DATG(I,J)=ENV1(I,J,ISE) + DATG2(I,J)=HDATN(I,J,ISE) + ENDDO + ENDDO - DDAT=0. - SAVE1=0. + DDAT=0. + SAVE1=0. ! RDIST2=AMDX*AMDX+AMDY*AMDY ! IF(RDIST2.GT.0.02)THEN - IF(ISE.GE.2)THEN + IF(ISE.GE.2)THEN + DO J=1,JMAX + DO I=1,IMAX + DDAT(I,J)=DATG2(I,J)-DATG(I,J) + ENDDO + ENDDO + END IF + DO J=1,JMAX - DO I=1,IMAX - DDAT(I,J)=DATG2(I,J)-DATG(I,J) - ENDDO + DO I=1,IMAX + SAVE1(I,J)=DDAT(I,J) + ENDDO ENDDO - END IF - DO J=1,JMAX - DO I=1,IMAX - SAVE1(I,J)=DDAT(I,J) - ENDDO - ENDDO ! DO I = 1,IB ! IW = ING(I) ! JW = JNG(I) @@ -2791,196 +2814,204 @@ SUBROUTINE hurr_move(ITIM,KST,IMAX,JMAX,KMAX,MTV6,MTV4,SDAT, ! END IF - IF(ISE.EQ.2) THEN - DO J=1,JMAX - DO I=1,IMAX - HDATN(I,J,ISE)=DATG(I,J) - ENDDO - ENDDO - END IF - - IF(ISE.GE.3.and.ISE.LE.(KMAX+2))then - - IF(IFLAG.EQ.1)THEN - DO J=1,JMAX - DO I=1,IMAX - HDATN(I,J,ISE)=DATG2(I,J) - ENDDO - ENDDO - SAVE1=0. - ELSE - DO J=1,JMAX - DO I=1,IMAX - HDATN(I,J,ISE)=DATG(I,J) - ENDDO - ENDDO - END IF + IF(ISE.EQ.2) THEN + DO J=1,JMAX + DO I=1,IMAX + HDATN(I,J,ISE)=DATG(I,J) + ENDDO + ENDDO + END IF - END IF + IF(ISE.GE.3.and.ISE.LE.(KMAX+2))then - IF(ISE.GT.(KMAX+2).and.ISE.LE.(3*KMAX+2))THEN + IF(IFLAG.EQ.1)THEN + DO J=1,JMAX + DO I=1,IMAX + HDATN(I,J,ISE)=DATG2(I,J) + ENDDO + ENDDO + SAVE1=0. + ELSE + DO J=1,JMAX + DO I=1,IMAX + HDATN(I,J,ISE)=DATG(I,J) + ENDDO + ENDDO + END IF - DO J=1,JMAX - DO I=1,IMAX - HDATN(I,J,ISE)=DATG(I,J) - ENDDO - ENDDO + END IF - ENDIF + IF(ISE.GT.(KMAX+2).and.ISE.LE.(3*KMAX+2))THEN - IF(ISE.GT.(3*KMAX+2))THEN - IF(IFLAG.EQ.1)THEN - DO J=1,JMAX - DO I=1,IMAX - HDATN(I,J,ISE)=DATG2(I,J) - ENDDO - ENDDO - SAVE1=0. - ELSE - DO J=1,JMAX - DO I=1,IMAX - HDATN(I,J,ISE)=DATG(I,J) - SAVE1(I,J)=SAVE1(I,J)*1.E3 - ENDDO - ENDDO - END IF - ENDIF + DO J=1,JMAX + DO I=1,IMAX + HDATN(I,J,ISE)=DATG(I,J) + ENDDO + ENDDO + + ENDIF + + IF(ISE.GT.(3*KMAX+2))THEN + IF(IFLAG.EQ.1)THEN + DO J=1,JMAX + DO I=1,IMAX + HDATN(I,J,ISE)=DATG2(I,J) + ENDDO + ENDDO + SAVE1=0. + ELSE + DO J=1,JMAX + DO I=1,IMAX + HDATN(I,J,ISE)=DATG(I,J) + SAVE1(I,J)=SAVE1(I,J)*1.E3 + ENDDO + ENDDO + END IF + ENDIF - IF(ISE.EQ.2)THEN - WRITE(NCHT)IWMIN1,IWMAX1,JWMIN1,JWMAX1 - DO J=1,JMAX - DO I=1,IMAX - SAVE2(I,J)=DATG(I,J) - END DO - END DO - WRITE(NCHT)((SAVE2(I,J),I=1,IMAX),J=1,JMAX) ! PSL - END IF -! IF(ISE.EQ.3)THEN - IF(ISE.GE.3.and.ISE.LE.(KMAX+2))THEN - IF(IFLAG.EQ.1)THEN + IF(ISE.EQ.2)THEN + WRITE(NCHT)IWMIN1,IWMAX1,JWMIN1,JWMAX1 DO J=1,JMAX - DO I=1,IMAX - SAVE2(I,J)=DATG2(I,J) - END DO - END DO - ELSE - DO J=1,JMAX - DO I=1,IMAX - SAVE2(I,J)=DATG(I,J) - END DO + DO I=1,IMAX + SAVE2(I,J)=DATG(I,J) + END DO END DO + WRITE(NCHT)((SAVE2(I,J),I=1,IMAX),J=1,JMAX) ! PSL END IF - WRITE(NCHT)((SAVE2(I,J),I=1,IMAX),J=1,JMAX) ! T1 - END IF - WRITE(NCHT)((SAVE1(I,J),I=IWMIN1,IWMAX1),J=JWMIN1,JWMAX1) - -! PRINT*,'TEST ISE=',ISE +! IF(ISE.EQ.3)THEN + IF(ISE.GE.3.and.ISE.LE.(KMAX+2))THEN + IF(IFLAG.EQ.1)THEN + DO J=1,JMAX + DO I=1,IMAX + SAVE2(I,J)=DATG2(I,J) + END DO + END DO + ELSE + DO J=1,JMAX + DO I=1,IMAX + SAVE2(I,J)=DATG(I,J) + END DO + END DO + END IF + WRITE(NCHT)((SAVE2(I,J),I=1,IMAX),J=1,JMAX) ! T1 + END IF + WRITE(NCHT)((SAVE1(I,J),I=IWMIN1,IWMAX1),J=JWMIN1,JWMAX1) - WRITE(25)((SAVE1(I,J),I=1,IMAX),J=1,JMAX,2) +! PRINT*,'TEST ISE=',ISE - ENDIF + WRITE(25)((SAVE1(I,J),I=1,IMAX),J=1,JMAX,2) - 781 CONTINUE - - 788 CONTINUE + ENDIF + enddo !781 DEALLOCATE ( SAVE1, SAVE2 ) deallocate (DATG,DATG2,DDAT) deallocate (ENV1) - end + end SUBROUTINE hurr_move SUBROUTINE TWIND(UD,VD,TW) - PARAMETER (IX=41,JX=41,NF=11,IT=24,IR=120) - DIMENSION UD(IX,JX),VD(IX,JX),TW(IT,IR),R0(IT) - COMMON /POSIT/CLON_NEW,CLAT_NEW,SLON,SLAT,CLON,CLAT,RAD - COMMON /vect/R0,XVECT(IT),YVECT(IT) + use posit + use vect + implicit none + integer,PARAMETER:: IX=41,JX=41,NF=11,IT=24,IR=120 + real UD,VD,TW + DIMENSION UD(IX,JX),VD(IX,JX),TW(IT,IR) + + real DR,DD,DLON,DLAT,TLAT,TLON,X1,X2,Y1,Y2,UT,VT, DXX,DYY + + integer I,J,IDX,IDY print*,'CLON_NEW,CLAT_NEW,RAD=',CLON_NEW,CLAT_NEW,RAD DO J=1,IR - DO I=1,IT + DO I=1,IT !.. DETERMINE LAT, LON AREOUND CIRCLE - DR = 0.1*J - DD = (I-1)*15.*RAD - DLON = DR*COS(DD) - DLAT = DR*SIN(DD) - TLON = CLON_NEW + DLON - TLAT = CLAT_NEW + DLAT + DR = 0.1*J + DD = (I-1)*15.*RAD + DLON = DR*COS(DD) + DLAT = DR*SIN(DD) + TLON = CLON_NEW + DLON + TLAT = CLAT_NEW + DLAT !.. INTERPOLATION U, V AT TLON,TLAT AND CLACULATE TANGENTIAL WIND - IDX = floor(TLON) - SLON + 1 - IDY = floor(TLAT) - SLAT + 1 - TW(I,J)=0. - IF(IDX.GE.1.and.IDX.LT.IX.and.IDY.GE.1.and.IDY.LT.JX)THEN - DXX = TLON - floor(TLON) - DYY = TLAT - floor(TLAT) - X1 = UD(IDX ,IDY+1)*DYY + UD(IDX ,IDY)*(1-DYY) - X2 = UD(IDX+1,IDY+1)*DYY + UD(IDX+1,IDY)*(1-DYY) - Y1 = UD(IDX+1,IDY )*DXX + UD(IDX,IDY )*(1-DXX) - Y2 = UD(IDX+1,IDY+1)*DXX + UD(IDX,IDY+1)*(1-DXX) - UT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. - IF(I.EQ.0.OR.I.EQ.13) UT = Y1 - IF(I.EQ.7.OR.I.EQ.19) UT = X1 - X1 = VD(IDX ,IDY+1)*DYY + VD(IDX ,IDY)*(1-DYY) - X2 = VD(IDX+1,IDY+1)*DYY + VD(IDX+1,IDY)*(1-DYY) - Y1 = VD(IDX+1,IDY )*DXX + VD(IDX,IDY )*(1-DXX) - Y2 = VD(IDX+1,IDY+1)*DXX + VD(IDX,IDY+1)*(1-DXX) - VT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. - IF(I.EQ.0.OR.I.EQ.13) VT = Y1 - IF(I.EQ.7.OR.I.EQ.19) VT = X1 + IDX = floor(TLON) - SLON + 1 + IDY = floor(TLAT) - SLAT + 1 + TW(I,J)=0. + IF(IDX.GE.1.and.IDX.LT.IX.and.IDY.GE.1.and.IDY.LT.JX)THEN + DXX = TLON - floor(TLON) + DYY = TLAT - floor(TLAT) + X1 = UD(IDX ,IDY+1)*DYY + UD(IDX ,IDY)*(1-DYY) + X2 = UD(IDX+1,IDY+1)*DYY + UD(IDX+1,IDY)*(1-DYY) + Y1 = UD(IDX+1,IDY )*DXX + UD(IDX,IDY )*(1-DXX) + Y2 = UD(IDX+1,IDY+1)*DXX + UD(IDX,IDY+1)*(1-DXX) + UT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. + IF(I.EQ.0.OR.I.EQ.13) UT = Y1 + IF(I.EQ.7.OR.I.EQ.19) UT = X1 + X1 = VD(IDX ,IDY+1)*DYY + VD(IDX ,IDY)*(1-DYY) + X2 = VD(IDX+1,IDY+1)*DYY + VD(IDX+1,IDY)*(1-DYY) + Y1 = VD(IDX+1,IDY )*DXX + VD(IDX,IDY )*(1-DXX) + Y2 = VD(IDX+1,IDY+1)*DXX + VD(IDX,IDY+1)*(1-DXX) + VT = (X1*(1-DXX)+X2*DXX + Y1*(1-DYY)+Y2*DYY)/2. + IF(I.EQ.0.OR.I.EQ.13) VT = Y1 + IF(I.EQ.7.OR.I.EQ.19) VT = X1 !.. TANGENTIAL WIND - TW(I,J) = -SIN(DD)*UT + COS(DD)*VT - END IF - if(j.eq.1)then - print*,'TW(I,J),UT,VT=',I,J,TW(I,J),UT,VT,DD - & ,IDX,IDY,DLON,TLON,CLON_NEW,SLON - end if - + TW(I,J) = -SIN(DD)*UT + COS(DD)*VT + END IF + if(j.eq.1)then + print*,'TW(I,J),UT,VT=',I,J,TW(I,J),UT,VT,DD & + ,IDX,IDY,DLON,TLON,CLON_NEW,SLON + end if ! for SH - ENDDO + ENDDO ENDDO IF(CLAT_NEW.LT.0)THEN DO J=1,IR - DO I=1,IT - TW(I,J)=-TW(I,J) - ENDDO + DO I=1,IT + TW(I,J)=-TW(I,J) + ENDDO ENDDO END IF ! SH RETURN - END + END SUBROUTINE TWIND SUBROUTINE STRT_PT(RMX,TW,RFAVG) + implicit none + + integer, PARAMETER :: IX=41,JX=41,NF=11,IT=24,IR=120 + integer I, J, K, ICK, ICL, LL, MR, IRA, IRB, IK, KK, JJ - PARAMETER (IX=41,JX=41,NF=11,IT=24,IR=120) + real TM, TMX, JXX, RF, RFAVG, RA, RB, DXX, DV, DVDR, RM, CNT + real TWM, TMXX, RMX + real TW DIMENSION TW(IT,IR),TWM(IR),TMXX(IT),RMX(IT) REAL JMX DO I=1,IR - TWM(I) = 0. + TWM(I) = 0. ENDDO !.. CALCULATE MEAN TANGENTIAL WIND - DO 10 J=1,IR - TM=0. - DO 20 I=1,IT - TM = TM + TW(I,J) -20 CONTINUE - TWM(J) = TM/24. - print *,'MEAN TANGENTIAL WIND ',J,TWM(J) -10 CONTINUE + do j=1,ir + TM=0. + do i=1,it + TM = TM + TW(I,J) + enddo + TWM(J) = TM/24. + print *,'MEAN TANGENTIAL WIND ',J,TWM(J) + enddo !.. FIND MAXIMUM TANGENTIAL WIND RADIUS TMX=-100000000000. DO J=1,IR - IF(TWM(J).GE.TMX) THEN - TMX=TWM(J) - JMX = J*0.1 - ENDIF + IF(TWM(J).GE.TMX) THEN + TMX=TWM(J) + JMX = J*0.1 + ENDIF ENDDO print *,'MAXIMUM TANGENTIAL WIND RADIUS ',JMX @@ -2994,30 +3025,28 @@ SUBROUTINE STRT_PT(RMX,TW,RFAVG) CNT = 0.000004 !c print *,'CNT ',CNT - DO 30 K=JXX,120 - IF(TWM(K).GE.6..OR.TWM(K).LT.3.) GO TO 30 - DXX = 10000. - DV = TWM(K) - TWM(K+1) - DVDR = DV/DXX - IF(DVDR.LT.CNT) ICK = ICK+1 - IF(ICK.EQ.3) THEN - RF=K*0.1 - GO TO 40 - ENDIF -30 CONTINUE + do k=jxx,120 + IF(TWM(K).GE.6..OR.TWM(K).LT.3.) cycle + DXX = 10000. + DV = TWM(K) - TWM(K+1) + DVDR = DV/DXX + IF(DVDR.LT.CNT) ICK = ICK+1 + IF(ICK.EQ.3) THEN + RF=K*0.1 + exit + ENDIF + enddo -40 CONTINUE IF(ICK.NE.3) THEN - DO IK=JXX,120 - IF(TWM(IK).LE.3) THEN - RF = IK*0.1 - ICK=3 - GO TO 50 - ENDIF - ENDDO + DO IK=JXX,120 + IF(TWM(IK).LE.3) THEN + RF = IK*0.1 + ICK=3 + exit + ENDIF + ENDDO ENDIF -50 CONTINUE IF(ICK.NE.3) RF = 12. RFAVG = RF @@ -3034,13 +3063,13 @@ SUBROUTINE STRT_PT(RMX,TW,RFAVG) !.. DETERMINE STARTING POINT FOR EVERY 24 DIRECTION DO I=1,IT - TMXX(I) = -100000000. - DO J=1,IR - IF(TW(I,J).GE.TMXX(I)) THEN - TMXX(I) = TW(I,J) - RMX(I) = J*0.1*1.1 - ENDIF - ENDDO + TMXX(I) = -100000000. + DO J=1,IR + IF(TW(I,J).GE.TMXX(I)) THEN + TMXX(I) = TW(I,J) + RMX(I) = J*0.1*1.1 + ENDIF + ENDDO ENDDO !c DO I=1,IT @@ -3048,18 +3077,18 @@ SUBROUTINE STRT_PT(RMX,TW,RFAVG) !c ENDDO DO I=1,IT - IF (RMX(I).GT.RB.OR.RMX(I).LT.RA) THEN - TMX = -10000000. - DO KK=IRA,IRB - IF(TW(I,KK).GE.TMX) RM = KK * 0.1 * 1.1 - ENDDO - MR = IFIX(RM*10. + 0.5) - ICL=0 - DO LL = MR,IRB - IF(TW(I,LL).LT.0.) ICL=ICL+1 - ENDDO - IF(ICL.EQ.0) RMX(I) = RM*1.1 - ENDIF + IF (RMX(I).GT.RB.OR.RMX(I).LT.RA) THEN + TMX = -10000000. + DO KK=IRA,IRB + IF(TW(I,KK).GE.TMX) RM = KK * 0.1 * 1.1 + ENDDO + MR = IFIX(RM*10. + 0.5) + ICL=0 + DO LL = MR,IRB + IF(TW(I,LL).LT.0.) ICL=ICL+1 + ENDDO + IF(ICL.EQ.0) RMX(I) = RM*1.1 + ENDIF ENDDO !c DO I=1,IT @@ -3067,59 +3096,63 @@ SUBROUTINE STRT_PT(RMX,TW,RFAVG) !c ENDDO RETURN - END + END SUBROUTINE STRT_PT SUBROUTINE FILTER(RS,TW,RF,RFAVG,KST,IBGS,IVOBS,iflag_cold) - PARAMETER (IX=41,JX=41,IT=24,IR=120,NST=10) - - DIMENSION RS(IT),TW(IT,IR),RF(IT),R0(IT),IST(IT) + use vect + use rsfc + implicit none + integer, PARAMETER:: IX=41,JX=41,IT=24,IR=120 +! integer, PARAMETER:: NST=10 + integer I, ICK, K, IK, IS, KST, IBGS, IVOBS, iflag_cold + + real DXX, DV, CNT, IST, RMN, DVDR, RFAVG, RMN_FACT, RMN_HWRF + + real RS, RF + real TW + DIMENSION RS(IT),TW(IT,IR),RF(IT),IST(IT) + real R01 DIMENSION R01(IT) - COMMON /vect/R0,XVECT(IT),YVECT(IT) - COMMON /RSFC/STRPSF(NST),STVMAX(NST),STRPSF_06(NST) - -! REAL(4) RMN,RMN_HWRF ICK = 1 CNT = 0.000004 ! print *,'CNT ',CNT DO I=1,IT - IST(I) = IFIX(RS(I)*10) + IST(I) = IFIX(RS(I)*10) !c print *,'STARTING POINT ',I,IST(I) ENDDO - DO 100 I=1,IT - IS = IST(I) + iloop: do i=1,it + IS = IST(I) !CWH DO 30 K=IS,IR - DO 30 K=IS,IR-1 - IF(TW(I,K).GE.6..OR.TW(I,K).LT.3.) GO TO 30 - DXX = 10000. - DV = TW(I,K) - TW(I,K+1) - DVDR = DV/DXX - IF(DVDR.LT.CNT) THEN - ICK = ICK+1 - ENDIF - IF(ICK.EQ.3) THEN - RF(I)=K*0.1 + 0.0000001 -!c print *,'1st Catagory ',I - GO TO 100 - ENDIF -30 CONTINUE - -40 CONTINUE - DO IK=IS,IR - IF(TW(I,IK).LE.3) THEN - RF(I) = IK*0.1 + 0.00000001 + kloop: do k=is,ir-1 + IF(TW(I,K).GE.6..OR.TW(I,K).LT.3.) cycle kloop + DXX = 10000. + DV = TW(I,K) - TW(I,K+1) + DVDR = DV/DXX + IF(DVDR.LT.CNT) THEN + ICK = ICK+1 + ENDIF + IF(ICK.EQ.3) THEN + RF(I)=K*0.1 + 0.0000001 +!c print *,'1st Catagory ',I + cycle iloop + ENDIF + enddo kloop + + DO IK=IS,IR + IF(TW(I,IK).LE.3) THEN + RF(I) = IK*0.1 + 0.00000001 !c print *,'2nd Catagory ',I - GO TO 100 - ENDIF - ENDDO + cycle iloop + ENDIF + ENDDO -50 CONTINUE !c print *,'3rd Catagory ',I - RF(I) = 10. -100 CONTINUE + RF(I) = 10. + enddo iloop !c RMAX=0. DO I=1,IT @@ -3136,18 +3169,19 @@ SUBROUTINE FILTER(RS,TW,RF,RFAVG,KST,IBGS,IVOBS,iflag_cold) RMN=RMN+RF(I) END DO RMN=RMN/FLOAT(IT) + DO I=1,IT IF(RF(I).GT.2.5*RMN)RF(I)=2.5*RMN IF(RF(I).LT.0.4*RMN)RF(I)=0.4*RMN END DO - DO I=2,IT-1 - R01(I)=(RF(I)+RF(I-1)+RF(I+1))/3. - END DO - R01(1)=(RF(1)+RF(IT)+RF(2))/3. - R01(IT)=(RF(IT)+RF(IT-1)+RF(1))/3. + DO I=2,IT-1 + R01(I)=(RF(I)+RF(I-1)+RF(I+1))/3. + END DO + R01(1)=(RF(1)+RF(IT)+RF(2))/3. + R01(IT)=(RF(IT)+RF(IT-1)+RF(1))/3. - RF=R01 + RF=R01 IF(IBGS.eq.0)THEN @@ -3246,11 +3280,12 @@ SUBROUTINE FILTER(RS,TW,RF,RFAVG,KST,IBGS,IVOBS,iflag_cold) ENDDO RETURN - END + END SUBROUTINE FILTER !! subroutine 'get_eta_level' returns the interface and !! layer-mean pressures for reference. subroutine get_eta_level(npz, p_s, pf, ph, ak, bk, pscale) + implicit none integer, intent(in) :: npz real(4), intent(in) :: p_s !< unit: pascal real(4), intent(in) :: ak(npz+1) @@ -3293,6 +3328,7 @@ real function calc_dist(lat1,lon1,lat2,lon2) ! Earth radius from WRF-NMM module_model_constants.F as of HWRF R2 ! (WRF-NMM 3.2): + implicit none real, parameter :: Rearth = 6370e3 real, intent(in) :: lat1,lat2,lon1,lon2 diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotm.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotm.f deleted file mode 100644 index 50bac19fa..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotm.f +++ /dev/null @@ -1,106 +0,0 @@ - SUBROUTINE SROTM (N,SX,INCX,SY,INCY,SPARAM) -C -C APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX -C -C (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN -C (DX**T) -C -C SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE -C LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. -C WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. -C -C SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 -C -C (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) -C H=( ) ( ) ( ) ( ) -C (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). -C SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. -C - DIMENSION SX(1),SY(1),SPARAM(5) - DATA ZERO,TWO/0.E0,2.E0/ -C - SFLAG=SPARAM(1) - IF(N .LE. 0 .OR.(SFLAG+TWO.EQ.ZERO)) GO TO 140 - IF(.NOT.(INCX.EQ.INCY.AND. INCX .GT.0)) GO TO 70 -C - NSTEPS=N*INCX - IF(SFLAG) 50,10,30 - 10 CONTINUE - SH12=SPARAM(4) - SH21=SPARAM(3) - DO 20 I=1,NSTEPS,INCX - W=SX(I) - Z=SY(I) - SX(I)=W+Z*SH12 - SY(I)=W*SH21+Z - 20 CONTINUE - GO TO 140 - 30 CONTINUE - SH11=SPARAM(2) - SH22=SPARAM(5) - DO 40 I=1,NSTEPS,INCX - W=SX(I) - Z=SY(I) - SX(I)=W*SH11+Z - SY(I)=-W+SH22*Z - 40 CONTINUE - GO TO 140 - 50 CONTINUE - SH11=SPARAM(2) - SH12=SPARAM(4) - SH21=SPARAM(3) - SH22=SPARAM(5) - DO 60 I=1,NSTEPS,INCX - W=SX(I) - Z=SY(I) - SX(I)=W*SH11+Z*SH12 - SY(I)=W*SH21+Z*SH22 - 60 CONTINUE - GO TO 140 - 70 CONTINUE - KX=1 - KY=1 - IF(INCX .LT. 0) KX=1+(1-N)*INCX - IF(INCY .LT. 0) KY=1+(1-N)*INCY -C - IF(SFLAG)120,80,100 - 80 CONTINUE - SH12=SPARAM(4) - SH21=SPARAM(3) - DO 90 I=1,N - W=SX(KX) - Z=SY(KY) - SX(KX)=W+Z*SH12 - SY(KY)=W*SH21+Z - KX=KX+INCX - KY=KY+INCY - 90 CONTINUE - GO TO 140 - 100 CONTINUE - SH11=SPARAM(2) - SH22=SPARAM(5) - DO 110 I=1,N - W=SX(KX) - Z=SY(KY) - SX(KX)=W*SH11+Z - SY(KY)=-W+SH22*Z - KX=KX+INCX - KY=KY+INCY - 110 CONTINUE - GO TO 140 - 120 CONTINUE - SH11=SPARAM(2) - SH12=SPARAM(4) - SH21=SPARAM(3) - SH22=SPARAM(5) - DO 130 I=1,N - W=SX(KX) - Z=SY(KY) - SX(KX)=W*SH11+Z*SH12 - SY(KY)=W*SH21+Z*SH22 - KX=KX+INCX - KY=KY+INCY - 130 CONTINUE - 140 CONTINUE - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotm.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotm.f90 new file mode 100644 index 000000000..cad77361c --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotm.f90 @@ -0,0 +1,110 @@ + SUBROUTINE SROTM (N,SX,INCX,SY,INCY,SPARAM) + implicit none +!C +!C APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX +!C +!C (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN +!C (DX**T) +!C +!C SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE +!C LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. +!C WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +!C +!C SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 +!C +!C (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) +!C H=( ) ( ) ( ) ( ) +!C (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). +!C SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. +!C + integer incx,incy,n,i,kx,ky,nsteps + real,DIMENSION(1):: SX(*),SY(*) + real, dimension(5):: SPARAM(5) + real zero,two,sflag,w,z,sh11,sh12,sh21,sh22 + DATA ZERO,TWO/0.E0,2.E0/ +!C + SFLAG=SPARAM(1) + IF(N .LE. 0 .OR.(SFLAG+TWO.EQ.ZERO)) then + return + endif + IF((INCX.EQ.INCY.AND. INCX .GT.0)) then + NSTEPS=N*INCX + if(sflag.eq.0) then + SH12=SPARAM(4) + SH21=SPARAM(3) + DO I=1,NSTEPS,INCX + W=SX(I) + Z=SY(I) + SX(I)=W+Z*SH12 + SY(I)=W*SH21+Z + enddo + return + else if(sflag.gt.0) then + SH11=SPARAM(2) + SH22=SPARAM(5) + DO I=1,NSTEPS,INCX + W=SX(I) + Z=SY(I) + SX(I)=W*SH11+Z + SY(I)=-W+SH22*Z + enddo + return + else + SH11=SPARAM(2) + SH12=SPARAM(4) + SH21=SPARAM(3) + SH22=SPARAM(5) + DO I=1,NSTEPS,INCX + W=SX(I) + Z=SY(I) + SX(I)=W*SH11+Z*SH12 + SY(I)=W*SH21+Z*SH22 + enddo + return + endif + else + KX=1 + KY=1 + IF(INCX .LT. 0) KX=1+(1-N)*INCX + IF(INCY .LT. 0) KY=1+(1-N)*INCY + if(sflag.eq.0) then + SH12=SPARAM(4) + SH21=SPARAM(3) + do i=1,n + W=SX(KX) + Z=SY(KY) + SX(KX)=W+Z*SH12 + SY(KY)=W*SH21+Z + KX=KX+INCX + KY=KY+INCY + enddo + return + else if(sflag.gt.0) then + SH11=SPARAM(2) + SH22=SPARAM(5) + do i=1,n + W=SX(KX) + Z=SY(KY) + SX(KX)=W*SH11+Z + SY(KY)=-W+SH22*Z + KX=KX+INCX + KY=KY+INCY + enddo + return + else + SH11=SPARAM(2) + SH12=SPARAM(4) + SH21=SPARAM(3) + SH22=SPARAM(5) + do i=1,n + W=SX(KX) + Z=SY(KY) + SX(KX)=W*SH11+Z*SH12 + SY(KY)=W*SH21+Z*SH22 + KX=KX+INCX + KY=KY+INCY + enddo + endif + endif + RETURN + END SUBROUTINE SROTM diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotmg.f b/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotmg.f deleted file mode 100644 index 24243a13c..000000000 --- a/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotmg.f +++ /dev/null @@ -1,166 +0,0 @@ - SUBROUTINE SROTMG (SD1,SD2,SX1,SY1,SPARAM) -C -C CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS -C THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)* -C SY2)**T. -C WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. -C -C SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 -C -C (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) -C H=( ) ( ) ( ) ( ) -C (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). -C LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 -C RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE -C VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) -C -C THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE -C INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE -C OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. -C - DIMENSION SPARAM(5) -C - DATA ZERO,ONE,TWO /0.E0,1.E0,2.E0/ - DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/ - IF(.NOT. SD1 .LT. ZERO) GO TO 10 -C GO ZERO-H-D-AND-SX1.. - GO TO 60 - 10 CONTINUE -C CASE-SD1-NONNEGATIVE - SP2=SD2*SY1 - IF(.NOT. SP2 .EQ. ZERO) GO TO 20 - SFLAG=-TWO - GO TO 260 -C REGULAR-CASE.. - 20 CONTINUE - SP1=SD1*SX1 - SQ2=SP2*SY1 - SQ1=SP1*SX1 -C - IF(.NOT. ABS(SQ1) .GT. ABS(SQ2)) GO TO 40 - SH21=-SY1/SX1 - SH12=SP2/SP1 -C - SU=ONE-SH12*SH21 -C - IF(.NOT. SU .LE. ZERO) GO TO 30 -C GO ZERO-H-D-AND-SX1.. - GO TO 60 - 30 CONTINUE - SFLAG=ZERO - SD1=SD1/SU - SD2=SD2/SU - SX1=SX1*SU -C GO SCALE-CHECK.. - GO TO 100 - 40 CONTINUE - IF(.NOT. SQ2 .LT. ZERO) GO TO 50 -C GO ZERO-H-D-AND-SX1.. - GO TO 60 - 50 CONTINUE - SFLAG=ONE - SH11=SP1/SP2 - SH22=SX1/SY1 - SU=ONE+SH11*SH22 - STEMP=SD2/SU - SD2=SD1/SU - SD1=STEMP - SX1=SY1*SU -C GO SCALE-CHECK - GO TO 100 -C PROCEDURE..ZERO-H-D-AND-SX1.. - 60 CONTINUE - SFLAG=-ONE - SH11=ZERO - SH12=ZERO - SH21=ZERO - SH22=ZERO -C - SD1=ZERO - SD2=ZERO - SX1=ZERO -C RETURN.. - GO TO 220 -C PROCEDURE..FIX-H.. - 70 CONTINUE - IF(.NOT. SFLAG .GE. ZERO) GO TO 90 -C - IF(.NOT. SFLAG .EQ. ZERO) GO TO 80 - SH11=ONE - SH22=ONE - SFLAG=-ONE - GO TO 90 - 80 CONTINUE - SH21=-ONE - SH12=ONE - SFLAG=-ONE - 90 CONTINUE - GO TO IGO,(120,150,180,210) -C PROCEDURE..SCALE-CHECK - 100 CONTINUE - 110 CONTINUE - IF(.NOT. SD1 .LE. RGAMSQ) GO TO 130 - IF(SD1 .EQ. ZERO) GO TO 160 - ASSIGN 120 TO IGO -C FIX-H.. - GO TO 70 - 120 CONTINUE - SD1=SD1*GAM**2 - SX1=SX1/GAM - SH11=SH11/GAM - SH12=SH12/GAM - GO TO 110 - 130 CONTINUE - 140 CONTINUE - IF(.NOT. SD1 .GE. GAMSQ) GO TO 160 - ASSIGN 150 TO IGO -C FIX-H.. - GO TO 70 - 150 CONTINUE - SD1=SD1/GAM**2 - SX1=SX1*GAM - SH11=SH11*GAM - SH12=SH12*GAM - GO TO 140 - 160 CONTINUE - 170 CONTINUE - IF(.NOT. ABS(SD2) .LE. RGAMSQ) GO TO 190 - IF(SD2 .EQ. ZERO) GO TO 220 - ASSIGN 180 TO IGO -C FIX-H.. - GO TO 70 - 180 CONTINUE - SD2=SD2*GAM**2 - SH21=SH21/GAM - SH22=SH22/GAM - GO TO 170 - 190 CONTINUE - 200 CONTINUE - IF(.NOT. ABS(SD2) .GE. GAMSQ) GO TO 220 - ASSIGN 210 TO IGO -C FIX-H.. - GO TO 70 - 210 CONTINUE - SD2=SD2/GAM**2 - SH21=SH21*GAM - SH22=SH22*GAM - GO TO 200 - 220 CONTINUE - IF(SFLAG)250,230,240 - 230 CONTINUE - SPARAM(3)=SH21 - SPARAM(4)=SH12 - GO TO 260 - 240 CONTINUE - SPARAM(2)=SH11 - SPARAM(5)=SH22 - GO TO 260 - 250 CONTINUE - SPARAM(2)=SH11 - SPARAM(3)=SH21 - SPARAM(4)=SH12 - SPARAM(5)=SH22 - 260 CONTINUE - SPARAM(1)=SFLAG - RETURN - END diff --git a/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotmg.f90 b/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotmg.f90 new file mode 100644 index 000000000..7c433ce3b --- /dev/null +++ b/sorc/hafs_tools.fd/sorc/hafs_vi/split/srotmg.f90 @@ -0,0 +1,223 @@ +! CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS +! THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)*> +!SY2)**T. +! WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +! +! SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 +! +! (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) +! H=( ) ( ) ( ) ( ) +! (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). +! LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 +! RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE +! VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) +! +! THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE +! INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE +! OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. +! +! Authors: +! ======== +! +! \author Univ. of Tennessee +! \author Univ. of California Berkeley +! \author Univ. of Colorado Denver +! \author NAG Ltd. +! +! \date December 2016 +! +! ===================================================================== + SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) + implicit none +! +! -- Reference BLAS level1 routine (version 3.7.0) -- +! -- Reference BLAS is a software package provided by Univ. of +! Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG +! Ltd..-- * December 2016 +! +! .. Scalar Arguments .. + REAL SD1,SD2,SX1,SY1 +! .. +! .. Array Arguments .. + REAL SPARAM(5) +! .. +! +! ===================================================================== +! Corrections by Kristján Jónasson 2018. The subroutines SROTMG and +! DROTMG in the reference BLAS distributed with LAPACK versions 3.2-3.8 +! contain an error, which the original (1979) routines in the reference +! BLAS level 1 (TOMS Algorithm 539) do not have. The original +! subroutines use goto to implement three internal procedures, +! ZERO-H-D-AND-SX1, SCALE-CHECK and FIX-CHECK, assigned goto for the +! last one, The subroutines were translated to be consistent with the +! Fortran 90 standard somtime around the year 2000. When refactoring to +! make the translations goto-less, a bug crept in. The bug is filed as +! issue #244 where the current reference BLAS is kept in the github +! repository. The corrections implemented below are commented with +! KJ-2018. They are based on (hopefully careful) comparison with the +! original BLAS, available on calgo.acm.org. +! Note that none of the current versions of MKL, OpenBLAS and +! the Apple Accelerate have this error +! ===================================================================== +! +! .. Local Scalars .. + REAL GAM,GAMSQ,ONE,RGAMSQ,SFLAG,SH11,SH12,SH21,SH22,SP1,SP2,SQ1 + real SQ2,STEMP,SU,TWO,ZERO +! .. +! .. Intrinsic Functions .. + INTRINSIC ABS +! .. +! .. Data statements .. +! + DATA ZERO,ONE,TWO/0.E0,1.E0,2.E0/ + DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/ +! .. + + IF (SD1.LT.ZERO) THEN +! GO ZERO-H-D-AND-SX1.. + SFLAG = -ONE + SH11 = ZERO + SH12 = ZERO + SH21 = ZERO + SH22 = ZERO + + SD1 = ZERO + SD2 = ZERO + SX1 = ZERO + ELSE +! CASE-SD1-NONNEGATIVE + SP2 = SD2*SY1 + IF (SP2.EQ.ZERO) THEN + SFLAG = -TWO + SPARAM(1) = SFLAG + RETURN + END IF +! REGULAR-CASE.. + SP1 = SD1*SX1 + SQ2 = SP2*SY1 + SQ1 = SP1*SX1 + + IF (ABS(SQ1).GT.ABS(SQ2)) THEN + SH21 = -SY1/SX1 + SH12 = SP2/SP1 + + SU = ONE - SH12*SH21 + + IF (SU.GT.ZERO) THEN + SFLAG = ZERO + SD1 = SD1/SU + SD2 = SD2/SU + SX1 = SX1*SU + END IF + ELSE + + IF (SQ2.LT.ZERO) THEN +! GO ZERO-H-D-AND-SX1.. + SFLAG = -ONE + SH11 = ZERO + SH12 = ZERO + SH21 = ZERO + SH22 = ZERO + + SD1 = ZERO + SD2 = ZERO + SX1 = ZERO + ELSE + SFLAG = ONE + SH11 = SP1/SP2 + SH22 = SX1/SY1 + SU = ONE + SH11*SH22 + STEMP = SD2/SU + SD2 = SD1/SU + SD1 = STEMP + SX1 = SY1*SU + END IF + END IF + +! KJ-2018: The main refactoring starts here and ends at location +! (*) +! PROCEDURE SCALE-CHECK + DO WHILE (SD1 .LE. RGAMSQ) + IF (SD1.EQ.ZERO) EXIT +! PROCEDURE FIX-H + IF (SFLAG .EQ. ZERO) THEN + SH11 = ONE + SH22 = ONE + ELSE IF (SFLAG .GT. ZERO) THEN + SH21 = -ONE + SH12 = ONE + ENDIF + SFLAG = -ONE +! ------------------ + SD1 = SD1*GAM**2 + SX1 = SX1/GAM + SH11 = SH11/GAM + SH12 = SH12/GAM + ENDDO + DO WHILE (SD1 .GE. GAMSQ) +! PROCEDURE FIX-H + IF (SFLAG .EQ. ZERO) THEN + SH11 = ONE + SH22 = ONE + ELSE IF (SFLAG .GT. ZERO) THEN + SH21 = -ONE + SH12 = ONE + ENDIF + SFLAG = -ONE +! -------------------- + SD1 = SD1*GAM**2 + SX1 = SX1*GAM + SH11 = SH11*GAM + SH12 = SH12*GAM + ENDDO + DO WHILE (ABS(SD2).LE.RGAMSQ) + IF (ABS(SD2).EQ.ZERO) EXIT +! PROCEDURE FIX-H + IF (SFLAG .EQ. ZERO) THEN + SH11 = ONE + SH22 = ONE + ELSE IF (SFLAG .GT. ZERO) THEN + SH21 = -ONE + SH12 = ONE + ENDIF + SFLAG = -ONE +! --------------------------- + SD2 = SD2*GAM**2 + SH21 = SH21/GAM + SH22 = SH22/GAM + ENDDO + DO WHILE (ABS(SD2).GE.GAMSQ) +! PROCEDURE FIX-H + IF (SFLAG .EQ. ZERO) THEN + SH11 = ONE + SH22 = ONE + ELSE IF (SFLAG .GT. ZERO) THEN + SH21 = -ONE + SH12 = ONE + ENDIF + SFLAG = -ONE +! --------------------------- + SD2 = SD2/GAM**2 + SH21 = SH21*GAM + SH22 = SH22*GAM + END DO + END IF +! KJ-2018. Location (*), end of main refactoring section + IF (SFLAG.LT.ZERO) THEN + SPARAM(2) = SH11 + SPARAM(3) = SH21 + SPARAM(4) = SH12 + SPARAM(5) = SH22 + ELSE IF (SFLAG.EQ.ZERO) THEN + SPARAM(3) = SH21 + SPARAM(4) = SH12 + ELSE + SPARAM(2) = SH11 + SPARAM(5) = SH22 + END IF + + SPARAM(1) = SFLAG + RETURN + END SUBROUTINE SROTMG + diff --git a/sorc/hafs_tracker.fd b/sorc/hafs_tracker.fd index 19554dae5..d77b5882f 160000 --- a/sorc/hafs_tracker.fd +++ b/sorc/hafs_tracker.fd @@ -1 +1 @@ -Subproject commit 19554dae5b83b1baeea0b7d461e77c8d87a116e0 +Subproject commit d77b5882f96d53f714c446d31c4688c2c58d15ff diff --git a/sorc/hafs_utils.fd b/sorc/hafs_utils.fd index e367c2d4a..13a4754a2 160000 --- a/sorc/hafs_utils.fd +++ b/sorc/hafs_utils.fd @@ -1 +1 @@ -Subproject commit e367c2d4a9a8959c31505bb86fc65e01d1fbbc49 +Subproject commit 13a4754a25d3b41d31dbb1ebeb449d73fcf2aa1e diff --git a/sorc/install_all.sh b/sorc/install_all.sh index d76983589..6318741e7 100755 --- a/sorc/install_all.sh +++ b/sorc/install_all.sh @@ -23,6 +23,7 @@ $Build_forecast && { $Build_utils && { ${CP} hafs_utils.fd/exec/chgres_cube ../exec/hafs_chgres_cube.x ${CP} hafs_utils.fd/exec/orog ../exec/hafs_orog.x + ${CP} hafs_utils.fd/exec/orog_gsl ../exec/hafs_orog_gsl.x ${CP} hafs_utils.fd/exec/sfc_climo_gen ../exec/hafs_sfc_climo_gen.x ${CP} hafs_utils.fd/exec/global_equiv_resol ../exec/hafs_global_equiv_resol.x ${CP} hafs_utils.fd/exec/regional_esg_grid ../exec/hafs_regional_esg_grid.x @@ -76,35 +77,8 @@ $Build_tools && { # install gsi #------------------------------------ $Build_gsi && { - #${CP} hafs_gsi.fd/exec/global_gsi.x ../exec/hafs_gsi.x - #${CP} hafs_gsi.fd/exec/global_enkf.x ../exec/hafs_enkf.x - ${CP} hafs_gsi.fd/exec/gsi.x ../exec/hafs_gsi.x - ${CP} hafs_gsi.fd/exec/enkf_fv3reg.x ../exec/hafs_enkf.x - ${CP} hafs_gsi.fd/exec/adderrspec.x ../exec/hafs_adderrspec.x - ${CP} hafs_gsi.fd/exec/adjustps.x ../exec/hafs_adjustps.x - ${CP} hafs_gsi.fd/exec/calc_increment_ens_ncio.x ../exec/hafs_calc_increment_ens_ncio.x - ${CP} hafs_gsi.fd/exec/calc_increment_ens.x ../exec/hafs_calc_increment_ens.x - ${CP} hafs_gsi.fd/exec/calc_increment_ncio.x ../exec/hafs_calc_increment_ncio.x - ${CP} hafs_gsi.fd/exec/calc_increment_serial.x ../exec/hafs_calc_increment_serial.x - ${CP} hafs_gsi.fd/exec/getnstensmeanp.x ../exec/hafs_getnstensmeanp.x - ${CP} hafs_gsi.fd/exec/getsfcensmeanp.x ../exec/hafs_getsfcensmeanp.x - ${CP} hafs_gsi.fd/exec/getsfcnstensupdp.x ../exec/hafs_getsfcnstensupdp.x - ${CP} hafs_gsi.fd/exec/getsigensmeanp_smooth.x ../exec/hafs_getsigensmeanp_smooth.x - ${CP} hafs_gsi.fd/exec/getsigensstatp.x ../exec/hafs_getsigensstatp.x - ${CP} hafs_gsi.fd/exec/gribmean.x ../exec/hafs_gribmean.x - ${CP} hafs_gsi.fd/exec/interp_inc.x ../exec/hafs_interp_inc.x - ${CP} hafs_gsi.fd/exec/ncdiag_cat_mpi.x ../exec/hafs_ncdiag_cat_mpi.x - ${CP} hafs_gsi.fd/exec/ncdiag_cat.x ../exec/hafs_ncdiag_cat.x - ${CP} hafs_gsi.fd/exec/oznmon_horiz.x ../exec/hafs_oznmon_horiz.x - ${CP} hafs_gsi.fd/exec/oznmon_time.x ../exec/hafs_oznmon_time.x - ${CP} hafs_gsi.fd/exec/radmon_angle.x ../exec/hafs_radmon_angle.x - ${CP} hafs_gsi.fd/exec/radmon_bcoef.x ../exec/hafs_radmon_bcoef.x - ${CP} hafs_gsi.fd/exec/radmon_bcor.x ../exec/hafs_radmon_bcor.x - ${CP} hafs_gsi.fd/exec/radmon_time.x ../exec/hafs_radmon_time.x - ${CP} hafs_gsi.fd/exec/recenterncio_hybgain.x ../exec/hafs_recenterncio_hybgain.x - ${CP} hafs_gsi.fd/exec/recenternemsiop_hybgain.x ../exec/hafs_recenternemsiop_hybgain.x - ${CP} hafs_gsi.fd/exec/recentersigp.x ../exec/hafs_recentersigp.x - ${CP} hafs_gsi.fd/exec/test_nc_unlimdims.x ../exec/hafs_test_nc_unlimdims.x + ${CP} hafs_gsi.fd/install/bin/gsi.x ../exec/hafs_gsi.x + ${CP} hafs_gsi.fd/install/bin/enkf.x ../exec/hafs_enkf.x } #------------------------------------ diff --git a/sorc/link_fix.sh b/sorc/link_fix.sh index f9b0ce652..e5a6efb35 100755 --- a/sorc/link_fix.sh +++ b/sorc/link_fix.sh @@ -11,10 +11,6 @@ cd ${FIXhafs} mkdir -p fix_fv3 if [ ${target} == "wcoss2" ]; then FIXROOT=/lfs/h2/emc/hur/noscrub/hafs-fix-files/hafs-${FIXversion}-fix/fix -elif [ ${target} == "wcoss_cray" ]; then - FIXROOT=/gpfs/hps3/emc/hwrf/noscrub/emc.hurpara/hafs-fix-files/hafs-${FIXversion}-fix/fix -elif [ ${target} == "wcoss_dell_p3" ]; then - FIXROOT=/gpfs/dell2/emc/modeling/noscrub/emc.hurpara/hafs-fix-files/hafs-${FIXversion}-fix/fix elif [ ${target} == "hera" ]; then FIXROOT=/scratch1/NCEPDEV/hwrf/noscrub/hafs-fix-files/hafs-${FIXversion}-fix/fix elif [ ${target} == "orion" ]; then diff --git a/sorc/machine-setup.sh b/sorc/machine-setup.sh index 3a72594a4..7f12ab239 100755 --- a/sorc/machine-setup.sh +++ b/sorc/machine-setup.sh @@ -27,6 +27,8 @@ if [[ -d /lfs4 ]] ; then fi target=jet module purge + module use /apps/modules/modulefiles + module use /apps/lmod/lmod/modulefiles/Core elif [[ -d /scratch1/NCEPDEV ]] ; then # We are on NOAA Hera if ( ! eval module help > /dev/null 2>&1 ) ; then @@ -35,6 +37,8 @@ elif [[ -d /scratch1/NCEPDEV ]] ; then fi target=hera module purge + module use /apps/modules/modulefiles + module use /apps/lmod/lmod/modulefiles/Core elif [[ -d /work/noaa ]] ; then # We are on MSU Orion if ( ! eval module help > /dev/null 2>&1 ) ; then @@ -47,51 +51,13 @@ elif [[ -d /work/noaa ]] ; then module use /apps/contrib/modulefiles module use /apps/contrib/NCEPLIBS/lib/modulefiles module use /apps/contrib/NCEPLIBS/orion/modulefiles -elif [[ -d /gpfs/hps && -e /etc/SuSE-release ]] ; then - # We are on NOAA Luna or Surge - if ( ! eval module help > /dev/null 2>&1 ) ; then - echo load the module command 1>&2 - source /opt/modules/default/init/$__ms_shell - fi - target=wcoss_cray - - # Silence the "module purge" to avoid the expected error messages - # related to modules that load modules. - module purge > /dev/null 2>&1 - module use /usrx/local/prod/modulefiles - module use /gpfs/hps/nco/ops/nwprod/lib/modulefiles - module use /gpfs/hps/nco/ops/nwprod/modulefiles - module use /opt/cray/alt-modulefiles - module use /opt/cray/craype/default/alt-modulefiles - module use /opt/cray/ari/modulefiles - module use /opt/modulefiles - module purge > /dev/null 2>&1 - - # Workaround until module issues are fixed: - unset _LMFILES_ - unset LOADEDMODULES - echo y 2> /dev/null | module clear > /dev/null 2>&1 - - module use /usrx/local/prod/modulefiles - module use /gpfs/hps/nco/ops/nwprod/lib/modulefiles - module use /gpfs/hps/nco/ops/nwprod/modulefiles - module use /opt/cray/alt-modulefiles - module use /opt/cray/craype/default/alt-modulefiles - module use /opt/cray/ari/modulefiles - module use /opt/modulefiles - module load modules -elif [[ -L /usrx && "$( readlink /usrx 2> /dev/null )" =~ dell ]] ; then - # We are on NOAA Venus or Mars - if ( ! eval module help > /dev/null 2>&1 ) ; then - echo load the module command 1>&2 - source /usrx/local/prod/lmod/lmod/init/$__ms_shell - fi - target=wcoss_dell_p3 - module purge - source /usrx/local/prod/lmod/lmod/init/$__ms_shell elif [[ -d /lfs/h1 && -d /lfs/h2 ]] ; then + # We are on NOAA WCOSS2 + echo load the module command 1>&2 + source /usr/share/lmod/lmod/init/$__ms_shell +# . /usr/share/lmod/lmod/init/sh target=wcoss2 - . $MODULESHOME/init/sh +# module purge elif [[ -d /glade ]] ; then # We are on NCAR Cheyenne if ( ! eval module help > /dev/null 2>&1 ) ; then diff --git a/ush/hafs/launcher.py b/ush/hafs/launcher.py index 4c35ce27d..ef480fba0 100644 --- a/ush/hafs/launcher.py +++ b/ush/hafs/launcher.py @@ -18,14 +18,17 @@ __all__=['load','launch','HAFSLauncher','parse_launch_args','multistorm_parse_args'] import os, re, sys, collections, random +import numpy as np +import xarray as xr import produtil.fileop, produtil.run, produtil.log import tcutil.revital, tcutil.storminfo, tcutil.numerics import hafs.config import hafs.prelaunch from random import Random -from produtil.fileop import isnonempty -from produtil.run import run, exe +from produtil.fileop import isnonempty, deliver_file +from produtil.cd import NamedDir, TempDir +from produtil.run import mpi, mpirun, run, runstr, checkrun, exe, bigexe, alias from produtil.log import jlogger from tcutil.numerics import to_datetime_rel, to_datetime, to_fraction from hafs.config import HAFSConfig @@ -665,7 +668,12 @@ def decide_domain_center(self,logger=None): logger.info('Domain center is already set to lat=%g lon=%g' %(cenla,cenlo)) return - (cenlo, cenla) = self.syndat.tcutil_domain_center(logger) + parent_domain_center=self.getstr('config','parent_domain_center','storm') + if parent_domain_center=='storm': + (cenlo, cenla) = self.syndat.tcutil_domain_center_storm(logger) + else: + (cenlo, cenla) = self.syndat.tcutil_domain_center(logger) + self.set('config','domlat',cenla) self.set('config','domlon',cenlo) logger.info('Decided on domain center lat=%g lon=%g'%(cenla,cenlo)) @@ -1433,6 +1441,149 @@ def make_holdvars(self,part1='{PARMhafs}/hafs_holdvars.txt',part2=None): out=list() logger=self.log() + # For the storm-focused nest, check (and recalculate if needed) i/jstart_nest, i/jend_nest + istart_nest=self.getstr('grid','istart_nest','auto').split(',') + jstart_nest=self.getstr('grid','jstart_nest','auto').split(',') + iend_nest=self.getstr('grid','iend_nest','auto').split(',') + jend_nest=self.getstr('grid','jend_nest','auto').split(',') + if "-999" in istart_nest+jstart_nest+iend_nest+jend_nest: + logger.info(f'Original istart_nest={istart_nest},jstart_nest={jstart_nest}') + logger.info(f'Original iend_nest={iend_nest},jend_nest={jend_nest}') + logger.info('Need to recalculate i/jstart_nest and i/jend_nest based on storm location.') + cres=self.getstr('grid','CASE','C512') + gtype=self.getstr('grid','gtype','regional') + stretch_fac=self.getstr('grid','stretch_fac','1.0001') + target_lon=self.getstr('grid','target_lon') + target_lat=self.getstr('grid','target_lat') + nest_grids=self.getint('grid','nest_grids',1) + parent_tile=self.getstr('grid','parent_tile').split(',') + refine_ratio=self.getstr('grid','refine_ratio','3').split(',') + npx=self.getstr('forecast','npx').split(',') + npy=self.getstr('forecast','npy').split(',') + regional_esg=self.getstr('grid','regional_esg','no') + idim_nest=self.getstr('grid','idim_nest').split(',') + jdim_nest=self.getstr('grid','jdim_nest').split(',') + delx_nest=self.getstr('grid','delx_nest').split(',') + dely_nest=self.getstr('grid','dely_nest').split(',') + jdim_nest=self.getstr('grid','jdim_nest').split(',') + halop2=self.getint('grid','halop2',5) + pazi=self.getfloat('grid','pazi',-180.) + WORKhafs=self.getstr('dir','WORKhafs','work') + EXEChafs=self.getstr('dir','EXEChafs','exec') + + # Run make_hgrid.x or regional_esg_grid.x to generate the parent tile grid file + with NamedDir(os.path.join(WORKhafs, 'launch'),logger=logger,rm_first=True) as d: + if gtype=='nest': + executable=os.path.join(EXEChafs, 'hafs_make_hgrid.x') + cmd=exe(executable)['--grid_type gnomonic_ed --nlon', 2*int(cres[1:]), '--grid_name', cres+'_grid', + '--do_schmidt --stretch_factor', stretch_fac, + '--target_lon', target_lon, '--target_lat', target_lat] + checkrun(cmd,logger=logger) + deliver_file(cres+'_grid.tile6.nc', './parent_grid.tile.halo0.nc', keep=True, logger=logger) + elif gtype=='regional' and nest_grids > 1 and not regional_esg=='yes': + executable=os.path.join(EXEChafs, 'hafs_make_hgrid.x') + cmd=exe(executable)['--grid_type gnomonic_ed --nlon', 2*int(cres[1:]), '--grid_name', cres+'_grid', + '--do_schmidt --stretch_factor', stretch_fac, + '--target_lon', target_lon, '--target_lat', target_lat, + '--nest_grids', 1, '--parent_tile', parent_tile[0], + '--istart_nest', istart_nest[0], '--jstart_nest', jstart_nest[0], + '--iend_nest', iend_nest[0], '--jend_nest', jend_nest[0], + '--halo 0 --great_circle_algorithm'] + checkrun(cmd,logger=logger) + deliver_file(cres+'_grid.tile7.nc', './parent_grid.tile.halo0.nc', keep=True, logger=logger) + elif gtype=='regional' and nest_grids > 1 and regional_esg=='yes': + executable=os.path.join(EXEChafs, 'hafs_regional_esg_grid.x') + # generate regional esg parent grid + lx=int(idim_nest[0])+halop2*2 + ly=int(jdim_nest[0])+halop2*2 + with open('./regional_grid.nml','w') as f: + f.write(f'®ional_grid_nml\n') + f.write(f' plon = {target_lon}\n') + f.write(f' plat = {target_lat}\n') + f.write(f' pazi = {pazi}\n') + f.write(f' delx = {delx_nest[0]}\n') + f.write(f' dely = {dely_nest[0]}\n') + f.write(f' lx = {-lx}\n') + f.write(f' ly = {-ly}\n') + f.write(f'/') + cmd=exe(executable) + checkrun(cmd,logger=logger) + # Subset into a halo0 grid using nco ncks an alternative way is to use hafs_shave.x + cmd=exe('ncks')['-O', + '-d', f'nx,{2*halop2},{2*(lx-halop2)-1}', + '-d', f'ny,{2*halop2},{2*(ly-halop2)-1}', + '-d', f'nxp,{2*halop2},{2*(lx-halop2)}', + '-d', f'nyp,{2*halop2},{2*(ly-halop2)}', + './regional_grid.nc', './parent_grid.tile.halo0.nc'] + checkrun(cmd,logger=logger) + # An alternative way is to use hafs_shave.x to shave the grid into halo0 + #with open('./input.shave.grid.halo0','w') as f: + # f.write(' '.join(map(str, [idim_nest[0], jdim_nest[0],halo0, + # "'./regional_grid.nc'", "'./parent_grid.tile.halo0.nc'"]))) + #executable=os.path.join(EXEChafs, 'hafs_shave.x') + #cmd=exe(executable)<'./input.shave.grid.halo0' + #checkrun(cmd,logger=logger) + else: + logger.warning('Unsupported gtype.') + + # Get storm center lon/lat from tmpvit + tmpvit=os.path.join(WORKhafs,'tmpvit') + #syndat is a StormInfo object + with open(tmpvit,'rt') as f: + syndat=tcutil.storminfo.parse_tcvitals(f,logger,raise_all=True) + syndat=syndat[0] + # Search the nearest index location to the storm center on the compute grid (not on the super grid) + grid=xr.open_dataset('./parent_grid.tile.halo0.nc') + dist=np.sqrt(np.mod((grid.x[::2,::2]-syndat.lon),360.)**2 + (grid.y[::2,::2]-syndat.lat)**2) + # Note: xloc is dim2, yloc is dim1 in the grid xarray + yloc,xloc=np.where(dist==dist.min()) + logger.info(f'Storm center at compute grid: xloc={xloc}, yloc={yloc}') + icenter=2*xloc[0] + jcenter=2*yloc[0] + logger.info(f'Storm center at super grid: icenter={icenter}, jcenter={jcenter}') + if gtype=='nest': + istart=int(min(max(4, icenter-(int(npx[0])-1)/int(refine_ratio[0])+1), + 2*int(cres[1:])-4-2*(int(npx[0])-1)/int(refine_ratio[0]))) + jstart=int(min(max(4, jcenter-(int(npy[0])-1)/int(refine_ratio[0])+1), + 2*int(cres[1:])-4-2*(int(npy[0])-1)/int(refine_ratio[0]))) + iend=int(istart-1+2*(int(npx[0])-1)/int(refine_ratio[0])) + jend=int(jstart-1+2*(int(npy[0])-1)/int(refine_ratio[0])) + istart_nest[0]=str(istart) + jstart_nest[0]=str(jstart) + iend_nest[0]=str(iend) + jend_nest[0]=str(jend) + elif gtype=='regional': + istart=int(min(max(4, icenter-(int(npx[1])-1)/int(refine_ratio[1])+1), + 2*(int(npx[0])-1)-4-2*(int(npx[1])-1)/int(refine_ratio[1]))) + jstart=int(min(max(4, jcenter-(int(npy[1])-1)/int(refine_ratio[1])+1), + 2*(int(npy[0])-1)-4-2*(int(npy[1])-1)/int(refine_ratio[1]))) + iend=int(istart-1+2*(int(npx[1])-1)/int(refine_ratio[1])) + jend=int(jstart-1+2*(int(npy[1])-1)/int(refine_ratio[1])) + istart_nest[1]=str(istart) + jstart_nest[1]=str(jstart) + iend_nest[1]=str(iend) + jend_nest[1]=str(jend) + else: + logger.warning('Unsupported gtype.') + + # Update i/jstart_nest and i/jend_nest + self.set('holdvars','istart_nest',','.join(istart_nest)) + self.set('holdvars','jstart_nest',','.join(jstart_nest)) + self.set('holdvars','iend_nest',','.join(iend_nest)) + self.set('holdvars','jend_nest',','.join(jend_nest)) + logger.info(f'Updated istart_nest={istart_nest},jstart_nest={jstart_nest}') + logger.info(f'Updated iend_nest={iend_nest},jend_nest={jend_nest}') + + # Update output_grid_cen_lon/lat + output_grid_cen_lon=self.getstr('forecast','output_grid_cen_lon').split(',') + output_grid_cen_lat=self.getstr('forecast','output_grid_cen_lat').split(',') + output_grid_cen_lon[1]=str(syndat.lon) + output_grid_cen_lat[1]=str(syndat.lat) + self.set('holdvars','output_grid_cen_lon',','.join(output_grid_cen_lon)) + self.set('holdvars','output_grid_cen_lat',','.join(output_grid_cen_lat)) + logger.info(f'Updated output_grid_cen_lon={output_grid_cen_lon}') + logger.info(f'Updated output_grid_cen_lat={output_grid_cen_lat}') + run_ocean=self.getbool('config','run_ocean') # Set ocean_start_dtg if needed diff --git a/ush/hafs/ww3.py b/ush/hafs/ww3.py index 343b82443..a5ccac0ce 100644 --- a/ush/hafs/ww3.py +++ b/ush/hafs/ww3.py @@ -18,15 +18,16 @@ from tcutil.numerics import to_datetime, to_datetime_rel, to_fraction, to_timedelta from hafs.exceptions import WW3InputError -prodnames={ - 'mod_def': ( './mod_def.ww3', '{com}/{out_prefix}.mod_def.ww3' ), - 'wind': ( './wind.ww3', '{com}/{out_prefix}.wind.ww3' ), - 'current': ( './current.ww3', '{com}/{out_prefix}.current.ww3' ), - 'restart': ( './restart.ww3', '{com}/{out_prefix}.restart_init.ww3' ), - 'ww3_shel': ( './ww3_shel.inp', '{com}/{out_prefix}.ww3_shel.inp' ) } +prodnames={ + 'mod_def': ( './mod_def.ww3', '{intercom}/ww3/mod_def.ww3' ), + 'ww3_mesh': ( './ww3_mesh.nc', '{intercom}/ww3/ww3_mesh.nc' ), + 'wind': ( './wind.ww3', '{intercom}/ww3/wind.ww3' ), + 'current': ( './current.ww3', '{intercom}/ww3/current.ww3' ), + 'restart': ( './restart.ww3', '{intercom}/ww3/restart_init.ww3' ) } +# 'ww3_shel': ( './ww3_shel.inp', '{intercom}/ww3/ww3_shel.inp' ) } ######################################################################## -class WW3Init(hafs.hafstask.HAFSTask): +class WW3Init(hafs.hafstask.HAFSTask): def __init__(self,dstore,conf,section,taskname=None,fcstlen=126, outstep=21600, pntstep=21600, rststep=21600, **kwargs): """Creates a WW3Init @@ -52,8 +53,8 @@ def _make_products(self): self._products=dict() atime=tcutil.numerics.to_datetime(self.conf.cycle) ww3_bdy=self.confstr('ww3_bdy','no') - if ww3_bdy == 'yes': - prodnames['nest']=( './nest.ww3', '{com}/{out_prefix}.nest.ww3' ) + if ww3_bdy == 'yes': + prodnames['nest']=( './nest.ww3', '{intercom}/ww3/nest.ww3' ) with self.dstore.transaction(): for prodname,filepaths in prodnames.items(): (localpath,compath)=filepaths @@ -85,7 +86,7 @@ def inputiter(self): yield dict(self.taskvars,dataset=dataset,item=item,ftime=when,atime=atime) when=to_datetime_rel(interval,when) ww3_bdy=self.confstr('ww3_bdy','no') - if ww3_bdy == 'yes': + if ww3_bdy == 'yes': atime=to_datetime(self.conf.cycle) wtime=to_datetime_rel(-6*3600,atime) dataset=self.confstr('gfswave_dataset','gfswave') @@ -94,7 +95,7 @@ def inputiter(self): yield dict(self.taskvars,dataset=dataset,item=item,ftime=when,atime=when,optional=True) ww3_rst=self.confstr('ww3_rst','no') print('ww3_rst=%s'%(ww3_rst)) - if ww3_rst == 'yes' or ww3_rst == 'always': + if ww3_rst == 'yes' or ww3_rst == 'always': atime=to_datetime(self.conf.cycle) wtime=to_datetime_rel(-6*3600,atime) dataset=self.confstr('gdaswave_dataset','gdaswave') @@ -151,7 +152,7 @@ def run(self): dummywind=True else: # Wrong usegfswind value - logger.warning('Wrong usegfswind value: %s. Assume usegfswind=yes.' + logger.warning('Wrong usegfswind value: %s. Assume usegfswind=yes.' 'Set dummywind to False.'%(usegfswind,)) usegfswind='yes' dummywind=False @@ -166,7 +167,7 @@ def link(s,t): make_symlink(s,t,force=True,logger=logger) deliver_file(self.icstr('{grid_inp}'),'ww3_grid.inp',keep=True,logger=logger) link(self.icstr('{grid_bot}'),'.') - if ww3_bdy == 'yes': + if ww3_bdy == 'yes': link(self.icstr('{grid_msk2}'),self.icstr('./ww3_grid_{vit[basin1lc]}.msk')) else: link(self.icstr('{grid_msk}'),'.') @@ -176,13 +177,15 @@ def link(s,t): cmd=exe('./ww3_grid') if redirect: cmd = cmd>='ww3_grid.log' checkrun(cmd,logger=logger) + # Copy over the pre-generated grid mesh file + deliver_file(self.icstr('{grid_mesh}'),'./ww3_mesh.nc') - if usegfswind == 'yes': - # Extract gfs wind from gfs grib2 data - ncfile='gfs.uvgrd10m.nc' + if usegfswind == 'yes': + # Extract gfs wind from gfs grib2 data + ncfile='gfs.uvgrd10m.nc' produtil.fileop.remove_file(ncfile,logger=logger) cmd=alias(bigexe(self.getexe('wgrib2','wgrib2'))) - for f in self.gfsgrib2iter(): + for f in self.gfsgrib2iter(): logger.info('Extracting wind at 10 m from %s'%(f)) subset='' for line in runstr(cmd[f],logger=logger).splitlines(True): @@ -198,7 +201,7 @@ def link(s,t): produtil.log.jlogger.warning( 'ww3init: will use dummy wind because %s is missing ' 'or empty.'%(ncfile,)) - + if dummywind: # Run ww3_prep for dummy wind deliver_file(self.icstr('{wind_inp}'),'ww3_prep.inp',keep=True,logger=logger) @@ -248,7 +251,7 @@ def link(s,t): 'restart.ww3: will generate restart.ww3 because %s is missing ' 'or could not be copied; %s'%(oldrst,str(ee)),exc_info=True) - if (not have_restart and ww3_rst == 'yes') or ww3_rst == 'always': + if (not have_restart and ww3_rst == 'yes') or ww3_rst == 'always': try: with NamedDir('ww3gint',keep=True,logger=logger) as nameddir: logger.info('ww3_grid: generating mod_def.ww3 for gnh_10m gridi from gdaswave') @@ -286,7 +289,7 @@ def link(s,t): if redirect: cmd = cmd>='ww3_strt.log' checkrun(cmd,logger=logger) - if ww3_bdy == 'yes': + if ww3_bdy == 'yes': try: logger.info('ww3_bound: generating ww3 boundary condition') self.get_ww3bdy_inputs() @@ -303,52 +306,52 @@ def link(s,t): 'ww3_bound: will run without input boundary condition because ww3_bound ' 'did not run successfully.',exc_info=True) - if redirect: self._copy_log() - - # Prepare ww3_shel.inp - ni=hafs.namelist.NamelistInserter(self.conf,self.section) - shel_inp=self.icstr('{shel_inp}') - atime=to_datetime(self.conf.cycle) # sim start time - etime=to_datetime_rel(self.fcstlen*3600,atime) # sim end time - flddt=int(self.outstep) - pntdt=int(self.pntstep) - #flddt=self.conf.getint('forecast_products','ww3_output_step',10800) - #pntdt=self.conf.getint('forecast_products','ww3_pntout_step',10800) - if pntdt > 0: - # Point output requested, need to provide buoy information - buoy_inp=self.icstr('{buoy_inp}') - with open(buoy_inp,'r') as bf: - #Read the file content and take out the eof character in the end. - buoyfile=bf.read()[:-1] - elif pntdt == 0: - # Point output no requested, no further info needed - buoyfile='$' - else: - # Wrong pntdt value - logger.warning('Wrong ww3_pntout_step value: %d. Set ww3_pntout_step = 0'%(pntdt,)) - pntdt=0 - self.pntout=0 - buoyfile='$' - ci=self.conf.getfloat('config','cycling_interval',6) - retime=to_datetime_rel(ci*3600*1,atime) # restart end time - invars=dict() - invars.update(RUN_BEG=atime.strftime('%Y%m%d %H%M%S'), - RUN_END=etime.strftime('%Y%m%d %H%M%S'), - FLD_BEG=atime.strftime('%Y%m%d %H%M%S'), - FLD_END=etime.strftime('%Y%m%d %H%M%S'), - FLD_DT=int(flddt), - PNT_BEG=atime.strftime('%Y%m%d %H%M%S'), - PNT_END=etime.strftime('%Y%m%d %H%M%S'), - PNT_DT=int(pntdt), - BUOY_FILE=buoyfile, - RST_BEG=atime.strftime('%Y%m%d %H%M%S'), - RST_END=retime.strftime('%Y%m%d %H%M%S'), - RST_DT=int(self.rststep) ) - - with open(shel_inp,'rt') as nf: - with open('ww3_shel.inp','wt') as of: - of.write(ni.parse(nf,logger=logger,source=shel_inp, - raise_all=True,atime=self.conf.cycle,**invars)) + #if redirect: self._copy_log() + + ## Prepare ww3_shel.inp + #ni=hafs.namelist.NamelistInserter(self.conf,self.section) + #shel_inp=self.icstr('{shel_inp}') + #atime=to_datetime(self.conf.cycle) # sim start time + #etime=to_datetime_rel(self.fcstlen*3600,atime) # sim end time + #flddt=int(self.outstep) + #pntdt=int(self.pntstep) + ##flddt=self.conf.getint('forecast_products','ww3_output_step',10800) + ##pntdt=self.conf.getint('forecast_products','ww3_pntout_step',10800) + #if pntdt > 0: + # # Point output requested, need to provide buoy information + # buoy_inp=self.icstr('{buoy_inp}') + # with open(buoy_inp,'r') as bf: + # #Read the file content and take out the eof character in the end. + # buoyfile=bf.read()[:-1] + #elif pntdt == 0: + # # Point output no requested, no further info needed + # buoyfile='$' + #else: + # # Wrong pntdt value + # logger.warning('Wrong ww3_pntout_step value: %d. Set ww3_pntout_step = 0'%(pntdt,)) + # pntdt=0 + # self.pntout=0 + # buoyfile='$' + #ci=self.conf.getfloat('config','cycling_interval',6) + #retime=to_datetime_rel(ci*3600*1,atime) # restart end time + #invars=dict() + #invars.update(RUN_BEG=atime.strftime('%Y%m%d %H%M%S'), + # RUN_END=etime.strftime('%Y%m%d %H%M%S'), + # FLD_BEG=atime.strftime('%Y%m%d %H%M%S'), + # FLD_END=etime.strftime('%Y%m%d %H%M%S'), + # FLD_DT=int(flddt), + # PNT_BEG=atime.strftime('%Y%m%d %H%M%S'), + # PNT_END=etime.strftime('%Y%m%d %H%M%S'), + # PNT_DT=int(pntdt), + # BUOY_FILE=buoyfile, + # RST_BEG=atime.strftime('%Y%m%d %H%M%S'), + # RST_END=retime.strftime('%Y%m%d %H%M%S'), + # RST_DT=int(self.rststep) ) + + #with open(shel_inp,'rt') as nf: + # with open('ww3_shel.inp','wt') as of: + # of.write(ni.parse(nf,logger=logger,source=shel_inp, + # raise_all=True,atime=self.conf.cycle,**invars)) self.deliver_products() self.state=COMPLETED @@ -356,19 +359,19 @@ def link(s,t): logger.error('Unhandled exception in wave init: %s' %(str(e),),exc_info=True) self.state=FAILED - self._copy_log() + #self._copy_log() raise def _copy_log(self): logger=self.log() - for lf in [ 'ww3_grid.log', 'ww3_prep_wind.log', 'ww3_prep_curr.log', + for lf in [ 'ww3_grid.log', 'ww3_prep_wind.log', 'ww3_prep_curr.log', 'ww3_strt.log', 'ww3_untarbdy.log', 'ww3_bound.log' ]: comloc=self.icstr('{com}/{out_prefix}.{lf}.ww3',lf=lf) if os.path.exists(lf): deliver_file(lf,comloc,keep=True,logger=logger) def get_ww3bdy_inputs(self): - """!Obtains WW3 input boundary condition data, links or copies to ww3init dir. + """!Obtains WW3 input boundary condition data, links or copies to ww3init dir. WW3 input boundary data comes from previous cycle's gfswave.""" logger=self.log() @@ -407,7 +410,7 @@ def get_ww3bdy_inputs(self): return def get_ww3rst_inputs(self): - """!Obtains global gdaswave restart file, links or copies to ww3init dir. + """!Obtains global gdaswave restart file, links or copies to ww3init dir. WW3 input restart file comes from current cycle's gdaswave.""" logger=self.log() @@ -453,7 +456,7 @@ def make_gint_inp(self,logger): ######################################################################## -ww3postprodnames={ +ww3postprodnames={ 'ww3outgrd': ( './out_grd.ww3', '{com}/{out_prefix}.out_grd.ww3' ), 'ww3grb2': ( './gribfile', '{com}/{out_prefix}.ww3.grb2' ), 'ww3grb2idx': ( './gribfile.idx', '{com}/{out_prefix}.ww3.grb2.idx' ), @@ -505,7 +508,7 @@ def __copy_ncks(self,source,target,ignore): checkrun(bigexe(ncks)['-4','-L','6',source,target]<'/dev/null', logger=logger) - @property + @property def ncks_path(self): """Returns the path to ncks. Returns None if ncks cannot be found. This function will only search for ncks once, and will @@ -515,7 +518,7 @@ def ncks_path(self): ncks=self.getexe('ncks','') if not self._ncks_path: ncks=produtil.fileop.find_exe('ncks',raise_missing=False) - assert(ncks is None or + assert(ncks is None or (isinstance(ncks,str) and ncks!='')) self._ncks_path=ncks return self._ncks_path @@ -528,7 +531,7 @@ def run(self): try: with NamedDir(self.workdir,keep=True,logger=logger,rm_first=True) as d: # Prepare mod_def.ww3 - ww3moddef=self.icstr('{com}/{out_prefix}.mod_def.ww3') + ww3moddef=self.icstr('{intercom}/ww3/mod_def.ww3') if not os.path.exists(ww3moddef): logger.error('%s: mod_def.ww3 not yet available from forecast'%( ww3moddef,)) @@ -585,10 +588,10 @@ def run(self): buoys=ww3_outp_info[indices[0]+1:indices[1]-2] # For point bullitin output if ww3_outp_bull_post == 'yes': - filebull=[] - filecbull=[] - filecsbull=[] - filelog=[] + filebull=[] + filecbull=[] + filecsbull=[] + filelog=[] commands=list() for i, buoy in enumerate(buoys): ipnt=i+1 @@ -649,8 +652,8 @@ def run(self): prod.deliver(frominfo=localpath,location=prod.location,logger=logger,copier=None) # For point spec output if ww3_outp_spec_post == 'yes': - fileout=[] - filelog=[] + fileout=[] + filelog=[] commands=list() ww3tstr=self.conf.cycle.strftime('%y%m%d%H') for i, buoy in enumerate(buoys): diff --git a/ush/hafs_make_grid.sh b/ush/hafs_make_grid.sh index c4e9f3028..0fc12060d 100755 --- a/ush/hafs_make_grid.sh +++ b/ush/hafs_make_grid.sh @@ -7,17 +7,19 @@ set -eux nargv=$# -if [ $nargv -ne 3 -a $nargv -ne 5 -a $nargv -ne 6 -a $nargv -ne 12 -a $nargv -ne 14 ]; then - echo "number of arguments must be 3, 5 (regular cubic sphere grid), 6 (stretched grid), or 12, 14 ( nested grid)" +if [ $nargv -ne 3 -a $nargv -ne 5 -a $nargv -ne 6 -a $nargv -ne 7 -a $nargv -ne 12 -a $nargv -ne 14 ]; then + echo "number of arguments must be 3, 5 (regular cubic sphere grid), 6 (stretched grid), 7 (regional esg grid) or 12, 14 ( global/regional nested grid)" echo "Usage for regular cubic sphere grid: (uses default target_lat, target_lon, retained for backwards compatibility ) " echo " $0 resolution out_dir script_dir" echo "Usage for regular cubic sphere grid: " echo " $0 resolution out_dir target_lon target_lat script_dir" - echo "Usage for Stretched grid: " + echo "Usage for stretched grid: " echo " $0 resolution out_dir stetch_fac target_lon target_lat script_dir" - echo "Usage for Nested grid: (single nest with parent tile 6, retained for backwards compatibility)" + echo "Usage for regional esg grid: " + echo " $0 resolution out_dir target_lon target_lat halop2 pazi script_dir" + echo "Usage for nested grid: (single nest with parent tile 6, retained for backwards compatibility)" echo " $0 resolution out_dir stetch_fac target_lon target_lat refine_ratio_list istart_nest_list jstart_nest_list iend_nest_list jend_nest_list halo script_dir" - echo "Usage for Nested grid: (single or multiple nests)" + echo "Usage for nested grid: (single or multiple nests)" echo " $0 resolution out_dir stetch_fac target_lon target_lat num_nests parent_tile_list refine_ratio_list istart_nest_list jstart_nest_list iend_nest_list jend_nest_list halo script_dir" exit 1 fi @@ -114,6 +116,98 @@ elif [ $nargv -eq 12 -o $nargv -eq 14 ]; then --target_lon ${target_lon} --target_lat ${target_lat} --nest_grids $nest_grids --parent_tile $parent_tile --refine_ratio $refine_ratio \ --istart_nest $istart_nest --jstart_nest $jstart_nest --iend_nest $iend_nest --jend_nest $jend_nest --halo $halo --great_circle_algorithm +elif [ $nargv -eq 7 -a ${regional_esg:-no} = yes ] ; then + export target_lon=$3 + export target_lat=$4 + export pazi=$5 + export halop2=$6 + export script_dir=$7 + export executable=${MAKEHGRIDEXEC:-$exec_dir/hafs_regional_esg_grid.x} + if [ ! -s $executable ]; then + echo "executable does not exist" + exit 1 + fi + + # First, deal with regional esg grid parent or single regional esg grid + n=1 + inest=$(( ${n} + 1 )) + idim=$( echo ${idim_nest} | cut -d , -f ${n} ) + jdim=$( echo ${jdim_nest} | cut -d , -f ${n} ) + delx=$( echo ${delx_nest} | cut -d , -f ${n} ) + dely=$( echo ${dely_nest} | cut -d , -f ${n} ) + halop2=${halop2:-$(( halo+2 ))} + (( lx=idim+halop2*2 )) + (( ly=jdim+halop2*2 )) + cat > ./regional_grid.nml << EOF + ®ional_grid_nml + plon = ${target_lon} + plat = ${target_lat} + pazi = ${pazi:--180.} + delx = ${delx} + dely = ${dely} + lx = -${lx} + ly = -${ly} + / +EOF + + $APRUN $executable + mv regional_grid.nml C${res}_grid.tile7.nml + mv regional_grid.nc C${res}_grid.tile7.nc + + # If needed, create a regional esg fine parent grid with its child/nest grid + # resolution. It covers the regional esg parent grid, which can be subsetted + # to generate collocated nest grid. + if [ ${nest_grids} -ge 2 ]; then + + n=2 + delx=$( echo ${delx_nest} | cut -d , -f ${n} ) + dely=$( echo ${dely_nest} | cut -d , -f ${n} ) + refine=$( echo ${refine_ratio} | cut -d , -f ${n} ) + lx=$(( ${lx} * ${refine} )) + ly=$(( ${ly} * ${refine} )) + + cat > ./regional_grid.nml << EOF + ®ional_grid_nml + plon = ${target_lon} + plat = ${target_lat} + pazi = ${pazi:--180.} + delx = ${delx} + dely = ${dely} + lx = -${lx} + ly = -${ly} + / +EOF + + $APRUN $executable + mv regional_grid.nml C${res}_nest1res_grid.tile7.nml + mv regional_grid.nc C${res}_nest1res_grid.tile7.nc + + # Subset to generate the regional esg nested grids + for n in $(seq 2 ${nest_grids}) + do + + itile=$((6 + ${n})) + refine=$( echo ${refine_ratio} | cut -d , -f ${n} ) + istart=$( echo ${istart_nest} | cut -d , -f ${n} ) + jstart=$( echo ${jstart_nest} | cut -d , -f ${n} ) + iend=$( echo ${iend_nest} | cut -d , -f ${n} ) + jend=$( echo ${jend_nest} | cut -d , -f ${n} ) + istart_sub=$(( $(( ${istart}+${halop2}*2-1 )) * ${refine} )) + jstart_sub=$(( $(( ${jstart}+${halop2}*2-1 )) * ${refine} )) + iend_sub=$(( $(( ${iend}+${halop2}*2 )) * ${refine} - 1 )) + jend_sub=$(( $(( ${jend}+${halop2}*2 )) * ${refine} - 1 )) + ncks -O -d nx,${istart_sub},${iend_sub} \ + -d ny,${jstart_sub},${jend_sub} \ + -d nxp,${istart_sub},$((${iend_sub}+1)) \ + -d nyp,${jstart_sub},$((${jend_sub}+1)) \ + C${res}_nest1res_grid.tile7.nc C${res}_nest1res_grid.tile${itile}.nc + # Replace the tile value after subsetting + ncap2 -s 'tile="'tile${itile}'"' C${res}_nest1res_grid.tile${itile}.nc C${res}_grid.tile${itile}.nc + + done + + fi # if [ ${nest_grids} -ge 2 ]; then + fi if [ $? -ne 0 ]; then @@ -121,7 +215,6 @@ if [ $? -ne 0 ]; then exit 1 fi - #--------------------------------------------------------------------------------------- #export executable=$exec_dir/make_solo_mosaic export executable=${MAKEMOSAICEXEC:-$exec_dir/hafs_make_solo_mosaic.x} @@ -175,6 +268,7 @@ elif [ $gtype = regional -a $nest_grids -gt 1 ]; then # mosaic file for coarse grids only $APRUN $executable --num_tiles 1 --dir $outdir --mosaic C${res}_coarse_mosaic --tile_file C${res}_grid.tile7.nc + $APRUN $executable --num_tiles 1 --dir $outdir --mosaic C${res}_mosaic --tile_file C${res}_grid.tile7.nc # mosaic file for nested grids only for itile in $(seq 8 $ntiles) diff --git a/ush/hafs_make_orog_gsl.sh b/ush/hafs_make_orog_gsl.sh new file mode 100755 index 000000000..75ce4c4c2 --- /dev/null +++ b/ush/hafs_make_orog_gsl.sh @@ -0,0 +1,71 @@ +#!/bin/bash +# +#----------------------------------------------------------------------- +# Script to run 'orog_gsl' executable, which generates 'oro_data' +# static topographic statistics files needed for GSL orographic +# drag suite. Source code is gsl_oro_data.f90. +#----------------------------------------------------------------------- +# + +set -eux + +nargv=$# + +if [ $nargv -ne 7 ]; then + echo "Number of arguments must be 7" + echo "Usage: $0 resolution tile griddir outdir script_dir hist_dir TMPDIR" + exit 1 +fi + +res=$1 +tile=$2 +halo=$3 +griddir=$4 +outdir=$5 +topo_am=$6 +TMPDIR=$7 +workdir=$TMPDIR/C${res}/orog_gsl/tile$tile + +#executable=$exec_dir/orog_gsl +executable=${OROGGSLEXEC:-$exec_dir/hafs_orog_gsl.x} +if [ ! -s $executable ]; then + echo "executable does not exist" + exit 1 +fi + +if [ ! -s $workdir ]; then mkdir -p $workdir ;fi +if [ ! -s $outdir ]; then mkdir -p $outdir ;fi + + +if [ $halo -eq "-999" ]; then + OUTGRID="C${res}_grid.tile${tile}.nc" +else + OUTGRID="C${res}_grid.tile${tile}.halo${halo}.nc" +fi + + +cd $workdir + +ln -sf ${griddir}/$OUTGRID . +ln -sf ${topo_am}/"HGT.Beljaars_filtered.lat-lon.30s_res.nc" . +ln -sf ${topo_am}/"geo_em.d01.lat-lon.2.5m.HGT_M.nc" . + +cp $executable . + +echo $tile > grid_info.dat +echo $res >> grid_info.dat +echo $halo >> grid_info.dat +time $executable < grid_info.dat + +if [ $? -ne 0 ]; then + echo "ERROR in running $executable " + exit 1 +else + mv ./C*oro_data_*.nc $outdir/ + echo "*oro_data_ls* and *oro_data_ss* files created" + echo "Successfully running $executable " + exit 0 +fi + +exit + diff --git a/ush/hafs_pre_job.sh.inc b/ush/hafs_pre_job.sh.inc index 836dcd8aa..2524912ea 100644 --- a/ush/hafs_pre_job.sh.inc +++ b/ush/hafs_pre_job.sh.inc @@ -27,6 +27,8 @@ if [[ -d /lfs4 ]] ; then fi target=jet module purge + module use /apps/modules/modulefiles + module use /apps/lmod/lmod/modulefiles/Core elif [[ -d /scratch1/NCEPDEV ]] ; then # We are on NOAA Hera if ( ! eval module help > /dev/null 2>&1 ) ; then @@ -35,6 +37,8 @@ elif [[ -d /scratch1/NCEPDEV ]] ; then fi target=hera module purge + module use /apps/modules/modulefiles + module use /apps/lmod/lmod/modulefiles/Core elif [[ -d /work/noaa ]] ; then # We are on MSU Orion if ( ! eval module help > /dev/null 2>&1 ) ; then @@ -48,58 +52,20 @@ elif [[ -d /work/noaa ]] ; then module use /apps/contrib/NCEPLIBS/lib/modulefiles module use /apps/contrib/NCEPLIBS/orion/modulefiles ulimit -s unlimited -elif [[ -d /gpfs/hps && -e /etc/SuSE-release ]] ; then - # We are on NOAA Luna or Surge - if ( ! eval module help > /dev/null 2>&1 ) ; then - echo load the module command 1>&2 - source /opt/modules/default/init/$__ms_shell - fi - target=wcoss_cray - - # Silence the "module purge" to avoid the expected error messages - # related to modules that load modules. - module purge > /dev/null 2>&1 - module use /usrx/local/prod/modulefiles - module use /gpfs/hps/nco/ops/nwprod/lib/modulefiles - module use /gpfs/hps/nco/ops/nwprod/modulefiles - module use /opt/cray/alt-modulefiles - module use /opt/cray/craype/default/alt-modulefiles - module use /opt/cray/ari/modulefiles - module use /opt/modulefiles - module purge > /dev/null 2>&1 - - # Workaround until module issues are fixed: - unset _LMFILES_ - unset LOADEDMODULES - echo y 2> /dev/null | module clear > /dev/null 2>&1 - - module use /usrx/local/prod/modulefiles - module use /gpfs/hps/nco/ops/nwprod/lib/modulefiles - module use /gpfs/hps/nco/ops/nwprod/modulefiles - module use /opt/cray/alt-modulefiles - module use /opt/cray/craype/default/alt-modulefiles - module use /opt/cray/ari/modulefiles - module use /opt/modulefiles - module load modules -elif [[ -L /usrx && "$( readlink /usrx 2> /dev/null )" =~ dell ]] ; then - # We are on NOAA Venus or Mars - if ( ! eval module help > /dev/null 2>&1 ) ; then - echo load the module command 1>&2 - source /usrx/local/prod/lmod/lmod/init/$__ms_shell - fi - target=wcoss_dell_p3 - module purge - source /usrx/local/prod/lmod/lmod/init/$__ms_shell elif [[ -d /lfs/h1 && -d /lfs/h2 ]] ; then + # We are on NOAA WCOSS2 + echo load the module command 1>&2 + source /usr/share/lmod/lmod/init/$__ms_shell +# . /usr/share/lmod/lmod/init/sh target=wcoss2 - . $MODULESHOME/init/sh + module purge elif [[ -d /glade ]] ; then - # We are on NCAR Yellowstone + # We are on NCAR Cheyenne if ( ! eval module help > /dev/null 2>&1 ) ; then echo load the module command 1>&2 . /usr/share/Modules/init/$__ms_shell fi - target=yellowstone + target=cheyenne module purge elif [[ -d /lustre && -d /ncrc ]] ; then # We are on GAEA. @@ -130,7 +96,7 @@ export WHERE_AM_I=${target} if [[ Q"${HOMEhafs:-}" != "Q" ]]; then module use $HOMEhafs/modulefiles - module load modulefile.hafs.$WHERE_AM_I + module load hafs.$WHERE_AM_I fi # Avoild "NetCDF: HDF error" diff --git a/ush/hafs_runcmd.sh.inc b/ush/hafs_runcmd.sh.inc index f850d251c..ce4eedd51 100644 --- a/ush/hafs_runcmd.sh.inc +++ b/ush/hafs_runcmd.sh.inc @@ -18,15 +18,7 @@ export KMP_STACKSIZE=${KMP_STACKSIZE:-2048m} # APRUNC: command to run pure mpi or mpi+omp jobs # APRUNF: command to run multi jobs from a command file # BACKGROUND: "" or "&" to implement the APRUNF capability on different platforms -if [ "$machine" = wcoss_cray ]; then - #export NODES=${NODES:-1} - export APRUNS="aprun -b -j1 -n1 -N1 -d1 -cc depth" - #export APRUNO="aprun -b -j1 -n1 -N1 -d${PURE_OMP_THREADS} -cc depth" - export APRUNO="time" - export APRUNC="aprun -b -j1 -n${TOTAL_TASKS} -N${NCTSK} -d${OMP_NUM_THREADS} -cc depth" - export APRUNF="aprun -b -j1 -n${TOTAL_TASKS} -N${NCTSK} -d${OMP_NUM_THREADS} -cc depth cfp" - export BACKGROUND="" -elif [ "$machine" = wcoss2 ]; then +if [ "$machine" = wcoss2 ]; then #export NODES=${NODES:-1} export APRUNS="time" export APRUNO="time" @@ -34,12 +26,6 @@ elif [ "$machine" = wcoss2 ]; then export APRUNF="mpiexec -n ${TOTAL_TASKS} cfp " export APRUNCFP="mpiexec" export APRUNO="time" -elif [ "$machine" = wcoss_dell_p3 ]; then - export APRUNS="time" - export APRUNO="time" - export APRUNC="mpirun -n ${TOTAL_TASKS}" - export APRUNF="mpirun -n ${TOTAL_TASKS} cfp" - export BACKGROUND="" elif [ "$machine" = jet ] || [ "$machine" = hera ] || [ "$machine" = orion ]; then export APRUNS="srun --ntasks=1 --nodes=1 --ntasks-per-node=1 --cpus-per-task=1" export APRUNO="srun --exclusive --ntasks=1 --nodes=1 --ntasks-per-node=${NCTSK} --cpus-per-task=${PURE_OMP_THREADS}" diff --git a/ush/produtil_repo b/ush/produtil_repo index f3dcf8478..503808518 160000 --- a/ush/produtil_repo +++ b/ush/produtil_repo @@ -1 +1 @@ -Subproject commit f3dcf84789418ff79df49e121b4e8fbb2e150276 +Subproject commit 503808518daef36ac4dd300794bfcaf9944c24e1 diff --git a/ush/tcutil/storminfo.py b/ush/tcutil/storminfo.py index 9d111af04..7a9eb4cf7 100644 --- a/ush/tcutil/storminfo.py +++ b/ush/tcutil/storminfo.py @@ -548,7 +548,7 @@ def __add__(self,amount): # repr(vmag),repr(dt),repr(dx),repr(dy),repr(dlat),repr(dlon))) return copy - def tcutil_domain_center(self,logger=None): + def tcutil_domain_center_storm(self,logger=None): """!Decide domain center based on the storm location. Returns a tuple containing a pair of floats (cenlo, cenla) which are the domain center longitude and latitude, respectively. Results @@ -571,78 +571,78 @@ def tcutil_domain_center(self,logger=None): ( self._cenlo, self._cenla ) = ( cenlo, cenla ) return ( cenlo, cenla ) -# def tcutil_domain_center(self,logger=None): -# """!Decide domain center based on the storm location, basin, -# and, if available, the 72hr forecast location. Returns a tuple -# containing a pair of floats (cenlo, cenla) which are the -# domain center longitude and latitude, respectively. Results -# are cached internally so future calls will not have to -# recompute the center location. -# @param logger a logging.Logger for log messages""" - -# if self._cenlo is not None and self._cenla is not None: -# return (self._cenlo,self._cenla) - -# storm_lon=self.lon -# assert(storm_lon is not None) -# storm_lat=self.lat -# if self.havefcstloc: -# assert(self.flon is not None) -# avglon=self.flon -# else: -# avglon=storm_lon-20.0 -# assert(avglon is not None) - -# # Decide center latitude. -# cenla=storm_lat -# if storm_lat<0: cenla=-cenla -# ilat=math.floor(cenla) -# if ilat < 15: cenla=15.0 -# if ilat > 25: cenla=25.0 -# if ilat >= 35: cenla=30.0 -# if ilat >= 40: cenla=35.0 -# if ilat >= 44: cenla=40.0 -# if ilat >= 50: cenla=45.0 -# if ilat >= 55: cenla=50.0 -# if storm_lat<0: cenla=-cenla - -# # Decide the center longitude. -# if logger is not None: -# logger.info('Averaging storm_lon=%f and avglon=%f'%(storm_lon,avglon)) -# diff=storm_lon-avglon -# if(diff> 360.): storm_lon -= 360.0 -# if(diff<-360.): avglon -= 360.0 -# result=int((10.0*storm_lon + 10.0*avglon)/2.0)/10.0 -# if(result > 180.0): result-=360.0 -# if(result < -180.0): result+=360.0 -# cenlo=result -# if logger is not None: -# logger.info('Decided cenlo=%f cenla=%f'%(cenlo,cenla)) -# logger.info('Storm is at lon=%f lat=%f'%(storm_lon,storm_lat)) -# # Lastly, some sanity checks to avoid outer domain centers too -# # far from storm centers: -# moved=False -# if(int(cenlo)>int(storm_lon)+5): -# cenlo=storm_lon+5.0 -# if logger is not None: -# logger.info( -# 'Center is too far east of storm. Moving it to %f' -# %(cenlo,)) -# moved=True -# if(int(cenlo) 25: cenla=25.0 + if ilat >= 35: cenla=30.0 + if ilat >= 40: cenla=35.0 + if ilat >= 44: cenla=40.0 + if ilat >= 50: cenla=45.0 + if ilat >= 55: cenla=50.0 + if storm_lat<0: cenla=-cenla + + # Decide the center longitude. + if logger is not None: + logger.info('Averaging storm_lon=%f and avglon=%f'%(storm_lon,avglon)) + diff=storm_lon-avglon + if(diff> 360.): storm_lon -= 360.0 + if(diff<-360.): avglon -= 360.0 + result=int((10.0*storm_lon + 10.0*avglon)/2.0)/10.0 + if(result > 180.0): result-=360.0 + if(result < -180.0): result+=360.0 + cenlo=result + if logger is not None: + logger.info('Decided cenlo=%f cenla=%f'%(cenlo,cenla)) + logger.info('Storm is at lon=%f lat=%f'%(storm_lon,storm_lat)) + # Lastly, some sanity checks to avoid outer domain centers too + # far from storm centers: + moved=False + if(int(cenlo)>int(storm_lon)+5): + cenlo=storm_lon+5.0 + if logger is not None: + logger.info( + 'Center is too far east of storm. Moving it to %f' + %(cenlo,)) + moved=True + if(int(cenlo)