From 3abca2bd75b849763043c327fb08c1f2fe71a66f Mon Sep 17 00:00:00 2001 From: LarissaReames-NOAA Date: Thu, 2 Sep 2021 19:09:41 +0000 Subject: [PATCH 001/109] Added unit test to be used as an instructional example for new users. --- sorc/chgres_cube.fd/grib2_util.F90 | 7 ++- tests/chgres_cube/CMakeLists.txt | 4 ++ tests/chgres_cube/ftst_example.F90 | 83 ++++++++++++++++++++++++++++++ 3 files changed, 92 insertions(+), 2 deletions(-) create mode 100644 tests/chgres_cube/ftst_example.F90 diff --git a/sorc/chgres_cube.fd/grib2_util.F90 b/sorc/chgres_cube.fd/grib2_util.F90 index c071be7ce..a0b01e36e 100644 --- a/sorc/chgres_cube.fd/grib2_util.F90 +++ b/sorc/chgres_cube.fd/grib2_util.F90 @@ -17,11 +17,14 @@ module grib2_util implicit none +public :: rh2spfh +public :: convert_omega + contains !> Convert relative humidity to specific humidity. !! -!! @param[inout] rh_sphum rel humidity on input. spec hum on output. +!! @param[inout] rh_sphum rel humidity (%) on input. spec hum (kg/kg) on output. !! @param[in] p pressure in Pa !! @param[in] t temperature !! @author Larissa Reames @@ -52,7 +55,7 @@ subroutine rh2spfh(rh_sphum,p,t) !print *, 'q = ', sphum !if (P .eq. 100000.0) THEN - ! print *, 'T = ', T, ' RH = ', RH, ' P = ', P, ' es = ', es, ' e = ', e, ' q = ', sphum + !print *, 'T = ', t, ' RH = ', rh, ' P = ', p, ' es = ', es, ' e = ', e, ' q = ', rh_sphum !end if end subroutine RH2SPFH diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index c86a6f788..3afb82840 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -174,3 +174,7 @@ add_mpi_test(chgres_cube-ftst_surface_nst_landfill add_executable(ftst_read_vcoord ftst_read_vcoord.F90) target_link_libraries(ftst_read_vcoord chgres_cube_lib) add_test(NAME chgres_cube-ftst_read_vcoord COMMAND ftst_read_vcoord) + +add_executable(ftst_example ftst_example.F90) +target_link_libraries(ftst_example chgres_cube_lib) +add_test(NAME chgres_cube-ftst_example COMMAND ftst_example) diff --git a/tests/chgres_cube/ftst_example.F90 b/tests/chgres_cube/ftst_example.F90 new file mode 100644 index 000000000..3823a6871 --- /dev/null +++ b/tests/chgres_cube/ftst_example.F90 @@ -0,0 +1,83 @@ +! Unit test for rh2spfh in grib2_utils to be used as an example for users +! learning how to write unit tests. Users are prompted to add an additional +! test for convert_omega +! Larissa Reames OU/CIMMS/NOAA/NSSL/FRDD + +program ftst_example + + use esmf + use model_grid, only : i_input, j_input + use grib2_util, only : rh2spfh + + implicit none + + real(esmf_kind_r4), allocatable :: rh_spfh(:,:), & + rh_orig(:,:), & + spfh_returned(:,:), & + spfh_correct(:,:) + real(esmf_kind_r8),allocatable :: t(:,:) + real(esmf_kind_r8) :: p + real,parameter :: EPS = 1.0E-6 + + i_input = 2 + j_input = 2 + allocate(rh_spfh(i_input,j_input)) + allocate(rh_orig(i_input,j_input)) + allocate(spfh_returned(i_input,j_input)) + allocate(spfh_correct(i_input,j_input)) + allocate(t(i_input,j_input)) + + ! ------------------------------------------------------------------------- + ! Set constants/values to be passed to the unit test. In this case it's a + ! set of single values, but it could be more complicated, like an + ! n-dimensional array or ESMF objects. + ! ------------------------------------------------------------------------- + + rh_spfh(:,:) = 50.0 ! Relative humidity (%) + p = 100000.0 ! Pressure (Pa) + t(:,:) = 300.0 ! Temperature (K) + spfh_correct(:,:) = 10.978297E-3 ! Correct specific humidity value (kg/kg) + + print*, "Starting Unit Testing rh2spfh." + + !------------------------------------------------------------------------- + ! Execute testing below by running target function rh2spfh and providing + ! values set above + !------------------------------------------------------------------------- + + rh_orig = rh_spfh ! Save the original RH value for posterity + call rh2spfh(rh_spfh,p,t) + spfh_returned = rh_spfh ! Rename the returned value for clarity + + !------------------------------------------------------------------------- + ! Check the returned value against what we know to be the correct answer. + ! If the correct result is returned (within a certain small tolerance), + ! then the test passes and the called routine is working as expected. If the + ! incorrect value is passed back, the test fails and an error is returned. + !------------------------------------------------------------------------- + + if ( any(abs(spfh_returned - spfh_correct) .lt. EPS)) then + print*, "RH2SPFH TEST PASSED. SUCCESS!" + else + print*, "RH2SPFH TEST FAILED." + print*, "TEST RETURNED VALUE OF ", spfh_returned + print*, "RETURNED VALUE EXPECT TO BE ", spfh_correct + stop 1 + endif + deallocate(rh_spfh,spfh_correct,rh_orig,spfh_returned,t) + ! ------------------------------------------------------------------------- + ! You can test multiple subroutines (units) in any test file. This would + ! be a good place to test the other subroutine in grib2_util, + ! convert_omega. Make note of the difference in variable size for this + ! routine. You don't have to pass an array of size you'd normally + ! encounter for these variables (like 200x200x64), just choose a small + ! size with the proper dimensionality, say 3x3x2, and fill it with values + ! typical of the various arrays. You can check the returned array element- + ! by-element, or use the any() command to check all elements at once. Make + ! sure to provide a helpful failure message indicating where the failure + ! occured and what the returned/expected values were at that location. Also, + ! don't forget to deallocate any allocatable arrays as this will cause a + ! failure when compiling the test with gnu compilers and address sanitizers. + ! ------------------------------------------------------------------------- + +end program ftst_example From bf9b521e05a3f1e9811153198942102cf722c94c Mon Sep 17 00:00:00 2001 From: Kyle Gerheiser <3209794+kgerheiser@users.noreply.github.com> Date: Tue, 5 Oct 2021 16:54:25 -0400 Subject: [PATCH 002/109] Add Findwgrib2.cmake (#578) The CMake build of wgrib2 was removed from the hpc-stack. Add a new package find - FindWgrib2.cmake - to find wgrib2 now. Update the chgres_cube CMakeLists.txt file for associated target changes. Fixes #577 --- .../workflows/debug-docs-test_coverage.yml | 12 ++++-- .github/workflows/intel.yml | 22 ++++++---- .github/workflows/linux-mac-nceplibs-mpi.yml | 23 +++++++---- .github/workflows/netcdf-versions.yml | 22 ++++++---- cmake/Findwgrib2.cmake | 41 +++++++++++++++++++ modulefiles/build.wcoss_cray.intel | 2 +- sorc/chgres_cube.fd/CMakeLists.txt | 3 +- 7 files changed, 94 insertions(+), 31 deletions(-) create mode 100644 cmake/Findwgrib2.cmake diff --git a/.github/workflows/debug-docs-test_coverage.yml b/.github/workflows/debug-docs-test_coverage.yml index 6e481a8dc..0f920f471 100644 --- a/.github/workflows/debug-docs-test_coverage.yml +++ b/.github/workflows/debug-docs-test_coverage.yml @@ -26,7 +26,7 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.0.1-${{ runner.os }} + key: esmf-8.0.1-${{ runner.os }}3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' @@ -53,7 +53,7 @@ jobs: uses: actions/cache@v2 with: path: ~/jasper - key: jasper-2.0.25-${{ runner.os }} + key: jasper-2.0.25-${{ runner.os }}3 - name: build-jasper if: steps.cache-jasper.outputs.cache-hit != 'true' @@ -62,7 +62,7 @@ jobs: tar zxf version-2.0.25.tar.gz cd jasper-version-2.0.25 mkdir build-jasper && cd build-jasper - cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper + cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper -DJAS_ENABLE_SHARED=OFF make -j2 make install @@ -71,7 +71,7 @@ jobs: uses: actions/cache@v2 with: path: ~/nceplibs - key: nceplibs-1.3.0-${{ runner.os }} + key: nceplibs-1.3.0-${{ runner.os }}3 - name: build-nceplibs if: steps.cache-nceplibs.outputs.cache-hit != 'true' @@ -97,6 +97,10 @@ jobs: export CC=mpicc export CXX=mpicxx export FC=mpifort + # Findwgrib2 in module form does not search -version + # as NCEPLIBS installs it + export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" + export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_PREFIX_PATH='~/jasper;~/nceplibs' -DCMAKE_BUILD_TYPE=Debug -DENABLE_DOCS=On -DCMAKE_Fortran_FLAGS="-g -fprofile-arcs -ftest-coverage -O0" make -j2 diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index e4266dc6d..cb0231749 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -37,7 +37,7 @@ jobs: uses: actions/cache@v2 with: path: ~/netcdf - key: netcdf-c-$4.7.4-{{ runner.os }}-intel + key: netcdf-c-$4.7.4-{{ runner.os }}-intel3 - name: build-hdf5 if: steps.cache-netcdf.outputs.cache-hit != 'true' @@ -46,7 +46,7 @@ jobs: wget https://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-1.10.7/src/hdf5-1.10.7.tar.gz &> /dev/null tar -xzf hdf5-1.10.7.tar.gz pushd hdf5-1.10.7 - ./configure --prefix=${HOME}/netcdf --enable-parallel --disable-tools --disable-fortran --disable-cxx --enable-parallel-tests + ./configure --prefix=${HOME}/netcdf --enable-parallel --disable-tools --disable-fortran --disable-cxx --enable-parallel-tests --disable-shared --disable-shared --enable-static make -j2 make install @@ -59,7 +59,7 @@ jobs: wget https://www.unidata.ucar.edu/downloads/netcdf/ftp/netcdf-c-4.7.4.tar.gz &> /dev/null tar -xzf netcdf-c-4.7.4.tar.gz pushd netcdf-c-4.7.4 - ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities + ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities --disable-shared make -j2 make install @@ -72,10 +72,11 @@ jobs: export FC=mpiifort export CPPFLAGS=-I${HOME}/netcdf/include export LDFLAGS=-L${HOME}/netcdf/lib + export LIBS=`nc-config --libs` wget https://github.com/Unidata/netcdf-fortran/archive/v4.5.3.tar.gz &> /dev/null tar -xzf v4.5.3.tar.gz pushd netcdf-fortran-4.5.3 - ./configure --prefix=${HOME}/netcdf + ./configure --prefix=${HOME}/netcdf --disable-shared make -j2 make install @@ -84,7 +85,7 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.0.1-${{ runner.os }}-intel + key: esmf-8.0.1-${{ runner.os }}-intel3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' @@ -103,6 +104,7 @@ jobs: export ESMF_NETCDF=split export ESMF_NETCDF_INCLUDE=${HOME}/netcdf/include export ESMF_NETCDF_LIBPATH=${HOME}/netcdf/lib + export ESMF_NETCDF_LIBS="-lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz" make -j2 make install @@ -111,7 +113,7 @@ jobs: uses: actions/cache@v2 with: path: ~/jasper - key: jasper-2.0.25-${{ runner.os }}-intel + key: jasper-2.0.25-${{ runner.os }}-intel3 - name: build-jasper if: steps.cache-jasper.outputs.cache-hit != 'true' @@ -120,7 +122,7 @@ jobs: tar zxf version-2.0.25.tar.gz cd jasper-version-2.0.25 mkdir build-jasper && cd build-jasper - cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper + cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper -DJAS_ENABLE_SHARED=OFF make -j2 make install @@ -135,7 +137,7 @@ jobs: uses: actions/cache@v2 with: path: ~/nceplibs - key: nceplibs-1.3.0-${{ runner.os }}-intel + key: nceplibs-1.3.0-${{ runner.os }}-intel3 - name: build-nceplibs if: steps.cache-nceplibs.outputs.cache-hit != 'true' @@ -158,6 +160,10 @@ jobs: export ESMFMKFILE=~/esmf/lib/esmf.mk cd ufs_utils mkdir build && cd build + # Findwgrib2 in module form does not search -version + # as NCEPLIBS installs it + export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" + export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_BUILD_TYPE=Debug -DCMAKE_PREFIX_PATH='~;~/jasper;~/nceplibs;~/netcdf' make -j2 diff --git a/.github/workflows/linux-mac-nceplibs-mpi.yml b/.github/workflows/linux-mac-nceplibs-mpi.yml index e0f29b610..4776bec3b 100644 --- a/.github/workflows/linux-mac-nceplibs-mpi.yml +++ b/.github/workflows/linux-mac-nceplibs-mpi.yml @@ -75,7 +75,7 @@ jobs: uses: actions/cache@v2 with: path: ~/netcdf - key: netcdf-c-${{ matrix.netcdf_version }}-${{ runner.os }}-${{ matrix.mpi_type }} + key: netcdf-c-${{ matrix.netcdf_version }}-${{ runner.os }}-${{ matrix.mpi_type }}3 - name: build-hdf5 if: steps.cache-netcdf.outputs.cache-hit != 'true' @@ -84,7 +84,7 @@ jobs: wget https://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-1.10.7/src/hdf5-1.10.7.tar.gz &> /dev/null tar -xzf hdf5-1.10.7.tar.gz pushd hdf5-1.10.7 - ./configure --prefix=${HOME}/netcdf --enable-parallel --disable-tools --disable-fortran --disable-cxx --enable-parallel-tests + ./configure --prefix=${HOME}/netcdf --enable-parallel --disable-tools --disable-fortran --disable-cxx --enable-parallel-tests --disable-shared --enable-static make -j2 make install @@ -97,7 +97,7 @@ jobs: wget https://www.unidata.ucar.edu/downloads/netcdf/ftp/netcdf-c-${{ matrix.netcdf_version }}.tar.gz &> /dev/null tar -xzf netcdf-c-${{ matrix.netcdf_version }}.tar.gz cd netcdf-c-${{ matrix.netcdf_version }} - ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities + ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities --disable-shared make -j2 make install @@ -110,10 +110,11 @@ jobs: export FC=mpifort export CPPFLAGS=-I${HOME}/netcdf/include export LDFLAGS=-L${HOME}/netcdf/lib + export LIBS=`nc-config --libs` wget https://github.com/Unidata/netcdf-fortran/archive/v4.5.3.tar.gz &> /dev/null tar -xzf v4.5.3.tar.gz pushd netcdf-fortran-4.5.3 - ./configure --prefix=${HOME}/netcdf + ./configure --prefix=${HOME}/netcdf --disable-shared make -j2 make install @@ -122,7 +123,7 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf--8.0.1-${{ runner.os }}-${{ matrix.mpi_type }}-netcdf-${{ matrix.netcdf_version }} + key: esmf--8.0.1-${{ runner.os }}-${{ matrix.mpi_type }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' @@ -146,6 +147,7 @@ jobs: export ESMF_NETCDF=split export ESMF_NETCDF_INCLUDE=${HOME}/netcdf/include export ESMF_NETCDF_LIBPATH=${HOME}/netcdf/lib + export ESMF_NETCDF_LIBS="-lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz" make -j2 make install @@ -154,7 +156,7 @@ jobs: uses: actions/cache@v2 with: path: ~/jasper - key: jasper-2.0.25-${{ runner.os }} + key: jasper-2.0.25-${{ runner.os }}3 - name: build-jasper if: steps.cache-jasper.outputs.cache-hit != 'true' @@ -165,7 +167,7 @@ jobs: tar zxf version-2.0.25.tar.gz cd jasper-version-2.0.25 mkdir build-jasper && cd build-jasper - cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper + cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper -DJAS_ENABLE_SHARED=OFF make -j2 make install @@ -187,7 +189,7 @@ jobs: uses: actions/cache@v2 with: path: ~/nceplibs - key: nceplibs-${{ matrix.nceplibs_version }}-${{ runner.os }}-${{ matrix.mpi_type }}-${{ hashFiles('nceplibs/hash.txt') }} + key: nceplibs-${{ matrix.nceplibs_version }}-${{ runner.os }}-${{ matrix.mpi_type }}-${{ hashFiles('nceplibs/hash.txt') }}3 - name: build-nceplibs if: steps.cache-nceplibs.outputs.cache-hit != 'true' @@ -212,6 +214,11 @@ jobs: export CC=mpicc export CXX=mpicxx export FC=mpifort + # Findwgrib2 in module form does not search -version + # as NCEPLIBS installs it + export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" + export DYLD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" + export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_PREFIX_PATH='~/jasper;~/nceplibs;~/netcdf' make -j2 diff --git a/.github/workflows/netcdf-versions.yml b/.github/workflows/netcdf-versions.yml index 53cad1f20..c286011a7 100644 --- a/.github/workflows/netcdf-versions.yml +++ b/.github/workflows/netcdf-versions.yml @@ -28,7 +28,7 @@ jobs: uses: actions/cache@v2 with: path: ~/netcdf - key: netcdf-c-${{ matrix.netcdf_version }}-${{ runner.os }} + key: netcdf-c-${{ matrix.netcdf_version }}-${{ runner.os }}3 - name: build-hdf5 if: steps.cache-netcdf.outputs.cache-hit != 'true' @@ -37,7 +37,7 @@ jobs: wget https://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-1.10.7/src/hdf5-1.10.7.tar.gz &> /dev/null tar -xzf hdf5-1.10.7.tar.gz pushd hdf5-1.10.7 - ./configure --prefix=${HOME}/netcdf --enable-parallel --disable-tools --disable-fortran --disable-cxx --enable-parallel-tests + ./configure --prefix=${HOME}/netcdf --enable-parallel --disable-tools --disable-fortran --disable-cxx --enable-parallel-tests --disable-shared --enable-static make -j2 make install @@ -50,7 +50,7 @@ jobs: wget https://www.unidata.ucar.edu/downloads/netcdf/ftp/netcdf-c-${{ matrix.netcdf_version }}.tar.gz &> /dev/null tar -xzf netcdf-c-${{ matrix.netcdf_version }}.tar.gz cd netcdf-c-${{ matrix.netcdf_version }} - ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities + ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities --disable-shared make -j2 make install @@ -63,10 +63,11 @@ jobs: export FC=mpifort export CPPFLAGS=-I${HOME}/netcdf/include export LDFLAGS=-L${HOME}/netcdf/lib + export LIBS=`nc-config --libs` wget https://github.com/Unidata/netcdf-fortran/archive/v4.5.3.tar.gz &> /dev/null tar -xzf v4.5.3.tar.gz pushd netcdf-fortran-4.5.3 - ./configure --prefix=${HOME}/netcdf + ./configure --prefix=${HOME}/netcdf --disable-shared make -j2 make install @@ -75,7 +76,7 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.0.1-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }} + key: esmf-8.0.1-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-esmf #if: steps.cache-esmf.outputs.cache-hit != 'true' @@ -94,6 +95,7 @@ jobs: export ESMF_NETCDF=split export ESMF_NETCDF_INCLUDE=${HOME}/netcdf/include export ESMF_NETCDF_LIBPATH=${HOME}/netcdf/lib + export ESMF_NETCDF_LIBS="-lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz" make -j2 make install @@ -102,7 +104,7 @@ jobs: uses: actions/cache@v2 with: path: ~/jasper - key: jasper-2.0.25-${{ runner.os }} + key: jasper-2.0.25-${{ runner.os }}3 - name: build-jasper if: steps.cache-jasper.outputs.cache-hit != 'true' @@ -111,7 +113,7 @@ jobs: tar zxf version-2.0.25.tar.gz cd jasper-version-2.0.25 mkdir build-jasper && cd build-jasper - cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper + cmake .. -DCMAKE_INSTALL_PREFIX=~/jasper -DJAS_ENABLE_SHARED=OFF make -j2 make install @@ -120,7 +122,7 @@ jobs: uses: actions/cache@v2 with: path: ~/nceplibs - key: nceplibs-1.3.0-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }} + key: nceplibs-1.3.0-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-nceplibs if: steps.cache-nceplibs.outputs.cache-hit != 'true' @@ -146,6 +148,10 @@ jobs: export CC=mpicc export CXX=mpicxx export FC=mpifort + # Findwgrib2 in module form does not search -version + # as NCEPLIBS installs it + export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" + export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_PREFIX_PATH='~/jasper;~/nceplibs;~/netcdf' -DCMAKE_BUILD_TYPE=Debug make -j2 diff --git a/cmake/Findwgrib2.cmake b/cmake/Findwgrib2.cmake new file mode 100644 index 000000000..68b8833c4 --- /dev/null +++ b/cmake/Findwgrib2.cmake @@ -0,0 +1,41 @@ +# This module produces the target wgrib2::wgrib2 + +find_path(WGRIB2_INCLUDES wgrib2api.mod) +find_library(WGRIB2_LIB libwgrib2.a) +find_library(WGRIB2_API_LIB libwgrib2_api.a) + +add_library(wgrib2::wgrib2 UNKNOWN IMPORTED) + +# Library builds are different between CMake build and the make build. +# libwgrib2_api.a is only necessary in the CMake build and must come first when linking +if(WGRIB2_API_LIB) + # CMake build. Need both. + set(first_lib ${WGRIB2_API_LIB}) + set(second_lib ${WGRIB2_LIB}) +else() + # Makefile build. Only need libwgrib2.a + set(first_lib ${WGRIB2_LIB}) + set(second_lib "") +endif() + +set_target_properties(wgrib2::wgrib2 PROPERTIES + IMPORTED_LOCATION "${first_lib}" + INTERFACE_INCLUDE_DIRECTORIES "${WGRIB2_INCLUDES}" + INTERFACE_LINK_LIBRARIES "${second_lib}") + +set(WGRIB2_LIBRARIES "${first_lib}" "${second_lib}") + +find_program(WGRIB2_EXE wgrib2) +execute_process(COMMAND ${WGRIB2_EXE} --version OUTPUT_VARIABLE version_str) + +# Wgrib2 changed how it output --version from "v0.x.y.z" to "vx.y.z" starting in wgrib2 3.0 +if(version_str MATCHES "^v0.*") + string(SUBSTRING "${version_str}" 3 5 version) +else() + string(SUBSTRING "${version_str}" 1 5 version) +endif() + +find_package_handle_standard_args(wgrib2 + REQUIRED_VARS WGRIB2_LIBRARIES WGRIB2_INCLUDES WGRIB2_EXE + VERSION_VAR version + ) diff --git a/modulefiles/build.wcoss_cray.intel b/modulefiles/build.wcoss_cray.intel index c6e297d28..d8bdc424d 100644 --- a/modulefiles/build.wcoss_cray.intel +++ b/modulefiles/build.wcoss_cray.intel @@ -16,7 +16,7 @@ module load alps/5.2.4-2.0502.9822.32.1.ari module load cray-netcdf/4.3.3.1 module load cray-hdf5/1.8.14 -module use /usrx/local/nceplibs/NCEPLIBS/cmake/install/NCEPLIBS-v1.2.0/modules +module use /usrx/local/nceplibs/NCEPLIBS/cmake/install/NCEPLIBS-v1.3.0/modules module load bacio/2.4.1 module load g2/3.4.1 module load ip/3.3.3 diff --git a/sorc/chgres_cube.fd/CMakeLists.txt b/sorc/chgres_cube.fd/CMakeLists.txt index 90101ab0b..7b6ad9388 100644 --- a/sorc/chgres_cube.fd/CMakeLists.txt +++ b/sorc/chgres_cube.fd/CMakeLists.txt @@ -49,8 +49,7 @@ target_link_libraries( sp::sp_d w3nco::w3nco_d esmf - wgrib2::wgrib2_lib - wgrib2::wgrib2_api + wgrib2::wgrib2 MPI::MPI_Fortran NetCDF::NetCDF_Fortran) From 7d8dbae3a2b716a1c1eceff5dbc45f8504d09565 Mon Sep 17 00:00:00 2001 From: LarissaReames-NOAA Date: Tue, 5 Oct 2021 20:59:13 +0000 Subject: [PATCH 003/109] Updates to test README to add instructions for use of example unit test. --- tests/README.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/README.md b/tests/README.md index aee9106fb..2a01448de 100644 --- a/tests/README.md +++ b/tests/README.md @@ -86,6 +86,17 @@ To run the tests locally, invoke one of the following after the `make install`: For the parallel tests to run locally, update the machine-specific "mpi_exec" script under [cmake](../cmake) with your run account and queue. +### EXAMPLE UNIT TEST: + +An example unit test, ftst_example.F90, exists in the tests/chgres_cube directory +and is currently compiled and run with existing tests + +This simple test checks whether the routine rh2spfh in chgres_cube.fd/grib2_util.F90 +is working correctly, and contains detailed comments explaining what each section +of the test does. It also prompts the user to create additional lines of code to +test one more subroutine from grib2_util.F90. Use this to get started understanding +the unit test framework. + ### QUESTIONS Please contact the repository managers: https://github.com/NOAA-EMC/UFS_UTILS/wiki From c49c767f7fda75dd9cc744507d5763f74a7b6235 Mon Sep 17 00:00:00 2001 From: LarissaReames-NOAA Date: Wed, 6 Oct 2021 16:15:40 +0000 Subject: [PATCH 004/109] Move verbose output from example unit test to be commented to streamline test output. --- tests/chgres_cube/ftst_example.F90 | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/tests/chgres_cube/ftst_example.F90 b/tests/chgres_cube/ftst_example.F90 index 3823a6871..7d8957611 100644 --- a/tests/chgres_cube/ftst_example.F90 +++ b/tests/chgres_cube/ftst_example.F90 @@ -56,15 +56,31 @@ program ftst_example ! incorrect value is passed back, the test fails and an error is returned. !------------------------------------------------------------------------- - if ( any(abs(spfh_returned - spfh_correct) .lt. EPS)) then - print*, "RH2SPFH TEST PASSED. SUCCESS!" - else - print*, "RH2SPFH TEST FAILED." - print*, "TEST RETURNED VALUE OF ", spfh_returned - print*, "RETURNED VALUE EXPECT TO BE ", spfh_correct + if ( any(abs(spfh_returned - spfh_correct) .gt. EPS)) then stop 1 + print*, "RH2SPFH TEST FAILED." endif + + !------------------------------------------------------------------------- + ! If you are trying to debug a test failure, code like the commented + ! section below might prove useful. + !------------------------------------------------------------------------- + + ! if ( any(abs(spfh_returned - spfh_correct) .lt. EPS)) then + ! print*, "RH2SPFH TEST PASSED. SUCCESS!" + ! else + ! print*, "RH2SPFH TEST FAILED." + ! print*, "TEST RETURNED VALUE OF ", spfh_returned + ! print*, "RETURNED VALUE EXPECT TO BE ", spfh_correct + ! stop 1 + ! endif + + !------------------------------------------------------------------------- + ! Make sure to deallocate any and all allocatable arrays that you use + !------------------------------------------------------------------------- + deallocate(rh_spfh,spfh_correct,rh_orig,spfh_returned,t) + ! ------------------------------------------------------------------------- ! You can test multiple subroutines (units) in any test file. This would ! be a good place to test the other subroutine in grib2_util, From b8cdc88784f6d799f4f4f031e8daf5b9697d0df8 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 8 Oct 2021 16:43:03 -0400 Subject: [PATCH 005/109] Add compiler flags for GNU Fortran v10 or newer compilers. (#583) Fixes #551 and #554. --- CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9c4e752f9..3657c8ade 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -34,6 +34,9 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -check -check noarg_temp_created -check nopointer -fp-stack-check -fstack-protector-all -fpe0 -debug -ftrapuv") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -fbacktrace") + if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch -fallow-invalid-boz") + endif() set(CMAKE_Fortran_FLAGS_RELEASE "-O3") set(CMAKE_Fortran_FLAGS_DEBUG "-O1 -ggdb -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans -ffpe-trap=invalid,zero,overflow -fbounds-check -fsanitize=address -fno-omit-frame-pointer -fno-optimize-sibling-calls") endif() From ee80df64752b0dab3b7012b1007d4c626c21d2d9 Mon Sep 17 00:00:00 2001 From: Larissa Reames <52886575+LarissaReames-NOAA@users.noreply.github.com> Date: Thu, 14 Oct 2021 07:25:56 -0500 Subject: [PATCH 006/109] chgres_cube - Simplify surface processing using field bundles (#572) Combine surface fields into ESMF field bundles. Replace individual calls to the regridding and search routines with new routines 'regrid_many' and 'search_many' that operate on these bundles. This results in a significant reduction in the length of surface.F90. Include new unit tests for 'regrid_many' and 'search_many'. Fixes #504. --- sorc/chgres_cube.fd/input_data.F90 | 88 +- sorc/chgres_cube.fd/surface.F90 | 2274 ++++++----------- tests/chgres_cube/CMakeLists.txt | 36 +- .../chgres_cube/ftst_surface_regrid_many.F90 | 395 +++ .../chgres_cube/ftst_surface_search_many.F90 | 523 ++++ 5 files changed, 1760 insertions(+), 1556 deletions(-) create mode 100644 tests/chgres_cube/ftst_surface_regrid_many.F90 create mode 100644 tests/chgres_cube/ftst_surface_search_many.F90 diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index e3f4b12de..b7029a59f 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -72,33 +72,33 @@ module input_data !< Default is igbp. integer, parameter :: ICET_DEFAULT = 265.0 !< Default value of soil and skin !< temperature (K) over ice. - type(esmf_field), public :: canopy_mc_input_grid !< canopy moist content - type(esmf_field), public :: f10m_input_grid !< log((z0+10)*1/z0) - type(esmf_field), public :: ffmm_input_grid !< log((z0+z1)*1/z0) + type(esmf_field), public :: canopy_mc_input_grid !< canopy moist content + type(esmf_field), public :: f10m_input_grid !< log((z0+10)*1/z0) + type(esmf_field), public :: ffmm_input_grid !< log((z0+z1)*1/z0) !! See sfc_diff.f for details. - type(esmf_field), public :: landsea_mask_input_grid !< land sea mask; + type(esmf_field), public :: landsea_mask_input_grid !< land sea mask; !! 0-water, 1-land, 2-ice - type(esmf_field), public :: q2m_input_grid !< 2-m spec hum - type(esmf_field), public :: seaice_depth_input_grid !< sea ice depth - type(esmf_field), public :: seaice_fract_input_grid !< sea ice fraction - type(esmf_field), public :: seaice_skin_temp_input_grid !< sea ice skin temp - type(esmf_field), public :: skin_temp_input_grid !< skin temp/sst - type(esmf_field), public :: snow_depth_input_grid !< snow dpeth - type(esmf_field), public :: snow_liq_equiv_input_grid !< snow liq equiv depth - type(esmf_field), public :: soil_temp_input_grid !< 3-d soil temp - type(esmf_field), public :: soil_type_input_grid !< soil type - type(esmf_field), public :: soilm_liq_input_grid !< 3-d liquid soil moisture - type(esmf_field), public :: soilm_tot_input_grid !< 3-d total soil moisture - type(esmf_field), public :: srflag_input_grid !< snow/rain flag - type(esmf_field), public :: t2m_input_grid !< 2-m temperature - type(esmf_field), public :: tprcp_input_grid !< precip - type(esmf_field), public :: ustar_input_grid !< fric velocity - type(esmf_field), public :: veg_type_input_grid !< vegetation type - type(esmf_field), public :: z0_input_grid !< roughness length - type(esmf_field), public :: veg_greenness_input_grid !< vegetation fraction - type(esmf_field), public :: lai_input_grid !< leaf area index - type(esmf_field), public :: max_veg_greenness_input_grid !< shdmax - type(esmf_field), public :: min_veg_greenness_input_grid !< shdmin + type(esmf_field), public :: q2m_input_grid !< 2-m spec hum + type(esmf_field), public :: seaice_depth_input_grid !< sea ice depth + type(esmf_field), public :: seaice_fract_input_grid !< sea ice fraction + type(esmf_field), public :: seaice_skin_temp_input_grid !< sea ice skin temp + type(esmf_field), public :: skin_temp_input_grid !< skin temp/sst + type(esmf_field), public :: snow_depth_input_grid !< snow dpeth + type(esmf_field), public :: snow_liq_equiv_input_grid !< snow liq equiv depth + type(esmf_field), public :: soil_temp_input_grid !< 3-d soil temp + type(esmf_field), public :: soil_type_input_grid !< soil type + type(esmf_field), public :: soilm_liq_input_grid !< 3-d liquid soil moisture + type(esmf_field), public :: soilm_tot_input_grid !< 3-d total soil moisture + type(esmf_field), public :: srflag_input_grid !< snow/rain flag + type(esmf_field), public :: t2m_input_grid !< 2-m temperature + type(esmf_field), public :: tprcp_input_grid !< precip + type(esmf_field), public :: ustar_input_grid !< fric velocity + type(esmf_field), public :: veg_type_input_grid !< vegetation type + type(esmf_field), public :: z0_input_grid !< roughness length + type(esmf_field), public :: veg_greenness_input_grid !< vegetation fraction + type(esmf_field), public :: lai_input_grid !< leaf area index + type(esmf_field), public :: max_veg_greenness_input_grid !< shdmax + type(esmf_field), public :: min_veg_greenness_input_grid !< shdmin integer, public :: lsoil_input=4 !< number of soil layers, no longer hardwired to allow !! for 7 layers of soil for the RUC LSM @@ -107,25 +107,25 @@ module input_data ! Fields associated with the nst model. - type(esmf_field), public :: c_d_input_grid !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public :: c_0_input_grid !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public :: d_conv_input_grid !< Thickness of free convection layer - type(esmf_field), public :: dt_cool_input_grid !< Sub-layer cooling amount - type(esmf_field), public :: ifd_input_grid !< Model mode index. 0-diurnal model not + type(esmf_field), public :: c_d_input_grid !< Coefficient 2 to calculate d(tz)/d(ts) + type(esmf_field), public :: c_0_input_grid !< Coefficient 1 to calculate d(tz)/d(ts) + type(esmf_field), public :: d_conv_input_grid !< Thickness of free convection layer + type(esmf_field), public :: dt_cool_input_grid !< Sub-layer cooling amount + type(esmf_field), public :: ifd_input_grid !< Model mode index. 0-diurnal model not !< started; 1-diurnal model started. - type(esmf_field), public :: qrain_input_grid !< Sensible heat flux due to rainfall - type(esmf_field), public :: tref_input_grid !< Reference temperature - type(esmf_field), public :: w_d_input_grid !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public :: w_0_input_grid !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public :: xs_input_grid !< Salinity content in diurnal thermocline layer - type(esmf_field), public :: xt_input_grid !< Heat content in diurnal thermocline layer - type(esmf_field), public :: xu_input_grid !< u-current content in diurnal thermocline layer - type(esmf_field), public :: xv_input_grid !< v-current content in diurnal thermocline layer - type(esmf_field), public :: xz_input_grid !< Diurnal thermocline layer thickness - type(esmf_field), public :: xtts_input_grid !< d(xt)/d(ts) - type(esmf_field), public :: xzts_input_grid !< d(xz)/d(ts) - type(esmf_field), public :: z_c_input_grid !< Sub-layer cooling thickness - type(esmf_field), public :: zm_input_grid !< Oceanic mixed layer depth + type(esmf_field), public :: qrain_input_grid !< Sensible heat flux due to rainfall + type(esmf_field), public :: tref_input_grid !< Reference temperature + type(esmf_field), public :: w_d_input_grid !< Coefficient 4 to calculate d(tz)/d(ts) + type(esmf_field), public :: w_0_input_grid !< Coefficient 3 to calculate d(tz)/d(ts) + type(esmf_field), public :: xs_input_grid !< Salinity content in diurnal thermocline layer + type(esmf_field), public :: xt_input_grid !< Heat content in diurnal thermocline layer + type(esmf_field), public :: xu_input_grid !< u-current content in diurnal thermocline layer + type(esmf_field), public :: xv_input_grid !< v-current content in diurnal thermocline layer + type(esmf_field), public :: xz_input_grid !< Diurnal thermocline layer thickness + type(esmf_field), public :: xtts_input_grid !< d(xt)/d(ts) + type(esmf_field), public :: xzts_input_grid !< d(xz)/d(ts) + type(esmf_field), public :: z_c_input_grid !< Sub-layer cooling thickness + type(esmf_field), public :: zm_input_grid !< Oceanic mixed layer depth public :: read_input_atm_data public :: cleanup_input_atm_data @@ -6512,7 +6512,7 @@ subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d) else call error_handler("ERROR USING MISSING_VAR_METHOD. PLEASE SET VALUES IN" // & " VARMAP TABLE TO ONE OF: set_to_fill, set_to_NaN,"// & - " , skip, or stop.", 1) + " , intrp, skip, or stop.", 1) endif end subroutine handle_grib_error diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index e46c79f6c..c8cc2961a 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -33,88 +33,88 @@ module surface !< are applied at these points. ! surface fields (not including nst) - type(esmf_field), public :: canopy_mc_target_grid + type(esmf_field), public :: canopy_mc_target_grid !< canopy moisture content - type(esmf_field), public :: f10m_target_grid + type(esmf_field), public :: f10m_target_grid !< log((z0+10)*1/z0) !< See sfc_diff.f for details - type(esmf_field), public :: ffmm_target_grid + type(esmf_field), public :: ffmm_target_grid !< log((z0+z1)*1/z0) !< See sfc_diff.f for details - type(esmf_field), public :: q2m_target_grid + type(esmf_field), public :: q2m_target_grid !< 2-m specific humidity - type(esmf_field), public :: seaice_depth_target_grid + type(esmf_field), public :: seaice_depth_target_grid !< sea ice depth - type(esmf_field), public :: seaice_fract_target_grid + type(esmf_field), public :: seaice_fract_target_grid !< sea ice fraction - type(esmf_field), public :: seaice_skin_temp_target_grid + type(esmf_field), public :: seaice_skin_temp_target_grid !< sea ice skin temperature - type(esmf_field), public :: skin_temp_target_grid + type(esmf_field), public :: skin_temp_target_grid !< skin temperature/sst - type(esmf_field), public :: srflag_target_grid + type(esmf_field), public :: srflag_target_grid !< snow/rain flag - type(esmf_field), public :: snow_liq_equiv_target_grid + type(esmf_field), public :: snow_liq_equiv_target_grid !< liquid equiv snow depth - type(esmf_field), public :: snow_depth_target_grid + type(esmf_field), public :: snow_depth_target_grid !< physical snow depth - type(esmf_field), public :: soil_temp_target_grid + type(esmf_field), public :: soil_temp_target_grid !< 3-d soil temperature - type(esmf_field), public :: soilm_liq_target_grid + type(esmf_field), public :: soilm_liq_target_grid !< 3-d liquid soil moisture - type(esmf_field), public :: soilm_tot_target_grid + type(esmf_field), public :: soilm_tot_target_grid !< 3-d total soil moisture - type(esmf_field), public :: t2m_target_grid + type(esmf_field), public :: t2m_target_grid !< 2-m temperatrure - type(esmf_field), public :: tprcp_target_grid + type(esmf_field), public :: tprcp_target_grid !< precip - type(esmf_field), public :: ustar_target_grid + type(esmf_field), public :: ustar_target_grid !< friction velocity - type(esmf_field), public :: z0_target_grid + type(esmf_field), public :: z0_target_grid !< roughness length - type(esmf_field), public :: lai_target_grid + type(esmf_field), public :: lai_target_grid !< leaf area index ! nst fields - type(esmf_field), public :: c_d_target_grid + type(esmf_field), public :: c_d_target_grid !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public :: c_0_target_grid + type(esmf_field), public :: c_0_target_grid !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public :: d_conv_target_grid + type(esmf_field), public :: d_conv_target_grid !< Thickness of free convection layer - type(esmf_field), public :: dt_cool_target_grid + type(esmf_field), public :: dt_cool_target_grid !< Sub-layer cooling amount - type(esmf_field), public :: ifd_target_grid + type(esmf_field), public :: ifd_target_grid !< Model mode index. 0-diurnal model not !< started; 1-diurnal model started. - type(esmf_field), public :: qrain_target_grid + type(esmf_field), public :: qrain_target_grid !< Sensible heat flux due to rainfall - type(esmf_field), public :: tref_target_grid + type(esmf_field), public :: tref_target_grid !< reference temperature - type(esmf_field), public :: w_d_target_grid + type(esmf_field), public :: w_d_target_grid !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public :: w_0_target_grid + type(esmf_field), public :: w_0_target_grid !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public :: xs_target_grid + type(esmf_field), public :: xs_target_grid !< Salinity content in diurnal !< thermocline layer - type(esmf_field), public :: xt_target_grid + type(esmf_field), public :: xt_target_grid !< Heat content in diurnal thermocline !< layer - type(esmf_field), public :: xu_target_grid + type(esmf_field), public :: xu_target_grid !< u-current content in diurnal !< thermocline layer - type(esmf_field), public :: xv_target_grid + type(esmf_field), public :: xv_target_grid !< v-current content in diurnal !< thermocline layer - type(esmf_field), public :: xz_target_grid + type(esmf_field), public :: xz_target_grid !< Diurnal thermocline layer thickness - type(esmf_field), public :: xtts_target_grid + type(esmf_field), public :: xtts_target_grid !< d(xt)/d(ts) - type(esmf_field), public :: xzts_target_grid + type(esmf_field), public :: xzts_target_grid !< d(xz)/d(ts) - type(esmf_field), public :: z_c_target_grid + type(esmf_field), public :: z_c_target_grid !< Sub-layer cooling thickness - type(esmf_field), public :: zm_target_grid + type(esmf_field), public :: zm_target_grid !< Oceanic mixed layer depth type(esmf_field) :: soil_type_from_input_grid @@ -137,6 +137,18 @@ module surface !< gravity real, parameter, private :: hlice = 3.335E5 !< latent heat of fusion + + + type realptr_2d + real(esmf_kind_r8), pointer :: p(:,:) + !< array of 2d pointers + end type realptr_2d + !< pointer to hold array of 2d pointers + type realptr_3d + real(esmf_kind_r8), pointer :: p(:,:,:) + !< array of 3d pointers + end type realptr_3d + !< pointer to hold array of 3d pointers public :: surface_driver public :: create_nst_esmf_fields @@ -145,6 +157,8 @@ module surface public :: cleanup_target_sfc_data public :: nst_land_fill public :: cleanup_target_nst_data + public :: regrid_many + public :: search_many contains @@ -219,8 +233,7 @@ subroutine surface_driver(localpet) call interp(localpet) !--------------------------------------------------------------------------------------------- -! Adjust soil/landice column temperatures for any change in elevation between -! the +! Adjust soil/landice column temperatures for any change in elevation between the ! input and target grids. !--------------------------------------------------------------------------------------------- @@ -353,9 +366,7 @@ subroutine interp(localpet) vgfrc_from_climo, & minmax_vgfrc_from_climo, & lai_from_climo, & - tg3_from_soil, & - external_model, & - input_type + tg3_from_soil use static_data, only : veg_type_target_grid, & soil_type_target_grid, & @@ -374,6 +385,9 @@ subroutine interp(localpet) integer :: i, j, ij, rc, tile integer :: clb_target(2), cub_target(2) integer :: isrctermprocessing + integer :: num_fields + integer :: sotyp_ind, vgfrc_ind, mmvg_ind, lai_ind + integer, allocatable :: search_nums(:) integer(esmf_kind_i4), pointer :: unmapped_ptr(:) integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:) integer(esmf_kind_i4), pointer :: mask_target_ptr(:,:) @@ -387,47 +401,14 @@ subroutine interp(localpet) real(esmf_kind_r8), allocatable :: data_one_tile2(:,:) real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) - real(esmf_kind_r8), allocatable :: soil_type_target_grid_save(:,:) - real(esmf_kind_r8), pointer :: canopy_mc_target_ptr(:,:) - real(esmf_kind_r8), pointer :: c_d_target_ptr(:,:) - real(esmf_kind_r8), pointer :: c_0_target_ptr(:,:) - real(esmf_kind_r8), pointer :: d_conv_target_ptr(:,:) - real(esmf_kind_r8), pointer :: dt_cool_target_ptr(:,:) - real(esmf_kind_r8), pointer :: ifd_target_ptr(:,:) - real(esmf_kind_r8), pointer :: qrain_target_ptr(:,:) - real(esmf_kind_r8), pointer :: tref_target_ptr(:,:) - real(esmf_kind_r8), pointer :: w_d_target_ptr(:,:) - real(esmf_kind_r8), pointer :: w_0_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xs_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xt_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xu_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xv_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xz_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xtts_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xzts_target_ptr(:,:) - real(esmf_kind_r8), pointer :: z_c_target_ptr(:,:) - real(esmf_kind_r8), pointer :: zm_target_ptr(:,:) - real(esmf_kind_r8), pointer :: seaice_depth_target_ptr(:,:) real(esmf_kind_r8), pointer :: seaice_fract_target_ptr(:,:) - real(esmf_kind_r8), pointer :: seaice_skin_temp_target_ptr(:,:) - real(esmf_kind_r8), pointer :: skin_temp_target_ptr(:,:) - real(esmf_kind_r8), pointer :: snow_depth_target_ptr(:,:) - real(esmf_kind_r8), pointer :: snow_liq_equiv_target_ptr(:,:) - real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:) - real(esmf_kind_r8), pointer :: soil_type_from_input_ptr(:,:) - real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:) - real(esmf_kind_r8), pointer :: soilm_tot_target_ptr(:,:,:) real(esmf_kind_r8), pointer :: srflag_target_ptr(:,:) real(esmf_kind_r8), pointer :: terrain_from_input_ptr(:,:) real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:) - real(esmf_kind_r8), pointer :: z0_target_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:) real(esmf_kind_r8), pointer :: landmask_input_ptr(:,:) real(esmf_kind_r8), pointer :: veg_type_input_ptr(:,:) real(esmf_kind_r8), allocatable :: veg_type_target_one_tile(:,:) - real(esmf_kind_r8), pointer :: veg_greenness_target_ptr(:,:) - real(esmf_kind_r8), pointer :: min_veg_greenness_target_ptr(:,:) - real(esmf_kind_r8), pointer :: max_veg_greenness_target_ptr(:,:) - real(esmf_kind_r8), pointer :: lai_target_ptr(:,:) type(esmf_regridmethod_flag) :: method type(esmf_routehandle) :: regrid_bl_no_mask @@ -437,6 +418,15 @@ subroutine interp(localpet) type(esmf_routehandle) :: regrid_nonland type(esmf_routehandle) :: regrid_seaice type(esmf_routehandle) :: regrid_water + + type(esmf_fieldbundle) :: bundle_all_target, bundle_all_input + type(esmf_fieldbundle) :: bundle_seaice_target, bundle_seaice_input + type(esmf_fieldbundle) :: bundle_water_target, bundle_water_input + type(esmf_fieldbundle) :: bundle_allland_target, bundle_allland_input + type(esmf_fieldbundle) :: bundle_landice_target, bundle_landice_input + type(esmf_fieldbundle) :: bundle_nolandice_target, bundle_nolandice_input + + logical, allocatable :: dozero(:) !----------------------------------------------------------------------- ! Interpolate fieids that do not require 'masked' interpolation. @@ -456,62 +446,41 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid T2M." - call ESMF_FieldRegrid(t2m_input_grid, & - t2m_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid Q2M." - call ESMF_FieldRegrid(q2m_input_grid, & - q2m_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid TPRCP." - call ESMF_FieldRegrid(tprcp_input_grid, & - tprcp_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid F10M." - call ESMF_FieldRegrid(f10m_input_grid, & - f10m_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid FFMM." - call ESMF_FieldRegrid(ffmm_input_grid, & - ffmm_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid USTAR." - call ESMF_FieldRegrid(ustar_input_grid, & - ustar_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + bundle_all_target = ESMF_FieldBundleCreate(name="all points target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_all_input = ESMF_FieldBundleCreate(name="all points input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + call ESMF_FieldBundleAdd(bundle_all_target, (/t2m_target_grid,q2m_target_grid,tprcp_target_grid, & + f10m_target_grid,ffmm_target_grid,ustar_target_grid,srflag_target_grid/), & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_all_input, (/t2m_input_grid,q2m_input_grid,tprcp_input_grid, & + f10m_input_grid,ffmm_input_grid,ustar_input_grid,srflag_input_grid/), & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleGet(bundle_all_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(dozero(num_fields)) + dozero(:) = .True. - print*,"- CALL Field_Regrid SRFLAG." - call ESMF_FieldRegrid(srflag_input_grid, & - srflag_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_all_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + call ESMF_FieldBundleDestroy(bundle_all_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + print*,"- CALL FieldGet FOR SRFLAG." call ESMF_FieldGet(srflag_target_grid, & farrayPtr=srflag_target_ptr, rc=rc) @@ -586,12 +555,10 @@ subroutine interp(localpet) allocate(data_one_tile(i_target,j_target)) allocate(data_one_tile_3d(i_target,j_target,lsoil_target)) allocate(mask_target_one_tile(i_target,j_target)) - allocate(soil_type_target_grid_save(i_target,j_target)) else allocate(data_one_tile(0,0)) allocate(data_one_tile_3d(0,0,0)) allocate(mask_target_one_tile(0,0)) - allocate(soil_type_target_grid_save(0,0)) endif !----------------------------------------------------------------------- @@ -892,175 +859,65 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid for soil temperature over seaice." - call ESMF_FieldRegrid(soil_temp_input_grid, & - soil_temp_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." - call ESMF_FieldGet(soil_temp_target_grid, & - farrayPtr=soil_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for sea ice depth." - call ESMF_FieldRegrid(seaice_depth_input_grid, & - seaice_depth_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid sea ice depth." - call ESMF_FieldGet(seaice_depth_target_grid, & - farrayPtr=seaice_depth_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for snow depth." - call ESMF_FieldRegrid(snow_depth_input_grid, & - snow_depth_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid snow depth." - call ESMF_FieldGet(snow_depth_target_grid, & - farrayPtr=snow_depth_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for snow liq equiv." - call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & - snow_liq_equiv_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid snow liq equiv." - call ESMF_FieldGet(snow_liq_equiv_target_grid, & - farrayPtr=snow_liq_equiv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for sea ice skin temp." - call ESMF_FieldRegrid(seaice_skin_temp_input_grid, & - seaice_skin_temp_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + bundle_seaice_target = ESMF_FieldBundleCreate(name="sea ice target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_seaice_input = ESMF_FieldBundleCreate(name="sea ice input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_seaice_target, (/seaice_depth_target_grid, snow_depth_target_grid, & + snow_liq_equiv_target_grid, seaice_skin_temp_target_grid, & + soil_temp_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_seaice_input, (/seaice_depth_input_grid, snow_depth_input_grid, & + snow_liq_equiv_input_grid, seaice_skin_temp_input_grid, & + soil_temp_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_seaice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + - print*,"- CALL FieldGet FOR TARGET grid sea ice skin temp." - call ESMF_FieldGet(seaice_skin_temp_target_grid, & - farrayPtr=seaice_skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + search_nums = (/92,66,65,21,21/) + dozero(:) = .True. + l = lbound(unmapped_ptr) u = ubound(unmapped_ptr) - - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - seaice_depth_target_ptr(i,j) = -9999.9 - snow_depth_target_ptr(i,j) = -9999.9 - snow_liq_equiv_target_ptr(i,j) = -9999.9 - seaice_skin_temp_target_ptr(i,j) = -9999.9 - soil_temp_target_ptr(i,j,:) = -9999.9 - enddo + + call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, & + unmapped_ptr=unmapped_ptr ) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_seaice_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) do tile = 1, num_tiles_target_grid - print*,"- CALL FieldGather FOR TARGET GRID SEAICE DEPTH TILE: ", tile - call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", rc) - if (localpet == 0) then - ! I don't think is needed anymore with the more recent fixes to fill values in input_data - !if (count(landmask_target_ptr == 2) == 0) data_one_tile(:,:) =0.0_esmf_kind_r8 - + if (localpet == 0) then where(mask_target_one_tile == 1) mask_target_one_tile = 0 where(mask_target_one_tile == 2) mask_target_one_tile = 1 - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 92) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE DEPTH TILE: ", tile - call ESMF_FieldScatter(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 66) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile - call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 65) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile - call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SEAICE SKIN TEMP: ", tile - call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) endif - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE SKIN TEMP: ", tile - call ESMF_FieldScatter(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SEAICE COLUMN TEMP: ", tile - call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - do j = 1, lsoil_target - data_one_tile = data_one_tile_3d(:,:,j) - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) - data_one_tile_3d(:,:,j) = data_one_tile - enddo - endif - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile - call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + call search_many(num_fields,bundle_seaice_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, & + field_data_3d=data_one_tile_3d) enddo + deallocate(search_nums) + call ESMF_FieldBundleDestroy(bundle_seaice_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_seaice, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1093,690 +950,114 @@ subroutine interp(localpet) unmappedDstList=unmapped_ptr, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - - print*,"- CALL Field_Regrid for skin temperature over water." - call ESMF_FieldRegrid(skin_temp_input_grid, & - skin_temp_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET skin temperature." - call ESMF_FieldGet(skin_temp_target_grid, & - farrayPtr=skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for z0 over water." - call ESMF_FieldRegrid(z0_input_grid, & - z0_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET z0." - call ESMF_FieldGet(z0_target_grid, & - farrayPtr=z0_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - skin_temp_target_ptr(i,j) = -9999.9 - z0_target_ptr(i,j) = -9999.9 - enddo + bundle_water_target = ESMF_FieldBundleCreate(name="water target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_water_input = ESMF_FieldBundleCreate(name="water input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_water_target, (/skin_temp_target_grid, z0_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_water_input, (/skin_temp_input_grid, z0_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) if (convert_nst) then - print*,"- CALL Field_Regrid for c_d over water." - call ESMF_FieldRegrid(c_d_input_grid, & - c_d_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call ESMF_FieldBundleAdd(bundle_water_target, (/c_d_target_grid,c_0_target_grid,d_conv_target_grid, & + dt_cool_target_grid,ifd_target_grid,qrain_target_grid,tref_target_grid, & + w_d_target_grid,w_0_target_grid,xs_target_grid,xt_target_grid,xu_target_grid, & + xv_target_grid,xz_target_grid,xtts_target_grid,xzts_target_grid, & + z_c_target_grid,zm_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleAdd(bundle_water_input, (/c_d_input_grid,c_0_input_grid,d_conv_input_grid, & + dt_cool_input_grid,ifd_input_grid,qrain_input_grid,tref_input_grid, & + w_d_input_grid,w_0_input_grid,xs_input_grid,xt_input_grid,xu_input_grid, & + xv_input_grid,xz_input_grid,xtts_input_grid,xzts_input_grid, & + z_c_input_grid,zm_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_water_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + + search_nums(:)=(/11,83,0,0,0,0,1,0,11,0,0,0,0,0,0,30,0,0,0,0/) + dozero(:) = .True. + + else + call ESMF_FieldBundleGet(bundle_water_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + search_nums(:)=(/11,83/) + dozero(:) = .True. + endif - print*,"- CALL Field_Regrid for c_0 over water." - call ESMF_FieldRegrid(c_0_input_grid, & - c_0_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, & + unmapped_ptr=unmapped_ptr, resetifd=.True.) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_water_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call error_handler("IN FieldBundleDestroy", rc) - print*,"- CALL Field_Regrid for d_conv over water." - call ESMF_FieldRegrid(d_conv_input_grid, & - d_conv_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - print*,"- CALL Field_Regrid for dt_cool over water." - call ESMF_FieldRegrid(dt_cool_input_grid, & - dt_cool_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + if (localpet == 0) then + allocate(latitude_one_tile(i_target,j_target)) + else + allocate(latitude_one_tile(0,0)) + endif - print*,"- CALL Field_Regrid for ifd over water." - call ESMF_FieldRegrid(ifd_input_grid, & - ifd_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + do tile = 1, num_tiles_target_grid - print*,"- CALL Field_Regrid for qrain over water." - call ESMF_FieldRegrid(qrain_input_grid, & - qrain_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call error_handler("IN FieldGather", rc) - print*,"- CALL Field_Regrid for tref over water." - call ESMF_FieldRegrid(tref_input_grid, & - tref_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call error_handler("IN FieldGather", rc) - print*,"- CALL Field_Regrid for w_d over water." - call ESMF_FieldRegrid(w_d_input_grid, & - w_d_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + if (localpet == 0) then + allocate(water_target_one_tile(i_target,j_target)) + water_target_one_tile = 0 + where(mask_target_one_tile == 0) water_target_one_tile = 1 + endif - print*,"- CALL Field_Regrid for w_0 over water." - call ESMF_FieldRegrid(w_0_input_grid, & - w_0_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call search_many(num_fields,bundle_water_target,data_one_tile, water_target_one_tile,& + tile,search_nums,localpet,latitude=latitude_one_tile) - print*,"- CALL Field_Regrid for xs over water." - call ESMF_FieldRegrid(xs_input_grid, & - xs_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + if (localpet == 0) deallocate(water_target_one_tile) - print*,"- CALL Field_Regrid for xt over water." - call ESMF_FieldRegrid(xt_input_grid, & - xt_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + enddo - print*,"- CALL Field_Regrid for xu over water." - call ESMF_FieldRegrid(xu_input_grid, & - xu_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + deallocate(latitude_one_tile,search_nums) + + call ESMF_FieldBundleDestroy(bundle_water_target,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call error_handler("IN FieldBundleDestroy", rc) - print*,"- CALL Field_Regrid for xv over water." - call ESMF_FieldRegrid(xv_input_grid, & - xv_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_water, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) - print*,"- CALL Field_Regrid for xz over water." - call ESMF_FieldRegrid(xz_input_grid, & - xz_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) +!--------------------------------------------------------------------------------------------- +! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice. +!--------------------------------------------------------------------------------------------- - print*,"- CALL Field_Regrid for xtts over water." - call ESMF_FieldRegrid(xtts_input_grid, & - xtts_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xzts over water." - call ESMF_FieldRegrid(xzts_input_grid, & - xzts_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for z_c over water." - call ESMF_FieldRegrid(z_c_input_grid, & - z_c_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for zm over water." - call ESMF_FieldRegrid(zm_input_grid, & - zm_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - -! Tag unmapped points - - print*,"- CALL FieldGet FOR TARGET c_d." - call ESMF_FieldGet(c_d_target_grid, & - farrayPtr=c_d_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET c_0." - call ESMF_FieldGet(c_0_target_grid, & - farrayPtr=c_0_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET d_conv." - call ESMF_FieldGet(d_conv_target_grid, & - farrayPtr=d_conv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET dt_cool." - call ESMF_FieldGet(dt_cool_target_grid, & - farrayPtr=dt_cool_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET ifd." - call ESMF_FieldGet(ifd_target_grid, & - farrayPtr=ifd_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - ifd_target_ptr = float(nint(ifd_target_ptr)) - - print*,"- CALL FieldGet FOR TARGET qrain." - call ESMF_FieldGet(qrain_target_grid, & - farrayPtr=qrain_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET tref." - call ESMF_FieldGet(tref_target_grid, & - farrayPtr=tref_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET w_d." - call ESMF_FieldGet(w_d_target_grid, & - farrayPtr=w_d_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET w_0." - call ESMF_FieldGet(w_0_target_grid, & - farrayPtr=w_0_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xs." - call ESMF_FieldGet(xs_target_grid, & - farrayPtr=xs_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xt." - call ESMF_FieldGet(xt_target_grid, & - farrayPtr=xt_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xu." - call ESMF_FieldGet(xu_target_grid, & - farrayPtr=xu_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xv." - call ESMF_FieldGet(xv_target_grid, & - farrayPtr=xv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xz." - call ESMF_FieldGet(xz_target_grid, & - farrayPtr=xz_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xtts." - call ESMF_FieldGet(xtts_target_grid, & - farrayPtr=xtts_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xzts." - call ESMF_FieldGet(xzts_target_grid, & - farrayPtr=xzts_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET z_c." - call ESMF_FieldGet(z_c_target_grid, & - farrayPtr=z_c_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET zm." - call ESMF_FieldGet(zm_target_grid, & - farrayPtr=zm_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - c_d_target_ptr(i,j) = -9999.9 - c_0_target_ptr(i,j) = -9999.9 - d_conv_target_ptr(i,j) = -9999.9 - dt_cool_target_ptr(i,j) = -9999.9 - ifd_target_ptr(i,j) = -9999.9 - qrain_target_ptr(i,j) = -9999.9 - tref_target_ptr(i,j) = -9999.9 - w_d_target_ptr(i,j) = -9999.9 - w_0_target_ptr(i,j) = -9999.9 - xs_target_ptr(i,j) = -9999.9 - xt_target_ptr(i,j) = -9999.9 - xu_target_ptr(i,j) = -9999.9 - xv_target_ptr(i,j) = -9999.9 - xz_target_ptr(i,j) = -9999.9 - xtts_target_ptr(i,j) = -9999.9 - xzts_target_ptr(i,j) = -9999.9 - z_c_target_ptr(i,j) = -9999.9 - zm_target_ptr(i,j) = -9999.9 - enddo - - endif - - if (localpet == 0) then - allocate(latitude_one_tile(i_target,j_target)) - else - allocate(latitude_one_tile(0,0)) - endif - - do tile = 1, num_tiles_target_grid - -! skin temp - - print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE TILE: ", tile - call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile - call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile - call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - allocate(water_target_one_tile(i_target,j_target)) - water_target_one_tile = 0 - where(mask_target_one_tile == 0) water_target_one_tile = 1 - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & - latitude=latitude_one_tile) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP: ", tile - call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! z0 - - print*,"- CALL FieldGather FOR TARGET GRID Z0 TILE: ", tile - call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 83) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID Z0: ", tile - call ESMF_FieldScatter(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - if (convert_nst) then - -! c_d - - print*,"- CALL FieldGather FOR TARGET GRID C_D TILE: ", tile - call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID C_D: ", tile - call ESMF_FieldScatter(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! c_0 - - print*,"- CALL FieldGather FOR TARGET GRID C_0 TILE: ", tile - call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID C_0: ", tile - call ESMF_FieldScatter(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! d_conv - - print*,"- CALL FieldGather FOR TARGET GRID D_CONV TILE: ", tile - call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID D_CONV: ", tile - call ESMF_FieldScatter(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! dt_cool - - print*,"- CALL FieldGather FOR TARGET GRID DT_COOL TILE: ", tile - call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID DT_COOL: ", tile - call ESMF_FieldScatter(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! ifd - - print*,"- CALL FieldGather FOR TARGET GRID IFD TILE: ", tile - call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 1) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID IFD: ", tile - call ESMF_FieldScatter(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! qrain - - print*,"- CALL FieldGather FOR TARGET GRID QRAIN TILE: ", tile - call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID QRAIN: ", tile - call ESMF_FieldScatter(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! tref - - print*,"- CALL FieldGather FOR TARGET GRID TREF TILE: ", tile - call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & - latitude=latitude_one_tile) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID TREF: ", tile - call ESMF_FieldScatter(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! w_d - - print*,"- CALL FieldGather FOR TARGET GRID W_D TILE: ", tile - call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID W_D: ", tile - call ESMF_FieldScatter(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! w_0 - - print*,"- CALL FieldGather FOR TARGET GRID W_0 TILE: ", tile - call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID W_0: ", tile - call ESMF_FieldScatter(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xs - - print*,"- CALL FieldGather FOR TARGET GRID XS TILE: ", tile - call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XS: ", tile - call ESMF_FieldScatter(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xt - - print*,"- CALL FieldGather FOR TARGET GRID XT TILE: ", tile - call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XT: ", tile - call ESMF_FieldScatter(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xu - - print*,"- CALL FieldGather FOR TARGET GRID XU TILE: ", tile - call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XU: ", tile - call ESMF_FieldScatter(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xv - - print*,"- CALL FieldGather FOR TARGET GRID XV TILE: ", tile - call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XV: ", tile - call ESMF_FieldScatter(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xz - - print*,"- CALL FieldGather FOR TARGET GRID XZ TILE: ", tile - call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 30) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XZ: ", tile - call ESMF_FieldScatter(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xtts - - print*,"- CALL FieldGather FOR TARGET GRID XTTS TILE: ", tile - call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XTTS: ", tile - call ESMF_FieldScatter(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xzts - - print*,"- CALL FieldGather FOR TARGET GRID XZTS TILE: ", tile - call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XZTS: ", tile - call ESMF_FieldScatter(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! z_c - - print*,"- CALL FieldGather FOR TARGET GRID Z_C TILE: ", tile - call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID Z_C: ", tile - call ESMF_FieldScatter(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! zm - - print*,"- CALL FieldGather FOR TARGET GRID ZM TILE: ", tile - call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID ZM: ", tile - call ESMF_FieldScatter(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - endif - - if (localpet == 0) deallocate(water_target_one_tile) - - enddo - - deallocate(latitude_one_tile) - - print*,"- CALL FieldRegridRelease." - call ESMF_FieldRegridRelease(routehandle=regrid_water, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegridRelease", rc) - -!--------------------------------------------------------------------------------------------- -! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice. -!--------------------------------------------------------------------------------------------- - - mask_input_ptr = 0 - where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 mask_target_ptr = 0 where (landmask_target_ptr == 1) mask_target_ptr = 1 @@ -1799,69 +1080,40 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid for snow depth over land." - call ESMF_FieldRegrid(snow_depth_input_grid, & - snow_depth_target_grid, & - routehandle=regrid_all_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, & ! flag needed so snow over sea - ! ice is not zeroed out. - rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for snow liq equiv over land." - call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & - snow_liq_equiv_target_grid, & - routehandle=regrid_all_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for canopy mc." - call ESMF_FieldRegrid(canopy_mc_input_grid, & - canopy_mc_target_grid, & - routehandle=regrid_all_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET snow depth." - call ESMF_FieldGet(snow_depth_target_grid, & - farrayPtr=snow_depth_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET snow liq equiv." - call ESMF_FieldGet(snow_liq_equiv_target_grid, & - farrayPtr=snow_liq_equiv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET canopy moisture." - call ESMF_FieldGet(canopy_mc_target_grid, & - farrayPtr=canopy_mc_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) + bundle_allland_target = ESMF_FieldBundleCreate(name="all land target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_allland_input = ESMF_FieldBundleCreate(name="all land input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_allland_target, (/canopy_mc_target_grid, snow_depth_target_grid, & + snow_liq_equiv_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_allland_input, (/canopy_mc_input_grid, snow_depth_input_grid, & + snow_liq_equiv_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_allland_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - snow_depth_target_ptr(i,j) = -9999.9 - snow_liq_equiv_target_ptr(i,j) = -9999.9 - canopy_mc_target_ptr(i,j) = -9999.9 - enddo + search_nums = (/223,66,65/) + dozero=(/.True.,.False.,.False./) + + call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, & + unmapped_ptr=unmapped_ptr) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_allland_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + do tile = 1, num_tiles_target_grid - print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1871,45 +1123,19 @@ subroutine interp(localpet) allocate(land_target_one_tile(i_target,j_target)) land_target_one_tile = 0 where(mask_target_one_tile == 1) land_target_one_tile = 1 - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 66) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH: ", tile - call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQUID EQUIV: ", tile - call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 65) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQUID EQUIV: ", tile - call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID CANOPY MC: ", tile - call ESMF_FieldGather(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 223) - deallocate(land_target_one_tile) endif + + call search_many(num_fields,bundle_allland_target,data_one_tile, land_target_one_tile,& + tile,search_nums,localpet) - print*,"- CALL FieldScatter FOR TARGET GRID CANOPY MC: ", tile - call ESMF_FieldScatter(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - + if (localpet == 0) deallocate(land_target_one_tile) enddo + deallocate(search_nums) + call ESMF_FieldBundleDestroy(bundle_allland_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_all_land, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1957,83 +1183,53 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid for soil temperature over landice." - call ESMF_FieldRegrid(soil_temp_input_grid, & - soil_temp_target_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for skin temperature over landice." - call ESMF_FieldRegrid(skin_temp_input_grid, & - skin_temp_target_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for terrain over landice." - call ESMF_FieldRegrid(terrain_input_grid, & - terrain_from_input_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid column temperature over landice." - call ESMF_FieldGet(soil_temp_target_grid, & - farrayPtr=soil_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET skin temperature." - call ESMF_FieldGet(skin_temp_target_grid, & - farrayPtr=skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR terrain from input grid." - call ESMF_FieldGet(terrain_from_input_grid, & - farrayPtr=terrain_from_input_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - + bundle_landice_target = ESMF_FieldBundleCreate(name="landice target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_landice_input = ESMF_FieldBundleCreate(name="landice input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_landice_target, (/skin_temp_target_grid, terrain_from_input_grid,& + soil_temp_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_landice_input, (/skin_temp_input_grid, terrain_input_grid,& + soil_temp_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + if (.not. sotyp_from_climo) then - print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile - call ESMF_FieldGather(soil_type_target_grid,soil_type_target_grid_save,rootPet=0,tile=1, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - print*,"- CALL Field_Regrid for soil type over landice." - call ESMF_FieldRegrid(soil_type_input_grid, & - soil_type_target_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - rc=rc) + call ESMF_FieldBundleAdd(bundle_landice_input, (/soil_type_input_grid/),rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR SOIL TYPE TARGET GRID." - call ESMF_FieldGet(soil_type_target_grid, & - farrayPtr=soil_type_from_input_ptr, rc=rc) + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_landice_target,(/soil_type_target_grid/),rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGet", rc) - endif + call error_handler("IN FieldBundleAdd", rc) + endif - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_landice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - soil_temp_target_ptr(i,j,:) = -9999.9 - skin_temp_target_ptr(i,j) = -9999.9 - terrain_from_input_ptr(i,j) = -9999.9 - if (.not.sotyp_from_climo) soil_type_from_input_ptr(i,j) = -9999.9 - enddo + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + + if (sotyp_from_climo) then + search_nums = (/21,7,21/) + dozero(:)=.False. + else + search_nums = (/21,7,21,231/) + dozero(:)=(/.False.,.False.,.False.,.True./) + endif + + call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, & + unmapped_ptr=unmapped_ptr ) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_landice_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) if (localpet == 0) then allocate (veg_type_target_one_tile(i_target,j_target)) @@ -2046,12 +1242,6 @@ subroutine interp(localpet) endif do tile = 1, num_tiles_target_grid - - print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMP TILE: ", tile - call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile call ESMF_FieldGather(veg_type_target_grid, veg_type_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -2060,71 +1250,24 @@ subroutine interp(localpet) if (localpet == 0) then land_target_one_tile = 0 where(nint(veg_type_target_one_tile) == veg_type_landice_target) land_target_one_tile = 1 - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) endif - - print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP, TILE: ", tile - call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - + print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID LAND, TILE: ", tile - call ESMF_FieldGather(terrain_from_input_grid_land, data_one_tile2, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 7, terrain_land=data_one_tile2) - endif - - print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID LANDICE COLUMN TEMP: ", tile - call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - do j = 1, lsoil_target - data_one_tile = data_one_tile_3d(:,:,j) - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) - data_one_tile_3d(:,:,j) = data_one_tile - enddo - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile - call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - if (.not. sotyp_from_climo) then - print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID LAND, TILE: ",tile - call ESMF_FieldGather(soil_type_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,231) - endif - - print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(soil_type_target_grid,data_one_tile,rootPet=0,tile=tile,rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - endif + call ESMF_FieldGather(terrain_from_input_grid_land, data_one_tile2, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + call search_many(num_fields,bundle_landice_target,data_one_tile, land_target_one_tile,& + tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d) enddo deallocate (veg_type_target_one_tile) deallocate (land_target_one_tile) + deallocate(search_nums) + + call ESMF_FieldBundleDestroy(bundle_landice_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_landice, rc=rc) @@ -2139,204 +1282,168 @@ subroutine interp(localpet) where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 0 - mask_target_ptr = 0 - where (landmask_target_ptr == 1) mask_target_ptr = 1 - where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0 - - method=ESMF_REGRIDMETHOD_NEAREST_STOD - isrctermprocessing = 1 - - print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields." - call ESMF_FieldRegridStore(soilm_tot_input_grid, & - soilm_tot_target_grid, & - srcmaskvalues=(/0/), & - dstmaskvalues=(/0/), & - polemethod=ESMF_POLEMETHOD_NONE, & - srctermprocessing=isrctermprocessing, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - normtype=ESMF_NORMTYPE_FRACAREA, & - routehandle=regrid_land, & - regridmethod=method, & - unmappedDstList=unmapped_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegridStore", rc) - - print*,"- CALL Field_Regrid for total soil moisture over land." - call ESMF_FieldRegrid(soilm_tot_input_grid, & - soilm_tot_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for soil temperature over land." - call ESMF_FieldRegrid(soil_temp_input_grid, & - soil_temp_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for skin temperature over land." - call ESMF_FieldRegrid(skin_temp_input_grid, & - skin_temp_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for terrain over land." - call ESMF_FieldRegrid(terrain_input_grid, & - terrain_from_input_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - if (.not. sotyp_from_climo) then - print*,"- CALL Field_Regrid for soil type over land." - call ESMF_FieldRegrid(soil_type_input_grid, & - soil_type_target_grid, & - routehandle=regrid_land, & - zeroregion=ESMF_REGION_SELECT, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - endif - - print*,"- CALL Field_Regrid for soil type over land." - call ESMF_FieldRegrid(soil_type_input_grid, & - soil_type_from_input_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - if (.not. vgfrc_from_climo) then - print*,"- CALL Field_Regrid for veg greenness over land." - call ESMF_FieldRegrid(veg_greenness_input_grid, & - veg_greenness_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - endif - - if (.not. minmax_vgfrc_from_climo) then - print*,"- CALL Field_Regrid for max veg greenness over land." - call ESMF_FieldRegrid(max_veg_greenness_input_grid, & - max_veg_greenness_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for min veg greenness over land." - call ESMF_FieldRegrid(min_veg_greenness_input_grid, & - min_veg_greenness_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - endif - - if (.not. lai_from_climo) then - print*,"- CALL Field_Regrid for leaf area index over land." - call ESMF_FieldRegrid(lai_input_grid, & - lai_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - - endif - - print*,"- CALL FieldGet FOR TARGET grid total soil moisture over land." - call ESMF_FieldGet(soilm_tot_target_grid, & - farrayPtr=soilm_tot_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET grid soil temp over ice." - call ESMF_FieldGet(soil_temp_target_grid, & - farrayPtr=soil_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + mask_target_ptr = 0 + where (landmask_target_ptr == 1) mask_target_ptr = 1 + where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0 - print*,"- CALL FieldGet FOR TARGET skin temperature." - call ESMF_FieldGet(skin_temp_target_grid, & - farrayPtr=skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 - print*,"- CALL FieldGet FOR terrain from input grid." - call ESMF_FieldGet(terrain_from_input_grid, & - farrayPtr=terrain_from_input_ptr, rc=rc) + print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields." + call ESMF_FieldRegridStore(soilm_tot_input_grid, & + soilm_tot_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_land, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + call error_handler("IN FieldRegridStore", rc) - if (.not. sotyp_from_climo) then - print*,"- CALL FieldGet FOR soil type target grid." + bundle_nolandice_target = ESMF_FieldBundleCreate(name="land no landice target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + bundle_nolandice_input = ESMF_FieldBundleCreate(name="land no landice input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/skin_temp_target_grid, terrain_from_input_grid,& + soil_type_from_input_grid,soilm_tot_target_grid,soil_temp_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/skin_temp_input_grid, terrain_input_grid,& + soil_type_input_grid,soilm_tot_input_grid,soil_temp_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + + if (.not. sotyp_from_climo) then +! call ESMF_FieldBundleAdd(bundle_nolandice_target, (/soil_type_target_grid/), rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldBundleAdd", rc) +! call ESMF_FieldBundleAdd(bundle_nolandice_input, (/soil_type_input_grid/), rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldBundleAdd", rc) + print*,"- CALL Field_Regrid ." + call ESMF_FieldRegrid(soil_type_input_grid, & + soil_type_target_grid, & + routehandle=regrid_land, & + zeroregion=ESMF_REGION_SELECT, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + call ESMF_FieldGet(soil_type_target_grid, & farrayPtr=soil_type_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGet", rc) - endif + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) - print*,"- CALL FieldGet FOR soil type from input grid." - call ESMF_FieldGet(soil_type_from_input_grid, & - farrayPtr=soil_type_from_input_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + soil_type_target_ptr(i,j) = -9999.9 + enddo + ! call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + ! call error_handler("IN FieldBundleGet", rc) + ! sotyp_ind = 3 + endif + + if (.not. vgfrc_from_climo) then + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/veg_greenness_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/veg_greenness_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + vgfrc_ind = num_fields + endif + + if (.not. lai_from_climo) then + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/lai_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/lai_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + lai_ind = num_fields + endif + + if (.not. minmax_vgfrc_from_climo) then + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/max_veg_greenness_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/max_veg_greenness_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/min_veg_greenness_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/min_veg_greenness_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + mmvg_ind = num_fields-1 + endif + + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + + search_nums(1:5) = (/85,7,224,85,86/) + dozero(1:5) = (/.False.,.False.,.True.,.True.,.False./) + + !if (.not.sotyp_from_climo) then + ! search_nums(sotyp_ind) = 226 + ! dozero(sotyp_ind) = .False. + !endif + if (.not. vgfrc_from_climo) then - print*,"- CALL FieldGet FOR TARGET veg greenness." - call ESMF_FieldGet(veg_greenness_target_grid, & - farrayPtr=veg_greenness_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + search_nums(vgfrc_ind) = 224 + dozero(vgfrc_ind) = .True. + endif + + if (.not. lai_from_climo) then + search_nums(lai_ind) = 229 + dozero(lai_ind) = .True. endif if (.not. minmax_vgfrc_from_climo) then - print*,"- CALL FieldGet FOR TARGET max veg greenness." - call ESMF_FieldGet(max_veg_greenness_target_grid, & - farrayPtr=max_veg_greenness_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET min veg greenness." - call ESMF_FieldGet(min_veg_greenness_target_grid, & - farrayPtr=min_veg_greenness_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGet", rc) - endif - - if (.not. lai_from_climo) then - print*,"- CALL FieldGet FOR TARGET lai." - call ESMF_FieldGet(lai_target_grid, & - farrayPtr=lai_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGet", rc) - endif + search_nums(mmvg_ind) = 227 + dozero(mmvg_ind) = .True. + + search_nums(mmvg_ind+1) = 228 + dozero(mmvg_ind+1) = .True. + endif - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - soilm_tot_target_ptr(i,j,:) = -9999.9 - soil_temp_target_ptr(i,j,:) = -9999.9 - skin_temp_target_ptr(i,j) = -9999.9 - terrain_from_input_ptr(i,j) = -9999.9 - if (.not. sotyp_from_climo) soil_type_target_ptr(i,j) = -9999.9 - soil_type_from_input_ptr(i,j) = -9999.9 - veg_greenness_target_ptr(i,j) = -9999.9 - max_veg_greenness_target_ptr(i,j) = -9999.9 - min_veg_greenness_target_ptr(i,j) = -9999.9 - lai_target_ptr(i,j) = -9999.9 - enddo + call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, & + unmapped_ptr=unmapped_ptr) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_nolandice_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) if (localpet == 0) then allocate (veg_type_target_one_tile(i_target,j_target)) @@ -2356,140 +1463,17 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - if (localpet == 0) then where(nint(veg_type_target_one_tile) == veg_type_landice_target) mask_target_one_tile = 0 - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 7) - endif - - print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile - call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) endif - - print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile - call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile - call ESMF_FieldGather(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - + print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile call ESMF_FieldGather(soil_type_target_grid, data_one_tile2, rootPet=0,tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldGather", rc) - -!--------------------------------------------------------------------------------------- -! Some grib2 data does not have soil type. Set soil type interpolated from input -! grid to the target (model) grid soil type. This turns off the soil moisture -! rescaling. -!--------------------------------------------------------------------------------------- - - if (.not. sotyp_from_climo) then - if (localpet==0) then - call search(data_one_tile2, mask_target_one_tile, i_target, j_target, tile, 224,soilt_climo=soil_type_target_grid_save) - endif - else - if (localpet == 0 .and. maxval(data_one_tile) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then - ! If soil type from the input grid has any non-zero points then soil type must exist for - ! use - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 224) - elseif (localpet == 0) then - data_one_tile = data_one_tile2 - endif - endif - - if (.not. sotyp_from_climo) then - print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(soil_type_target_grid, data_one_tile2, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - endif - - print*,"- CALL FieldScatter FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile - call ESMF_FieldScatter(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - if (.not. vgfrc_from_climo) then - print*,"- CALL FieldGather FOR TARGET GRID VEG GREENNESS, TILE: ", tile - call ESMF_FieldGather(veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 226) - endif - - print*,"- CALL FieldScatter FOR VEG GREENNESS TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - endif - - if (.not. minmax_vgfrc_from_climo) then - print*,"- CALL FieldGather FOR TARGET GRID MAX VEG GREENNESS, TILE: ", tile - call ESMF_FieldGather(max_veg_greenness_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile, 227) - endif - - print*,"- CALL FieldScatter FOR MAX VEG GREENNESS TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(max_veg_greenness_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID MIN VEG GREENNESS, TILE: ", tile - call ESMF_FieldGather(min_veg_greenness_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,228) - endif - - - print*,"- CALL FieldScatter FOR MIN VEG GREENNESS TARGET GRID, TILE: ",tile - call ESMF_FieldScatter(min_veg_greenness_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - - endif - - if (.not. lai_from_climo) then - print*,"- CALL FieldGather FOR TARGET GRID LEAF AREA INDEX, TILE: ", tile - call ESMF_FieldGather(lai_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile, 229) - endif - - print*,"- CALL FieldScatter FOR LEAF AREA INDEX TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(lai_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - endif + call search_many(num_fields,bundle_nolandice_target,data_one_tile, mask_target_one_tile,& + tile,search_nums,localpet,soilt_climo=data_one_tile2, field_data_3d=data_one_tile_3d) print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile call ESMF_FieldGather(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) @@ -2504,28 +1488,10 @@ subroutine interp(localpet) enddo endif - print*,"- CALL FieldScatter FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile - call ESMF_FieldScatter(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - do j = 1, lsoil_target - data_one_tile = data_one_tile_3d(:,:,j) - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) - data_one_tile_3d(:,:,j) = data_one_tile - enddo - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile - call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) if (tg3_from_soil) then print*,"- CALL FieldScatter FOR TARGET GRID SUBSTRATE TEMPERATURE, TILE: ", tile @@ -2533,9 +1499,30 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldScatter", rc) endif + + if (.not. sotyp_from_climo) then + print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID LAND, TILE: ",tile + call ESMF_FieldGather(soil_type_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,226) + endif + + print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile + call ESMF_FieldScatter(soil_type_target_grid,data_one_tile,rootPet=0,tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + endif enddo + deallocate(search_nums) + call ESMF_FieldBundleDestroy(bundle_nolandice_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_land, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3682,6 +2669,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID T2M." t2m_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="t2m_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3697,6 +2685,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID Q2M." q2m_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="q2m_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3712,6 +2701,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID TPRCP." tprcp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="tprcp_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3727,6 +2717,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID F10M." f10m_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="f10m_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3742,6 +2733,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID FFMM." ffmm_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="ffmm_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3757,6 +2749,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID USTAR." ustar_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="ustar_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3772,6 +2765,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SNOW LIQ EQUIV." snow_liq_equiv_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="snow_liq_equiv_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3787,6 +2781,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SNOW DEPTH." snow_depth_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="snow_depth_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3802,6 +2797,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE FRACTION." seaice_fract_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="seaice_fract_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3817,6 +2813,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE DEPTH." seaice_depth_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="seaice_depth_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3832,6 +2829,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE SKIN TEMP." seaice_skin_temp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="seaice_skin_temp_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3847,6 +2845,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SRFLAG." srflag_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="srflag_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3862,6 +2861,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SKIN TEMPERATURE." skin_temp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="skin_temp_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3877,6 +2877,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID CANOPY MOISTURE CONTENT." canopy_mc_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="canopy_mc_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3892,6 +2893,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID LEAF AREA INDEX." lai_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="lai_target_grid",& staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3907,6 +2909,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID Z0." z0_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="z0_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3922,6 +2925,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID TERRAIN." terrain_from_input_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="terrain_from_input_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3937,7 +2941,8 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID SOIL TYPE." soil_type_from_input_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & - staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soil_type_from_input_grid", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3953,6 +2958,7 @@ subroutine create_surface_esmf_fields soil_temp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soil_temp_target_grid", & ungriddedLBound=(/1/), & ungriddedUBound=(/lsoil_target/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3970,6 +2976,7 @@ subroutine create_surface_esmf_fields soilm_tot_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soilm_tot_target_grid", & ungriddedLBound=(/1/), & ungriddedUBound=(/lsoil_target/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3987,6 +2994,7 @@ subroutine create_surface_esmf_fields soilm_liq_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soilm_liq_target_grid", & ungriddedLBound=(/1/), & ungriddedUBound=(/lsoil_target/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -4192,6 +3200,266 @@ subroutine ij_to_i_j(ij, itile, jtile, i, j) end subroutine ij_to_i_j +!> Regrid multiple ESMF fields from input to target grid +!! +!! @param[in] bundle_pre ESMF fieldBundle on input grid +!! @param[in] bundle_post ESMF fieldBundle on target grid +!! @param[in] num_field Number of fields in target field pointer +!! @param[inout] route Route handle to saved ESMF regridding instructions +!! @param[in] dozero Logical length num_field for whether field should be zeroed out before regridding +!! @param[inout] unmapped_ptr (optional) Pointer to unmapped points from FieldRegrid +!! @param[in] resetifd (optional) Logical for whether to reset ifd (only for water where nst data is used) +!! @author Larissa Reames, OU CIMMS/NOAA/NSSL + subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero, & + unmapped_ptr,resetifd) + + use esmf + use program_setup, only : convert_nst + use model_grid, only : i_target, j_target + + implicit none + + integer, intent(in) :: num_field + type(esmf_routehandle), intent(inout) :: route + type(esmf_fieldbundle), intent(in) :: bundle_pre, bundle_post + logical, intent(in) :: dozero(num_field) + logical, intent(in), optional :: resetifd + integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(:) + + type(esmf_field) :: field_pre,field_post + real(esmf_kind_r8), pointer :: tmp_ptr(:,:) + type(realptr_2d),allocatable :: ptr_2d(:) + type(realptr_3d),allocatable :: ptr_3d(:) + logical :: is2d(num_field) + character(len=50) :: fname + integer :: i, j, k, ij, ind_2d, ind_3d, rc, ndims,n2d, n3d,localpet, l(1), u(1) + type(esmf_vm) :: vm + + ind_2d = 0 + ind_3d = 0 + + if(present(unmapped_ptr)) then + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + endif + + do i = 1, num_field + call ESMF_FieldBundleGet(bundle_pre,i,field_pre,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + call ESMF_FieldBundleGet(bundle_post,i,field_post,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + call ESMF_FieldGet(field_post,dimCount=ndims,name=fname,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + + call ESMF_VMGetGlobal(vm, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN VMGetGlobal", rc) + call ESMF_VMGet(vm, localPet=localpet, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN VMGet", rc) + if(localpet==0) print*, "in regrid_many fname = ", fname, ndims + if (ndims == 2) is2d(i) = .True. + if (ndims == 3) is2d(i) = .False. + + if (dozero(i)) then + call ESMF_FieldRegrid(field_pre, & + field_post, & + routehandle=route, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + else + call ESMF_FieldRegrid(field_pre, & + field_post, & + routehandle=route, & + zeroregion=ESMF_REGION_SELECT, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + endif + enddo + + if (present(resetifd)) then + if( resetifd .and. convert_nst) then + call ESMF_FieldGet(ifd_target_grid,farrayPtr=tmp_ptr,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + tmp_ptr = float(nint(tmp_ptr)) + endif + endif + + n2d = count(is2d(:)) + n3d = count(.not.is2d(:)) + if(localpet==0) print*, is2d(:) + if (present(unmapped_ptr)) then + allocate(ptr_2d(n2d)) + if (n3d .ne. 0) allocate(ptr_3d(n3d)) + do i=1, num_field + if (is2d(i)) then + ind_2d = ind_2d + 1 + call ESMF_FieldBundleGet(bundle_post,i,field_post,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + call ESMF_FieldGet(field_post, farrayPtr=ptr_2d(ind_2d)%p, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + call ESMF_FieldGet(field_post,name=fname,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + if (localpet==0) print*, "in doreplace loop, 2d field = ", trim(fname) + else + ind_3d = ind_3d + 1 + call ESMF_FieldBundleGet(bundle_post,i,field_post,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + call ESMF_FieldGet(field_post,name=fname,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + if (localpet==0) print*, "in doreplace loop, 3d field = ", trim(fname) + call ESMF_FieldGet(field_post, farrayPtr=ptr_3d(ind_3d)%p, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + endif + end do + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + do k = 1,n2d + ptr_2d(k)%p(i,j) = -9999.9 + enddo + do k = 1,n3d + ptr_3d(k)%p(i,j,:) = -9999.9 + enddo + enddo + deallocate(ptr_2d) + if(n3d .ne. 0) deallocate(ptr_3d) + endif + end subroutine regrid_many + +!> Execute the search function for multple fields +!! +!! @param[in] num_field Number of fields to process. +!! @param[inout] bundle_target ESMF FieldBundle holding target fields to search +!! @param[inout] field_data_2d A real array of size i_target,j_target to temporarily hold data for searching +!! @param[inout] mask An integer array of size i_target,j_target that holds masked (0) and unmasked (1) +!! values indicating where to execute search (only at unmasked points). +!! @param[in] tile Current cubed sphere tile. +!! @param[inout] search_nums Array length num_field holding search field numbers corresponding to each field provided for searching. +!! @param[in] localpet ESMF local persistent execution thread. +!! @param[in] latitude (optional) A real array size i_target,j_target of latitude on the target grid +!! @param[in] terrain_land (optional) A real array size i_target,j_target of terrain height (m) on the target grid +!! @param[in] soilt_climo (optional) A real array size i_target,j_target of climatological soil type on the target grid +!! @param[in] field_data_3d (optional) An empty real array of size i_target,j_target,lsoil_target to temporarily hold soil data for searching +!! @author Larissa Reames, OU CIMMS/NOAA/NSSL + subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & + search_nums,localpet,latitude,terrain_land,soilt_climo,& + field_data_3d) + + use model_grid, only : i_target,j_target, lsoil_target + use program_setup, only : external_model, input_type + use search_util + + implicit none + + integer, intent(in) :: num_field + type(esmf_fieldbundle), intent(inout) :: bundle_target + real(esmf_kind_r8), intent(inout) :: field_data_2d(i_target,j_target) + real(esmf_kind_r8), intent(inout), optional :: field_data_3d(i_target,j_target,lsoil_target) + real(esmf_kind_r8), intent(inout), optional :: latitude(i_target,j_target) + real(esmf_kind_r8), intent(inout), optional :: terrain_land(i_target,j_target) + real(esmf_kind_r8), intent(inout), optional :: soilt_climo(i_target,j_target) + integer(esmf_kind_i8), intent(inout) :: mask(i_target,j_target) + + + integer, intent(in) :: tile,localpet + integer, intent(inout) :: search_nums(num_field) + + type(esmf_field) :: temp_field + character(len=50) :: fname + integer, parameter :: SOTYP_LAND_FIELD_NUM = 224 + integer, parameter :: SST_FIELD_NUM = 11 + integer, parameter :: TERRAIN_FIELD_NUM= 7 + integer :: j,k, rc, ndims + + do k = 1,num_field + call ESMF_FieldBundleGet(bundle_target,k,temp_field, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + call ESMF_FieldGet(temp_field, name=fname, dimcount=ndims,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + if (ndims .eq. 2) then + print*, "processing 2d field ", trim(fname) + print*, "FieldGather" + call ESMF_FieldGather(temp_field,field_data_2d,rootPet=0,tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + if (localpet == 0) then + if (present(latitude) .and. search_nums(k).eq.SST_FIELD_NUM) then + ! Sea surface temperatures; pass latitude field to search + print*, "search1" + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),latitude=latitude) + elseif (present(terrain_land) .and. search_nums(k) .eq. TERRAIN_FIELD_NUM) then + ! Terrain height; pass optional climo terrain array to search + print*, "search2" + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land) + elseif (search_nums(k) .eq. SOTYP_LAND_FIELD_NUM) then + ! Soil type over land + if (fname .eq. "soil_type_target_grid") then + ! Soil type over land when interpolating input data to target grid + ! *with* the intention of retaining interpolated data in output + print*, "search3" + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),soilt_climo=soilt_climo) + elseif (present(soilt_climo)) then + if (maxval(field_data_2d) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then + ! Soil type over land when interpolating input data to target grid + ! *without* the intention of retaining data in output file + print*, "search4" + call search(field_data_2d, mask, i_target, j_target, tile, search_nums(k)) + else + ! If no soil type field exists in input data (e.g., GFS grib2) then don't search + ! but simply set data to the climo field. This may result in + ! somewhat inaccurate soil moistures as no scaling will occur + print*, "search5" + field_data_2d = soilt_climo + endif !check field value + endif !sotype from target grid + else + ! Any field that doesn't require any of the special treatments or + ! passing of additional variables as in those above + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k)) + endif !if present + endif !localpet + call ESMF_FieldScatter(temp_field, field_data_2d, rootPet=0, tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + else + ! Process 3d fields soil temperature, moisture, and liquid + print*, "FieldGather" + call ESMF_FieldGather(temp_field,field_data_3d,rootPet=0,tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + print*, "processing 3d field ", trim(fname) + if (localpet==0) then + do j = 1, lsoil_target + field_data_2d = field_data_3d(:,:,j) + call search(field_data_2d, mask, i_target, j_target, tile, 21) + field_data_3d(:,:,j) = field_data_2d + enddo + endif + call ESMF_FieldScatter(temp_field, field_data_3d, rootPet=0, tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + endif !ndims + end do !fields + + end subroutine search_many + !> Free up memory once the target grid surface fields are !! no longer needed. !! diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index f4abbc058..0181ceb64 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -114,15 +114,15 @@ add_mpi_test(chgres_cube-ftst_read_sfc_gfs_nemsio NUMPROCS 1 TIMEOUT 60) -# Comment out this unit test until ESMF memory leaks are solved -# add_executable(ftst_surface_interp ftst_surface_interp.F90) -# target_link_libraries(ftst_surface_interp chgres_cube_lib) - -# Cause test to be run with MPI. -# add_mpi_test(chgres_cube-ftst_surface_interp -# EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp -# NUMPROCS 1 -# TIMEOUT 60) +## Comment out this unit test until ESMF memory leaks are solved +## add_executable(ftst_surface_interp ftst_surface_interp.F90) +## target_link_libraries(ftst_surface_interp chgres_cube_lib) +## +## Cause test to be run with MPI. +## add_mpi_test(chgres_cube-ftst_surface_interp +## EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp +## NUMPROCS 1 +## TIMEOUT 60) add_executable(ftst_read_sfc_nemsio ftst_read_sfc_nemsio.F90) target_link_libraries(ftst_read_sfc_nemsio chgres_cube_lib) @@ -178,6 +178,24 @@ add_mpi_test(chgres_cube-ftst_surface_nst_landfill NUMPROCS 1 TIMEOUT 60) +add_executable(ftst_surface_regrid_many ftst_surface_regrid_many.F90) +target_link_libraries(ftst_surface_regrid_many chgres_cube_lib) + +# Cause test to be run with MPI. +add_mpi_test(chgres_cube-ftst_surface_regrid_many + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_regrid_many + NUMPROCS 1 + TIMEOUT 60) + +add_executable(ftst_surface_search_many ftst_surface_search_many.F90) +target_link_libraries(ftst_surface_search_many chgres_cube_lib) + +# Cause test to be run with MPI. +add_mpi_test(chgres_cube-ftst_surface_search_many + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_search_many + NUMPROCS 1 + TIMEOUT 60) + add_executable(ftst_read_vcoord ftst_read_vcoord.F90) target_link_libraries(ftst_read_vcoord chgres_cube_lib) add_test(NAME chgres_cube-ftst_read_vcoord COMMAND ftst_read_vcoord) diff --git a/tests/chgres_cube/ftst_surface_regrid_many.F90 b/tests/chgres_cube/ftst_surface_regrid_many.F90 new file mode 100644 index 000000000..9fac01bef --- /dev/null +++ b/tests/chgres_cube/ftst_surface_regrid_many.F90 @@ -0,0 +1,395 @@ + program surface_interp + +! Unit test for surface routine interp that regrids surface +! variables from input to target grid. +! +! Author: Larissa Reames, OU CIMMS/NOAA NSSL + + use esmf + + + use model_grid, only : i_input, j_input, & + input_grid, & + latitude_input_grid, & + longitude_input_grid, & + i_target, j_target, & + target_grid, num_tiles_target_grid, & + latitude_target_grid, & + longitude_target_grid + + use input_data, only: t2m_input_grid, & + q2m_input_grid + + use surface, only : regrid_many, & + t2m_target_grid, & + q2m_target_grid + + + implicit none + + integer, parameter :: IPTS_INPUT=4 + integer, parameter :: JPTS_INPUT=3 + integer, parameter :: IPTS_TARGET=8 + integer, parameter :: JPTS_TARGET=5 + + real, parameter :: EPSILON=0.0001 + real(esmf_kind_r8) :: deltalon + + integer :: clb(4), cub(4) + integer :: ierr, localpet, npets, rc + integer :: i, j, k, num_fields + integer :: isrctermprocessing + + real(esmf_kind_r8), allocatable :: latitude(:,:), longitude(:,:) + real(esmf_kind_r8), allocatable :: q2m_input(:,:), & + t2m_input(:,:) + real(esmf_kind_r8), allocatable :: q2m_correct(:,:), & + q2m_target(:,:), & + t2m_target(:,:), & + t2m_correct(:,:) + real(esmf_kind_r8), pointer :: lon_ptr(:,:), & + lat_ptr(:,:) + type(esmf_vm) :: vm + type(esmf_polekind_flag) :: polekindflag(2) + type(esmf_fieldbundle) :: bundle_all_target, bundle_all_input + type(esmf_regridmethod_flag) :: method + type(esmf_routehandle) :: regrid_bl_no_mask + logical, allocatable :: dozero(:) + + print*,"Starting test of surface regrid_many." + + call mpi_init(ierr) + + call ESMF_Initialize(rc=ierr) + + call ESMF_VMGetGlobal(vm, rc=ierr) + + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) + + !--------------------------------------------------------------------! + !----------------- Setup Input Grid & Coordinates -------------------! + !--------------------------------------------------------------------! + + i_input = IPTS_INPUT + j_input = JPTS_INPUT + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + + input_grid = ESMF_GridCreateNoPeriDim(maxIndex=(/i_input,j_input/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + allocate(latitude(i_input,j_input)) + allocate(longitude(i_input,j_input)) + + ! This is a random regional grid. I tried a global grid here but it had an unstable + ! solution. + + deltalon = 2.0_esmf_kind_r8 + do i = 1, i_input + longitude(i,:) = 90+real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + do j = 1, j_input + latitude(:,j) = 35.0-real((j-1),kind=esmf_kind_r8) * deltalon + end do + + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridAddCoord", rc) + + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_ptr(i,j) = longitude(i,j) + if (lon_ptr(i,j) > 360.0_esmf_kind_r8) lon_ptr(i,j) = lon_ptr(i,j) - 360.0_esmf_kind_r8 + lat_ptr(i,j) = latitude(i,j) + enddo + enddo + nullify(lat_ptr,lon_ptr) + + + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) + deallocate(latitude, longitude) + + !Initializes input ESMF fields + t2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + q2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + !Allocate and fill in the fields on the input grid that we need to create soil type + allocate(t2m_input(i_input,j_input)) + allocate(q2m_input(i_input,j_input)) + + t2m_input = reshape((/290.,292.,294.,296., 291.,293.,295.,297., 292.,294.,296.,298./),(/i_input,j_input/)) + q2m_input = reshape((/6.E-4,7.E-4,8.E-4,9.E-4, 7.E-4,8.E-4,9.E-4,10.E-4, 8.E-4,9.E-4,10.E-4,11.E-4/),(/i_input,j_input/)) + + call ESMF_FieldScatter(t2m_input_grid,t2m_input,rootpet=0,rc=rc) + call ESMF_FieldScatter(q2m_input_grid,q2m_input,rootpet=0,rc=rc) + + deallocate(t2m_input,q2m_input) + + !--------------------------------------------------------------------! + !---------------- Setup Target Grid & Coordinates -------------------! + !--------------------------------------------------------------------! + + i_target = IPTS_TARGET + j_target = JPTS_TARGET + + num_tiles_target_grid = 1 + target_grid = ESMF_GridCreate1PeriDim(maxIndex=(/i_target,j_target/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + allocate(latitude(i_target,j_target)) + allocate(longitude(i_target,j_target)) + + ! Regional grid that fits within the input regional grid but with smaller grid cells + deltalon = 0.5 + do i = 1, i_target + longitude(i,:) = 91.1_esmf_kind_r8 + real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + do i = 1, j_target + latitude(:,i) = 34.1_esmf_kind_r8 - real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + call ESMF_GridAddCoord(target_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridAddCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_ptr(i,j) = longitude(i,j) + if (lon_ptr(i,j) > 360.0_esmf_kind_r8) lon_ptr(i,j) = lon_ptr(i,j) -360.0_esmf_kind_r8 + lat_ptr(i,j) = latitude(i,j) + enddo + enddo + nullify(lat_ptr,lon_ptr) + + + latitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_latitude", & + rc=rc) + + longitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + + call ESMF_FieldScatter(longitude_target_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_target_grid, latitude, rootpet=0, rc=rc) + deallocate(latitude, longitude) + + ! Create target t2m and q2m fields + t2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="t2m_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + q2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="q2m_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + ! Create masks on the target grid and the correct (expected) soil type on the target grid + ! to check against what returns from interp + + allocate(t2m_correct(i_target,j_target)) + allocate(q2m_correct(i_target,j_target)) + allocate(t2m_target(i_target,j_target)) + allocate(q2m_target(i_target,j_target)) + + + !t2m_correct = reshape((/0., 0., 15.,15.,5., 5., 5., 5., & + ! 0., 0., 5., 5., 6., 6., 6., 6., & + ! 0., 0., 5., 5., 6., 6., 6., 6., & + ! 0., 0., 5., 5., 6., 6., 0., 0., & + ! 0., 0., 5., 5., 6., 6., 0., 0. /),(/i_target,j_target/)) + t2m_correct = reshape((/ 292.000000000000, 292.000000000000,& + 292.000000000000, 292.000000000000, 294.000000000000,& + 294.000000000000, 294.000000000000, 294.000000000000,& + 293.000000000000, 293.000000000000, 293.000000000000,& + 293.000000000000, 295.000000000000, 295.000000000000,& + 295.000000000000, 295.000000000000, 293.000000000000,& + 293.000000000000, 293.000000000000, 293.000000000000,& + 295.000000000000, 295.000000000000, 295.000000000000,& + 295.000000000000, 293.000000000000, 293.000000000000,& + 293.000000000000, 293.000000000000, 295.000000000000,& + 295.000000000000, 295.000000000000, 295.000000000000,& + 293.000000000000, 293.000000000000, 293.000000000000,& + 293.000000000000, 295.000000000000, 295.000000000000,& + 295.000000000000, 295.000000000000/),(/i_target,j_target/)) + !q2m_correct = reshape((/0., 0.,16.,16., 4., 4., 4., 4., & + ! 0., 0., 3., 3., 5., 5., 5., 5., & + ! 0., 0., 3., 3., 5., 5., 5., 5., & + ! 0., 0., 3., 3., 5., 5., 0., 0., & + ! 0., 0., 3., 3., 5., 5., 0., 0. /),(/i_target,j_target/)) + q2m_correct = reshape((/ 7.000000000000000E-004, 7.000000000000000E-004,& + 7.000000000000000E-004, 7.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004/),(/i_target,j_target/)) + + + method=ESMF_REGRIDMETHOD_NEAREST_STOD + + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore FOR NON-MASKED BILINEAR INTERPOLATION." + call ESMF_FieldRegridStore(t2m_input_grid, & + t2m_target_grid, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + srctermprocessing=isrctermprocessing, & + routehandle=regrid_bl_no_mask, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + bundle_all_target = ESMF_FieldBundleCreate(name="all points target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_all_input = ESMF_FieldBundleCreate(name="all points input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + call ESMF_FieldBundleAdd(bundle_all_target, (/t2m_target_grid,q2m_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_all_input, (/t2m_input_grid,q2m_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleGet(bundle_all_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(dozero(num_fields)) + dozero(:) = .True. + + !Call the routine to unit test. + call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero) + deallocate(dozero) + + call ESMF_FieldBundleDestroy(bundle_all_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + call ESMF_FieldBundleDestroy(bundle_all_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + + call ESMF_FieldGather(t2m_target_grid, t2m_target, rootPet=0, rc=rc) + call ESMF_FieldGather(q2m_target_grid, q2m_target, rootPet=0, rc=rc) + + print*,"Check results." + + if (any((abs(t2m_target - t2m_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'T2M SHOULD BE:', t2m_correct + print*,'T2M FROM TEST:', t2m_target + stop 2 + endif + + if (any((abs(q2m_target - q2m_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'Q2M SHOULD BE:', q2m_correct + print*,'Q2M FROM TEST:', q2m_target + stop 2 + endif + + + print*,"OK" + +! Deallocate and destroy + deallocate(t2m_target,t2m_correct,q2m_target,q2m_correct) + call ESMF_FieldDestroy(latitude_input_grid,rc=rc) + call ESMF_FieldDestroy(longitude_input_grid,rc=rc) + call ESMF_FieldDestroy(latitude_target_grid,rc=rc) + call ESMF_FieldDestroy(longitude_target_grid,rc=rc) + call ESMF_FieldDestroy(t2m_input_grid,rc=rc) + call ESMF_FieldDestroy(t2m_input_grid,rc=rc) + call ESMF_FieldDestroy(q2m_input_grid,rc=rc) + call ESMF_FieldDestroy(q2m_input_grid,rc=rc) +call ESMF_GridDestroy(input_grid, rc=rc) + call ESMF_GridDestroy(target_grid, rc=rc) + + + call ESMF_finalize(endflag=ESMF_END_KEEPMPI) + call mpi_finalize(rc) + + print*,"SUCCESS!" + + end program surface_interp diff --git a/tests/chgres_cube/ftst_surface_search_many.F90 b/tests/chgres_cube/ftst_surface_search_many.F90 new file mode 100644 index 000000000..ec627d6e8 --- /dev/null +++ b/tests/chgres_cube/ftst_surface_search_many.F90 @@ -0,0 +1,523 @@ + program surface_interp + +! Unit test for surface routine interp that regrids surface +! variables from input to target grid. +! +! Author: Larissa Reames, OU CIMMS/NOAA NSSL + + use esmf + + use model_grid, only : i_target, j_target, & + target_grid, num_tiles_target_grid, & + latitude_target_grid, & + longitude_target_grid, & + lsoil_target + + use program_setup, only : external_model, input_type + + use surface, only : search_many + + implicit none + + integer, parameter :: IPTS_TARGET=3 + integer, parameter :: JPTS_TARGET=3 + + real, parameter :: EPSILON=0.0001 + real(esmf_kind_r8) :: deltalon + + integer :: clb(4), cub(4) + integer :: ierr, localpet, npets, rc + integer :: i, j, k, num_fields + integer :: isrctermprocessing + + integer(esmf_kind_i8),allocatable :: mask_target_search(:,:), & + mask_default(:,:) + integer, allocatable :: field_nums(:) + real(esmf_kind_r8), allocatable :: latitude(:,:), longitude(:,:) + real(esmf_kind_r8), allocatable :: field1_search(:,:), & + field2_search(:,:), & + field1_default(:,:), & + latitude_default(:,:), & + terrain_land(:,:), & + soilt_climo(:,:), & + soil_temp_search(:,:,:) + real(esmf_kind_r8), allocatable :: field1_search_correct(:,:), & + field2_search_correct(:,:), & + field_default_correct(:,:), & + soil_temp_correct(:,:) + real(esmf_kind_r8), allocatable :: dummy_2d(:,:), & + dummy_3d(:,:,:) + real(esmf_kind_r8), pointer :: lon_ptr(:,:), & + lat_ptr(:,:) + + character(len=50) :: fname + + type(esmf_vm) :: vm + type(esmf_field) :: field1_target_grid, & + field2_target_grid, & + field3_target_grid, & + field4_target_grid, & + field_3d_target_grid, & + temp_field + type(esmf_fieldbundle) :: bundle_search1, & + bundle_search2, & + bundle_default1, & + bundle_default2, & + bundle_3d_search + + print*,"Starting test of surface regrid_many." + + call mpi_init(ierr) + + call ESMF_Initialize(rc=ierr) + + call ESMF_VMGetGlobal(vm, rc=ierr) + + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) + + !--------------------------------------------------------------------! + !---------------- Setup Target Grid & Coordinates -------------------! + !--------------------------------------------------------------------! + + i_target = IPTS_TARGET + j_target = JPTS_TARGET + lsoil_target = 2 + + num_tiles_target_grid = 1 + target_grid = ESMF_GridCreate1PeriDim(maxIndex=(/i_target,j_target/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + allocate(latitude(i_target,j_target)) + allocate(longitude(i_target,j_target)) + + ! Regional grid + deltalon = 0.5 + do i = 1, i_target + longitude(i,:) = 91.1_esmf_kind_r8 + real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + do i = 1, j_target + latitude(:,i) = 34.1_esmf_kind_r8 - real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + call ESMF_GridAddCoord(target_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridAddCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_ptr(i,j) = longitude(i,j) + if (lon_ptr(i,j) > 360.0_esmf_kind_r8) lon_ptr(i,j) = lon_ptr(i,j) -360.0_esmf_kind_r8 + lat_ptr(i,j) = latitude(i,j) + enddo + enddo + nullify(lat_ptr,lon_ptr) + + + latitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_latitude", & + rc=rc) + + longitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + + call ESMF_FieldScatter(longitude_target_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_target_grid, latitude, rootpet=0, rc=rc) + deallocate(latitude, longitude) + + ! Create target fields + field1_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="field1_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field2_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="field2_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field3_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="soil_type_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field4_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="field4_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field_3d_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="field_3d_target_grid", & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + + ! Allocate space for arrays + allocate(field1_search_correct(i_target,j_target)) + allocate(field2_search_correct(i_target,j_target)) + allocate(field1_search(i_target,j_target)) + allocate(field2_search(i_target,j_target)) + allocate(mask_target_search(i_target,j_target)) + + allocate(field1_default(i_target,j_target)) + allocate(field_default_correct(i_target,j_target)) + allocate(mask_default(i_target,j_target)) + allocate(latitude_default(i_target,j_target)) + allocate(dummy_2d(i_target,j_target)) + + allocate(terrain_land(i_target,j_target)) + allocate(soilt_climo(i_target,j_target)) + + allocate(soil_temp_search(i_target,j_target,lsoil_target)) + allocate(soil_temp_correct(i_target,j_target)) + allocate(dummy_3d(i_target,j_target,lsoil_target)) + + ! Field values for default replacement tests + field1_default = reshape((/0., 0., 0., 0., -9999.9, 0., 0., 0.,0./),(/i_target,j_target/)) + mask_default = reshape((/0, 0, 0, 0, 1, 0, 0, 0, 0/),(/i_target,j_target/)) + latitude_default = reshape((/-30.0, -30.0, -30.0, 0., 75., 0., 25.0, 25.0,25.0/),(/i_target,j_target/)) + + + ! Field values to check basic search option tests + field1_search=reshape((/-9999.9, 0., 0., 0., .88, 0., 0., 0.,.1/),(/i_target,j_target/)) + field1_search_correct=reshape((/.88, 0., 0., 0., .88, 0., 0.,0.,.1/),(/i_target,j_target/)) + field2_search=reshape((/3., 0., 0., 0., 2., 0., 0., 0., -9999.9/),(/i_target,j_target/)) + field2_search_correct=reshape((/3., 0., 0., 0., 2., 0., 0., 0.,2./),(/i_target,j_target/)) + mask_target_search=reshape((/1, 0, 0, 0, 1, 0, 0, 0, 1/),(/i_target,j_target/)) + soil_temp_search(:,:,1) = reshape((/-9999.9, 0., 0., 0., 280., 0., 0.,0.,290./),(/i_target,j_target/)) + soil_temp_search(:,:,2) = reshape((/-9999.9, 0., 0., 0., 280., 0.,0.,0.,290./),(/i_target,j_target/)) + soil_temp_correct(:,:) = reshape((/280., 0., 0., 0., 280.,0.,0.,0.,290./),(/i_target,j_target/)) + ! Default terrain values to check default terrain replacement + terrain_land = reshape((/0., 0., 0., 0., 75.0, 0., 0., 0.,0./),(/i_target,j_target/)) + + ! Climatology soil type values to check soil type replacement + soilt_climo = reshape((/0., 0., 0., 0., 2., 0., 0., 0.,0./),(/i_target,j_target/)) + + ! Create field bundles and assign fields to them + bundle_default1 = ESMF_FieldBundleCreate(name="fields_default1", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + ! will search sst, terrain height, soil_type_target_grid + call ESMF_FieldBundleAdd(bundle_default1, (/field1_target_grid,field2_target_grid, & + field3_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + bundle_default2 = ESMF_FieldBundleCreate(name="fields_default2", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search GFS grib2 soil type + call ESMF_FieldBundleAdd(bundle_default2,(/field1_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + + bundle_3d_search = ESMF_FieldBundleCreate(name="fields_search_3d", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search soil temperature + call ESMF_FieldBundleAdd(bundle_3d_search,(/field_3d_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + + bundle_search1 = ESMF_FieldBundleCreate(name="fields_search1", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search veg greeness and restart soil type + call ESMF_FieldBundleAdd(bundle_search1,(/field1_target_grid,field2_target_grid/),rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + + bundle_search2 = ESMF_FieldBundleCreate(name="fields_search2", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search hrrr grib2 non-target-grid soil type + call ESMF_FieldBundleAdd(bundle_search2,(/field1_target_grid/),rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + +!------------------------------------------------------------------------------------- +! SEARCH TEST CHECKS REPLACEMENT OF VEG FRACTION AND RESTART FILE SOIL TYPE +!------------------------------------------------------------------------------------- + + ! Fill esmf fields for search test + call ESMF_FieldScatter(field1_target_grid, field1_search, rootPet=0,tile=1, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldScatter(field2_target_grid, field2_search, rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_search1,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums = (/226,224/) + input_type="restart" + + !Call the search many routine to test search and replace + call search_many(num_fields,bundle_search1,dummy_2d,mask_target_search,1,field_nums,localpet, & + soilt_climo=soilt_climo) + + call ESMF_FieldBundleDestroy(bundle_search1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + call ESMF_FieldGather(field1_target_grid, dummy_2d, rootPet=0, rc=rc) + + print*,"Check results for field1_search." + + if (any((abs(dummy_2d - field1_search_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field1_search SHOULD BE:', field1_search_correct + print*,'field1_search FROM TEST:', dummy_2d + stop 2 + endif + call ESMF_FieldGather(field2_target_grid, dummy_2d, rootPet=0, rc=rc) + + print*,"Check results for field2_search." + if (any((abs(dummy_2d - field2_search_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field2_search SHOULD BE:', field2_search_correct + print*,'field2_search FROM TEST:', dummy_2d + stop 2 + endif + +!------------------------------------------------------------------------------------- +! SEARCH TEST CHECKS REPLACEMENT OF HRRR GRIB2 SOIL NO TYPE TARGET GRID +!------------------------------------------------------------------------------------- + + ! Fill esmf fields for search test + call ESMF_FieldScatter(field1_target_grid, field2_search, rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_search2,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums = (/224/) + input_type="grib2" + external_model="HRRR" + + !Call the search many routine to test search and replace + call search_many(num_fields,bundle_search2,dummy_2d,mask_target_search,1,field_nums,localpet, & + soilt_climo=soilt_climo) + + call ESMF_FieldBundleDestroy(bundle_search2,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + call ESMF_FieldGather(field1_target_grid, dummy_2d, rootPet=0, rc=rc) + + print*,"Check results for field2_search." + + if (any((abs(dummy_2d - field2_search_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field2_search SHOULD BE:', field2_search_correct + print*,'field2_search FROM TEST:', dummy_2d + stop 2 + endif + +!------------------------------------------------------------------------------------- +! DEFAULT TEST 1 CHECKS DEFAULT/CLIMO SST,TERRAIN,SOILTYPE REPLACEMENT +!------------------------------------------------------------------------------------- + + ! Fill esmf fields for default1 test + call ESMF_FieldScatter(field1_target_grid, field1_default, rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldScatter(field2_target_grid, field1_default,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldScatter(field3_target_grid, field1_default,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_default1,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums = (/11,7,224/) + !Call the search many routine to test some branches of default behavior + call search_many(num_fields,bundle_default1,dummy_2d,mask_default,1,field_nums,localpet, & + latitude=latitude_default,terrain_land=terrain_land,soilt_climo=soilt_climo) + + print*,"Check results for bundle_default1." + + do i = 1,num_fields + call ESMF_FieldBundleGet(bundle_default1,i,temp_field,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + call ESMF_FieldGet(temp_field, name=fname, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + print*, "Check ", trim(fname) + call ESMF_FieldGather(temp_field,dummy_2d,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + field_default_correct = field1_default + if (i .eq. 1) then + field_default_correct(2,2) = 273.16 + elseif (i .eq. 2) then + field_default_correct(2,2) = terrain_land(2,2) + else + field_default_correct(2,2) = soilt_climo(2,2) + endif + + if (any((abs(dummy_2d - field_default_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,trim(fname), ' SHOULD BE:', field_default_correct + print*,trim(fname), ' FROM TEST:', dummy_2d + stop 2 + endif + enddo + call ESMF_FieldBundleDestroy(bundle_default1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + +!--------------------------------------------- +! DEFAULT TEST 2 TESTS GFS GRIB2 SOIL TYPE +!--------------------------------------------- + ! Fill esmf fields for default2 test + call ESMF_FieldScatter(field1_target_grid, field1_default,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_default2,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums(:) = (/224/) + + input_type="grib2" + external_model="GFS" + !Call the search many routine to test behavior for GFS grib2 soil type + call search_many(num_fields,bundle_default2,dummy_2d,mask_default,1,field_nums,localpet,& + soilt_climo=soilt_climo) + + call ESMF_FieldBundleDestroy(bundle_default2,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + print*,"Check results for bundle_default2." + + call ESMF_FieldGather(field1_target_grid,dummy_2d,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + if (any((abs(dummy_2d - soilt_climo)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field1_target SHOULD BE:', soilt_climo + print*,'field1_target FROM TEST:', dummy_2d + stop 2 + endif + +!-------------------------------------------------------- +! 3D TEST TESTS REPLACEMENT FOR SOIL TEMPERATURE +!-------------------------------------------------------! +! Fill esmf fields for default2 test + call ESMF_FieldScatter(field_3d_target_grid,soil_temp_search,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_3d_search,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums(:) = (/21/) + + !Call the search many routine to test behavior for GFS grib2 soil type + call search_many(num_fields,bundle_3d_search,dummy_2d,mask_target_search,1,field_nums,localpet,& + field_data_3d=dummy_3d) + + call ESMF_FieldBundleDestroy(bundle_3d_search,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + print*,"Check results for bundle_3d_search." + + call ESMF_FieldGather(field_3d_target_grid,dummy_3d,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + do i = 1,lsoil_target + if (any((abs(dummy_3d(:,:,i) - soil_temp_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field_3d_target SHOULD BE:', soil_temp_correct + print*,'field_3d_target at level ',i,' FROM TEST:', dummy_3d(:,:,i) + stop 2 + endif + enddo + + print*,"Tests Passed!" + +! Deallocate and destroy + deallocate(field1_search_correct,field2_search_correct,field1_search,field2_search,mask_target_search) + deallocate(field1_default,mask_default,latitude_default,dummy_2d,terrain_land,soilt_climo,dummy_3d) + deallocate(soil_temp_correct,soil_temp_search,field_default_correct) + + call ESMF_FieldDestroy(latitude_target_grid,rc=rc) + call ESMF_FieldDestroy(longitude_target_grid,rc=rc) + call ESMF_FieldDestroy(field1_target_grid,rc=rc) + call ESMF_FieldDestroy(field2_target_grid,rc=rc) + call ESMF_FieldDestroy(field3_target_grid,rc=rc) + call ESMF_FieldDestroy(field4_target_grid,rc=rc) + call ESMF_FieldDestroy(field_3d_target_grid,rc=rc) + call ESMF_GridDestroy(target_grid, rc=rc) + + + call ESMF_finalize(endflag=ESMF_END_KEEPMPI) + call mpi_finalize(rc) + + print*,"SUCCESS!" + + end program surface_interp From cee91778c983e6204441a9b5a9f732c38a6e20e2 Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Mon, 18 Oct 2021 21:08:50 +0000 Subject: [PATCH 007/109] Update to language of unit test README to match that in unit test. --- tests/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/README.md b/tests/README.md index 2a01448de..b5500ba58 100644 --- a/tests/README.md +++ b/tests/README.md @@ -1,7 +1,7 @@ ## HOW TO CREATE A UNIT TEST. Unit tests should test only small parts of a program. For example, -a single routine or function. +a single routine or function, or multiple closely-linked routines. Source code for a test shall be placed in a program specific directory under ./tests. From 3f858724aaa31c3ed61c5f60dd677493bc453a5d Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Thu, 21 Oct 2021 08:42:08 -0400 Subject: [PATCH 008/109] chgres_cube - Eliminate segmentation fault in input_data.F90 (#585) Problem happened when using GRIB2 data as input. Variable 'slmsk_save' was not being allocated on all MPI tasks in routine 'read_input_sfc_grib2_file'. Fixes #584. --- sorc/chgres_cube.fd/input_data.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index b7029a59f..dab617f35 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -4797,7 +4797,7 @@ subroutine read_input_sfc_grib2_file(localpet) allocate(dummy2d_8(0,0)) allocate(dummy2d_82(0,0)) allocate(dummy2d(0,0)) - + allocate(slmsk_save(0,0)) endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -4861,7 +4861,7 @@ subroutine read_input_sfc_grib2_file(localpet) slmsk_save = nint(dummy2d) deallocate(icec_save) - endif + endif ! localpet == 0 print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." call ESMF_FieldScatter(landsea_mask_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) @@ -5033,7 +5033,8 @@ subroutine read_input_sfc_grib2_file(localpet) endif enddo enddo - endif + deallocate(dummy1d) + endif ! localpet == 0 if ((rc <= 0 .and. trim(to_upper(external_model)) /= "HRRR" .and. .not. rap_latlon) & .or. (rc < 0 .and. (trim(to_upper(external_model)) == "HRRR" .or. rap_latlon))) then @@ -5074,7 +5075,7 @@ subroutine read_input_sfc_grib2_file(localpet) print*,'sotype ',maxval(dummy2d_8),minval(dummy2d_8) deallocate(dummy2d_i) deallocate(dummy3d_stype) - endif + endif ! localpet == 0 print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." @@ -5486,11 +5487,13 @@ subroutine read_input_sfc_grib2_file(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldScatter", rc) - print*,"- CALL FieldScatter FOR INPUT VEG TYPE." + print*,"- CALL FieldScatter FOR INPUT SOIL TYPE." call ESMF_FieldScatter(soil_type_input_grid, dummy2d_82, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldScatter", rc) - + + deallocate(dummy2d_82) + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." call ESMF_FieldScatter(landsea_mask_input_grid,real(slmsk_save,esmf_kind_r8),rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& @@ -5511,9 +5514,11 @@ subroutine read_input_sfc_grib2_file(localpet) call check_soilt(dummy3d,slmsk_save,tsk_save) print*,'soilt ',maxval(dummy3d),minval(dummy3d) - deallocate(tsk_save, slmsk_save) + deallocate(tsk_save) endif + deallocate(slmsk_save) + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& From 005d210d93a55ba97a920d816a61fca918dad406 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 22 Oct 2021 07:06:48 -0400 Subject: [PATCH 009/109] Update documentation after move to ufs-community (#594) After ufs-utils was moved from NOAA-EMC to ufs-community, some of the documentation referred to the old url. Fixes #593 --- .github/PULL_REQUEST_TEMPLATE | 4 ++-- LICENSE.md | 2 +- README.md | 2 +- docs/source/chgres_cube.rst | 4 ++-- docs/source/ufs_utils.rst | 2 +- docs/user_guide.md | 2 +- tests/README.md | 2 +- 7 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.github/PULL_REQUEST_TEMPLATE b/.github/PULL_REQUEST_TEMPLATE index 2bb5c07fc..d465e2413 100644 --- a/.github/PULL_REQUEST_TEMPLATE +++ b/.github/PULL_REQUEST_TEMPLATE @@ -2,7 +2,7 @@ - You may delete any sections labeled "optional". -- If you are unclear on what should be written here, see https://github.com/NOAA-EMC/UFS_UTILS/wiki/9.-Creating-a-Pull-Request for some guidance. +- If you are unclear on what should be written here, see https://github.com/ufs-community/UFS_UTILS/wiki/9.-Creating-a-Pull-Request for some guidance. - The title of this pull request should be a brief summary (ideally less than 100 characters) of the changes included in this PR. Please also include the branch to which this PR is being issued. @@ -19,7 +19,7 @@ State whether the contingency tests were run or are pending, and if they were al ## DEPENDENCIES: Add any links to pending PRs that are required prior to merging this PR. For example: -NOAA-EMC/UFS_UTILS/pull/ +ufs-community/UFS_UTILS/pull/ ## DOCUMENTATION: If this PR is contributing new capabilities that need to be documented, please also include updates to the RST files in the docs/source directory as supporting material. diff --git a/LICENSE.md b/LICENSE.md index b7395d372..d8f627ec6 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -2,7 +2,7 @@ Copyright 2020 National Oceanic and Atmospheric Administration (by assignment fr The ufs_utils code incorporated in the Unified Forecast System (UFS) was jointly developed by the National Oceanic and Atmospheric Administration and the I. M. Systems Group. The gold standard copy -of the Code will be maintained by NOAA at https://github.com/NOAA-EMC/UFS_UTILS +of the Code will be maintained by NOAA at https://github.com/ufs-community/UFS_UTILS The National Oceanic and Atmospheric Administration is releasing this code under the GNU Lesser General Public License v3.0 (the "License"); you may not use this code except in compliance diff --git a/README.md b/README.md index 05dc5984c..3a192662c 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ Documentation for chgres_cube and other utilities can be found at https://noaa-emcufs-utils.readthedocs.io/en/latest/. Complete documentation can be found at -https://noaa-emc.github.io/UFS_UTILS/. +https://ufs-community.github.io/UFS_UTILS/. ## Authors diff --git a/docs/source/chgres_cube.rst b/docs/source/chgres_cube.rst index 4cba99841..988e346bb 100644 --- a/docs/source/chgres_cube.rst +++ b/docs/source/chgres_cube.rst @@ -407,12 +407,12 @@ Running the program stand alone Making changes to the chgres_cube program ----------------------------------------- -chgres_cube is part of the UFS_UTILS repository (https://github.com/NOAA-EMC/UFS_UTILS). When wanting to contribute to this repository developers shall follow the Gitflow software development process +chgres_cube is part of the UFS_UTILS repository (https://github.com/ufs-community/UFS_UTILS). When wanting to contribute to this repository developers shall follow the Gitflow software development process * Developers shall create their own fork of the UFS_UTILS repository * Developers shall create a ‘feature’ branch off ‘develop’ in their fork for all changes. * Developers shall open an issue and reference it in all commits. -For more details, see the UFS_UTILS wiki page: https://github.com/NOAA-EMC/UFS_UTILS/wiki +For more details, see the UFS_UTILS wiki page: https://github.com/ufs-community/UFS_UTILS/wiki Changes that support current or future NCEP operations will be given priority for inclusion into the authoritative repository. diff --git a/docs/source/ufs_utils.rst b/docs/source/ufs_utils.rst index 6e1193e57..b6e23aefe 100644 --- a/docs/source/ufs_utils.rst +++ b/docs/source/ufs_utils.rst @@ -5,7 +5,7 @@ Introduction **************************** -The Unified Forecast Systems (UFS) Utilities repository contains pre-processing programs for the UFS weather model. These programs set up the model grid and create coldstart initial conditions. The repository is hosted on `Github `_. Information on checking out the code and making changes to it is available on the repository `wiki page `_. +The Unified Forecast Systems (UFS) Utilities repository contains pre-processing programs for the UFS weather model. These programs set up the model grid and create coldstart initial conditions. The repository is hosted on `Github `_. Information on checking out the code and making changes to it is available on the repository `wiki page `_. *********************************** Grid Generation diff --git a/docs/user_guide.md b/docs/user_guide.md index 00ec65b67..dc70b4466 100644 --- a/docs/user_guide.md +++ b/docs/user_guide.md @@ -6,7 +6,7 @@ Utilities for the NCEP models. This is part of the [NCEPLIBS](https://github.com/NOAA-EMC/NCEPLIBS) project. The UFS_UTILS code can be found here: -https://github.com/NOAA-EMC/UFS_UTILS. +https://github.com/ufs-community/UFS_UTILS. ## The Utilities diff --git a/tests/README.md b/tests/README.md index b5500ba58..8a0d8033a 100644 --- a/tests/README.md +++ b/tests/README.md @@ -99,4 +99,4 @@ the unit test framework. ### QUESTIONS -Please contact the repository managers: https://github.com/NOAA-EMC/UFS_UTILS/wiki +Please contact the repository managers: https://github.com/ufs-community/UFS_UTILS/wiki From 5f34ba1ac41951b369fd1c719b8c1b9b0974807c Mon Sep 17 00:00:00 2001 From: David Wright Date: Fri, 5 Nov 2021 09:49:06 -0400 Subject: [PATCH 010/109] fvcom_tools - Add option to process 'cold' or 'warm' restart files (#595) Also, allow the user to select a specific time slice through the command line. Fixes #586 --- sorc/fvcom_tools.fd/CMakeLists.txt | 21 +- sorc/fvcom_tools.fd/docs/user_guide.md | 66 +++-- sorc/fvcom_tools.fd/fvcom_readme.md | 41 --- sorc/fvcom_tools.fd/module_ncio.f90 | 85 +++++-- sorc/fvcom_tools.fd/module_nwp.f90 | 277 +++++++++++++++++---- sorc/fvcom_tools.fd/process_FVCOM.f90 | 160 ++++++++---- tests/fvcom_tools/CMakeLists.txt | 26 ++ tests/fvcom_tools/LSanSuppress.supp | 2 + tests/fvcom_tools/ftst_readfvcomnetcdf.F90 | 146 +++++++++++ 9 files changed, 649 insertions(+), 175 deletions(-) delete mode 100644 sorc/fvcom_tools.fd/fvcom_readme.md create mode 100644 tests/fvcom_tools/CMakeLists.txt create mode 100644 tests/fvcom_tools/LSanSuppress.supp create mode 100644 tests/fvcom_tools/ftst_readfvcomnetcdf.F90 diff --git a/sorc/fvcom_tools.fd/CMakeLists.txt b/sorc/fvcom_tools.fd/CMakeLists.txt index 5bdac05a0..533435083 100644 --- a/sorc/fvcom_tools.fd/CMakeLists.txt +++ b/sorc/fvcom_tools.fd/CMakeLists.txt @@ -7,9 +7,10 @@ set(fortran_src kinds.f90 module_ncio.f90 module_nwp_base.f90 - module_nwp.f90 - process_FVCOM.f90) + module_nwp.f90) +# process_FVCOM.f90) +set(exe_src process_FVCOM.f90) if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8") @@ -18,15 +19,27 @@ elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU|Clang|AppleClang)$") endif() set(exe_name fvcom_to_FV3) -add_executable(${exe_name} ${fortran_src}) + +add_library(fvcom_tools_lib STATIC ${fortran_src}) +add_executable(${exe_name} ${exe_src}) + +set(mod_dir "${CMAKE_CURRENT_BINARY_DIR}/mod") +set_target_properties(fvcom_tools_lib PROPERTIES Fortran_MODULE_DIRECTORY ${mod_dir}) +target_include_directories(fvcom_tools_lib INTERFACE ${mod_dir}) + target_link_libraries( - ${exe_name} +# ${exe_name} + fvcom_tools_lib + PUBLIC MPI::MPI_Fortran NetCDF::NetCDF_Fortran) +target_link_libraries(${exe_name} PRIVATE fvcom_tools_lib) + install(TARGETS ${exe_name} RUNTIME DESTINATION ${exec_dir}) # If doxygen documentation we enabled, build it. if(ENABLE_DOCS) add_subdirectory(docs) endif() + diff --git a/sorc/fvcom_tools.fd/docs/user_guide.md b/sorc/fvcom_tools.fd/docs/user_guide.md index 1525880fd..e0dd50c53 100644 --- a/sorc/fvcom_tools.fd/docs/user_guide.md +++ b/sorc/fvcom_tools.fd/docs/user_guide.md @@ -1,18 +1,48 @@ - -# fvcom_tools - -# Introduction - -The process_FVCOM.f90 program replaces lake surface and lake ice -temperature along with aerial ice concentration generated from the -Great Lakes Operational Forecast System (GLOFS) in an FV3 surface -restart file. See [fvcom documentation](@ref fvcom_readme). - -This document is part of the UFS_UTILS -documentation. - -The fvcom_tools program is part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - - +@brief replaces lake surface and lake ice temperature @anchor user_guide + +**fvcom_to_FV3.exe** + +**Introduction:** + This code replaces lake surface and lake ice temperature along + with aerial ice concentration generated from Great Lakes + Operational Forecast System (GLOFS), an FVCOM-based model, into + sfc_data.nc. + **NOTE** that the variables in the input files must reside on + the same grid. This means data from FVCOM must be horizontally + interpolated to the FV3 grid. This routine will also force a + minimum ice concentration of 15%. If ice concentration is less + than 15% in FVCOM, it will be set to 0% to avoid FV3 from + changing values less than 15% to 15% and generating unrealistic + lake ice temperatures. + +**Library Dependencies:** + Installation depends on the netCDF library and cmake. + +**Running:** + This routine will take four variables from the command line: + 1. Name of FV3 sfc data file (e.g. sfc_data.tile7.halo0.nc) + which is generated from chgres_cube.exe. + 2. Name of FVCOM data file in netcdf format (e.g. fvcom.nc) + 3. "warm" or "cold" start. "warm" start will read in + sfc_data.nc files generated from a restart of UFS-SRW. + "cold" start will read in sfc_data.nc files generated + from chgres_cube. + 4. String of time slice to use in the fvcom.nc file. This string + should match exactly what is in the Times variable of the .nc file. + To run the script, use the following example, modifying file + names as needed: + ./fvcom_to_FV3 sfc_data.tile7.halo0.nc fvcom.nc cold \ + 2020-01-31T18:00:00.000000 + Output will be to the sfc data file and include lake surface + and lake ice temperature, and lake ice concentration from the + first time in the FVCOM file. + + +This routine is *strongly* based upon Eric James' (ESRL/GSL) work + to update HRRR/WRF Great Lakes' temperature data with FVCOM. + It also relies heavily on Ming Hu's (ESRL/GSL) ncio module. + +**For more information, please contact:** + David Wright + University of Michigan and GLERL + dmwright@umich.edu diff --git a/sorc/fvcom_tools.fd/fvcom_readme.md b/sorc/fvcom_tools.fd/fvcom_readme.md deleted file mode 100644 index 0eae64652..000000000 --- a/sorc/fvcom_tools.fd/fvcom_readme.md +++ /dev/null @@ -1,41 +0,0 @@ -@brief replaces lake surface and lake ice temperature @anchor fvcom_readme - -**fvcom_to_FV3.exe** - -**Introduction:** - This code replaces lake surface and lake ice temperature along - with aerial ice concentration generated from Great Lakes - Operational Forecast System (GLOFS), an FVCOM-based model, into - sfc_data.nc. - **NOTE** that the variables in the input files must reside on - the same grid. This means data from FVCOM must be horizontally - interpolated to the FV3 grid. This routine will also force a - minimum ice concentration of 15%. If ice concentration is less - than 15% in FVCOM, it will be set to 0% to avoid FV3 from - changing values less than 15% to 15% and generating unrealistic - lake ice temperatures. - -**Library Dependencies:** - Installation depends on the netCDF library and cmake. - -**Running:** - This routine will take two variables from the command line: - 1. Name of FV3 sfc data file (e.g. sfc_data.tile7.halo0.nc) - which is generated from chgres_cube.exe. - 2. Name of FVCOM data file in netcdf format (e.g. fvcom.nc) - - To run the script, use the following example, modifying file - names as needed: - ./fvcom_to_FV3 sfc_data.tile7.halo0.nc fvcom.nc - Output will be to the sfc data file and include lake surface - and lake ice temperature, and lake ice concentration from FVCOM. - - -This routine is *strongly* based upon Eric James' (ESRL/GSL) work - to update HRRR/WRF Great Lakes' temperature data with FVCOM. - It also relies heavily on Ming Hu's (ESRL/GSL) ncio module. - -**For more information, please contact:** - David Wright - University of Michigan and GLERL - dmwright@umich.edu diff --git a/sorc/fvcom_tools.fd/module_ncio.f90 b/sorc/fvcom_tools.fd/module_ncio.f90 index 318d9f172..548878979 100644 --- a/sorc/fvcom_tools.fd/module_ncio.f90 +++ b/sorc/fvcom_tools.fd/module_ncio.f90 @@ -85,7 +85,10 @@ module module_ncio procedure :: replace_var_nc_char_3d !< Replace 3D character type variable. @return procedure :: handle_err !< Handle netCDF errors. @return procedure :: convert_theta2t_2dgrid !< Convert theta T (Kelvin) to T (deg C). @return - procedure :: add_new_var => add_new_var_3d !< Add a new 3d variable to output file. @return + generic :: add_new_var => add_new_var_2d, & + add_new_var_3d !< Add a new 2d or 3d variable to ouput file. @return + procedure :: add_new_var_2d !< Add a new 2d variable to output file. @return + procedure :: add_new_var_3d !< Add a new 3d variable to output file. @return end type ncio contains @@ -1306,10 +1309,10 @@ subroutine get_var_nc_double_2d(this,varname,nd1,nd2,field) field(:,j)=temp(istart:iend) enddo ! - if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) - endif +! if(this%debug_level>100) then +! write(*,*) trim(thissubname),' show samples:' +! write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) +! endif else write(*,*) trim(thissubname),' ERROR: dimension does not match.' write(*,*) nd1,this%ends(1),nd2,this%ends(2) @@ -1362,12 +1365,12 @@ subroutine get_var_nc_double_3d(this,varname,nd1,nd2,nd3,field) enddo enddo ! - if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - do k=1,nd3 - write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) - enddo - endif +! if(this%debug_level>100) then +! write(*,*) trim(thissubname),' show samples:' +! do k=1,nd3 +! write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) +! enddo +! endif else write(*,*) trim(thissubname),' ERROR: dimension does not match.' write(*,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) @@ -1441,6 +1444,7 @@ subroutine get_var_nc_double(this,varname,ilength,field) if(status /= nf90_NoErr) call this%handle_err(status) do i=1,nDims dimname=" " + write(*,*) 'dimids(i) = ', dimids(i) status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim) if (status /= nf90_noerr) call this%handle_err(status) ends(i)=ndim @@ -2271,10 +2275,10 @@ subroutine get_var_nc_char_2d(this,varname,nd1,nd2,field) field(:,j)=temp(istart:iend) enddo ! - if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) field(1,1) - endif +! if(this%debug_level>100) then +! write(*,*) trim(thissubname),' show samples:' +! write(*,*) field(1,1) +! endif else write(*,*) trim(thissubname),' ERROR: dimension does not match.' write(*,*) nd1,this%ends(1),nd2,this%ends(2) @@ -2327,10 +2331,10 @@ subroutine get_var_nc_char_3d(this,varname,nd1,nd2,nd3,field) enddo enddo ! - if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) field(1,1,1) - endif +! if(this%debug_level>100) then +! write(*,*) trim(thissubname),' show samples:' +! write(*,*) field(1,1,1) +! endif else write(*,*) trim(thissubname),' ERROR: dimension does not match.' write(*,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) @@ -2542,4 +2546,47 @@ subroutine add_new_var_3d(this,varname,dname1,dname2,dname3,lname,units) end subroutine add_new_var_3d + !> Add a new variable to sfc_data.nc with dimensions (yaxis_1, + !! xaxis_1). + !! + !! @param this instance of an ncio class + !! @param[in] varname Name of variable to be created in netcdf file + !! @param[in] dname1 1st dimension name + !! @param[in] dname2 2nd dimension name + !! @param[in] lname long name output for netcdf variable + !! @param[in] units units to use in netcdf variable + !! + !! @author David.M.Wright org: UM/GLERL @date 2021-10-07 + subroutine add_new_var_2d(this,varname,dname1,dname2,lname,units) + implicit none + ! + class(ncio) :: this + character(len=*),intent(in) :: varname,dname1,dname2 & + ,lname,units + integer :: status, ncid, dim1id, dim2id, varid + + status = nf90_redef(this%ncid) !Enter Define Mode + if (status /= nf90_noerr) call this%handle_err(status) + + status = nf90_inq_dimid(this%ncid, dname1, dim1id) + if (status /= nf90_noerr) call this%handle_err(status) + status = nf90_inq_dimid(this%ncid, dname2, dim2id) + if (status /= nf90_noerr) call this%handle_err(status) + + status = nf90_def_var(this%ncid, varname, nf90_double, & + (/ dim1id, dim2id /), varid) + if (status /= nf90_noerr) call this%handle_err(status) + + status = nf90_put_att(this%ncid, varid, 'long_name', lname) + if (status /= nf90_noerr) call this%handle_err(status) + status = nf90_put_att(this%ncid, varid, 'units', units) + if (status /= nf90_noerr) call this%handle_err(status) + + status = nf90_enddef(this%ncid) !Exit Define Mode and + ! return to Data Mode + if (status /= nf90_noerr) call this%handle_err(status) + + end subroutine add_new_var_2d + + end module module_ncio diff --git a/sorc/fvcom_tools.fd/module_nwp.f90 b/sorc/fvcom_tools.fd/module_nwp.f90 index c3c925333..a4894b6c0 100644 --- a/sorc/fvcom_tools.fd/module_nwp.f90 +++ b/sorc/fvcom_tools.fd/module_nwp.f90 @@ -31,23 +31,35 @@ module module_nwp integer :: xlat !< Number of latitudes. integer :: xlon !< Number of longitudes. integer :: xtime !< Number of times. + integer :: datelen !< Length of date string. integer :: i_mask !< Is var visible (always 1). integer :: i_sst !< Index of sst var. integer :: i_ice !< Index of ice var. integer :: i_sfcT !< Index of sst temp var. integer :: i_iceT !< Index of ice temp var. + integer :: i_sfcTl !< Index of sfcTl character(len=20), allocatable :: varnames(:) !< Variable names. character(len=20), allocatable :: latname !< Latitude name. character(len=20), allocatable :: lonname !< Longitude name. character(len=20), allocatable :: dimnameEW !< East/West dimension name. character(len=20), allocatable :: dimnameNS !< North/South dimension name. character(len=20), allocatable :: dimnameTIME !< Time dimension name. + character(len=20), allocatable :: dimnameDATE !< String dimension name. + character(len=1), allocatable :: times(:,:) !< Array of times in FVCOM. + + real(r_kind), allocatable :: nwp_mask_c(:,:) !< cold start land/water mask 3d array + real(r_kind), allocatable :: nwp_sst_c(:,:,:) !< cold start sst 3d array + real(r_kind), allocatable :: nwp_ice_c(:,:,:) !< cold start over water ice concentration 3d array + real(r_kind), allocatable :: nwp_sfct_c(:,:,:) !< cold start skin temperature 3d array + real(r_kind), allocatable :: nwp_icet_c(:,:,:) !< cold start ice skin temperature 3d array + + real(r_kind), allocatable :: nwp_mask_w(:,:) !< warm start land/water mask 3d array + real(r_kind), allocatable :: nwp_sst_w(:,:) !< warm start sst 3d array + real(r_kind), allocatable :: nwp_ice_w(:,:) !< warm start over water ice concentration 3d array + real(r_kind), allocatable :: nwp_sfct_w(:,:) !< warm start skin temperature 3d array + real(r_kind), allocatable :: nwp_icet_w(:,:) !< warm start ice skin temperature 3d array + real(r_kind), allocatable :: nwp_sfctl_w(:,:) !< warm start skin temperature 3d array - real(r_kind), allocatable :: nwp_mask(:,:,:) !< Land/water mask 3D array - real(r_kind), allocatable :: nwp_sst(:,:,:) !< SST 3D array - real(r_kind), allocatable :: nwp_ice(:,:,:) !< Over water ice concentration 3D array - real(r_kind), allocatable :: nwp_sfcT(:,:,:) !< Skin temperature 3D array - real(r_kind), allocatable :: nwp_iceT(:,:,:) !< Ice skin temperature 3D array end type nwp_type type, extends(nwp_type) :: fcst_nwp @@ -61,6 +73,7 @@ module module_nwp procedure :: initial => initial_nwp !< Defines vars and names. @return procedure :: list_initial => list_initial_nwp !< List the setup. @return procedure :: read_n => read_nwp !< Initialize arrays, get data. @return + procedure :: get_time_ind => get_time_ind_nwp !< Get time ind. @return procedure :: finish => finish_nwp !< Finish and deallocate. @return end type fcst_nwp @@ -75,11 +88,13 @@ module module_nwp !! !! @param this fcst_nwp object !! @param[in] itype either ' FVCOM' or 'FV3LAM'. + !! @param[in] wcstart either 'warm' or 'cold'. !! @author David Wright, University of Michigan and GLERL - subroutine initial_nwp(this,itype) + subroutine initial_nwp(this,itype,wcstart) class(fcst_nwp) :: this character(len=6), intent(in) :: itype + character(len=4), intent(in) :: wcstart ! FVCOM grid if (itype==' FVCOM') then @@ -106,13 +121,46 @@ subroutine initial_nwp(this,itype) allocate(this%dimnameEW) allocate(this%dimnameNS) allocate(this%dimnameTIME) + allocate(this%dimnameDATE) this%dimnameEW = 'lon' this%dimnameNS = 'lat' this%dimnameTIME = 'Time' + this%dimnameDATE = 'DateStrLen' ! FV3LAM grid - else if (trim(itype)=='FV3LAM') then + else if (trim(itype)=='FV3LAM' .AND. wcstart=='warm') then + this%datatype = itype + this%numvar = 6 + + this%i_mask = 1 + this%i_sst = 2 + this%i_ice = 3 + this%i_iceT = 4 + this%i_sfcT = 5 + this%i_sfcTl= 6 + + allocate(this%varnames(this%numvar)) + this%varnames(1) = 'slmsk' + this%varnames(2) = 'tsea' + this%varnames(3) = 'fice' + this%varnames(4) = 'tisfc' + this%varnames(5) = 'tsfc' + this%varnames(6) = 'tsfcl' + + allocate(this%latname) + allocate(this%lonname) + this%latname = 'yaxis_1' + this%lonname = 'xaxis_1' + + allocate(this%dimnameEW) + allocate(this%dimnameNS) + allocate(this%dimnameTIME) + this%dimnameEW = 'xaxis_1' + this%dimnameNS = 'yaxis_1' + this%dimnameTIME = 'Time' + + else if (trim(itype)=='FV3LAM' .AND. wcstart=='cold') then this%datatype = itype this%numvar = 4 @@ -168,9 +216,9 @@ subroutine list_initial_nwp(this) write(*,*) 'List initial setup for ', this%datatype write(*,*) 'number of variables ', this%numvar - write(*,*) 'variable index: mask, sst, ice, sfcT' + write(*,*) 'variable index: mask, sst, ice, sfcT, sfcTl' write(*,'(15x,10I3)') this%i_mask, this%i_sst, this%i_ice, & - & this%i_sfcT + & this%i_sfcT, this%i_sfcTl write(*,*) 'variable name:' do k=1,this%numvar write(*,*) k,trim(this%varnames(k)) @@ -187,6 +235,7 @@ end subroutine list_initial_nwp !! @param this fcst_nwp ojbect !! @param[in] filename netcdf file name !! @param[in] itype either ' FVCOM' or 'FV3LAM' + !! @param[in] wcstart either 'warm' or 'cold'. !! @param[inout] numlon number of grid points in x-direction !! @param[inout] numlat number of grid poinst in y-direction !! @param[inout] numtimes length of time dimension @@ -196,20 +245,22 @@ end subroutine list_initial_nwp !! @param[inout] ice Ice concentration (%) !! @param[inout] sfcT Skin Temperature !! @param[inout] iceT Ice Skin Temperature + !! @param[inout] sfcTl Skin Temperature in restart file !! !! @author David Wright, University of Michigan and GLERL - subroutine read_nwp(this,filename,itype,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT) + subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl) class(fcst_nwp) :: this - character(len=5), intent(in) :: itype + character(len=6), intent(in) :: itype character(len=*), intent(in) :: filename + character(len=4), intent(in) :: wcstart integer, intent(in) :: time_to_get integer, intent(inout) :: numlon, numlat, numtimes ! real(r_single), intent(inout) :: mask(:,:), sst(:,:), ice(:,:), sfcT(:,:) real(r_kind), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) & - ,iceT(:,:) + ,iceT(:,:),sfcTl(:,:) ! Open the file using module_ncio.f90 code, and find the number of ! lat/lon points @@ -227,42 +278,100 @@ subroutine read_nwp(this,filename,itype,numlon,numlat,numtimes,time_to_get,mask, numtimes = this%xtime ! Allocate all the arrays to receive data - - allocate(this%nwp_mask(this%xlon,this%xlat,this%xtime)) - allocate(this%nwp_sst(this%xlon,this%xlat,this%xtime)) - allocate(this%nwp_ice(this%xlon,this%xlat,this%xtime)) - allocate(this%nwp_sfcT(this%xlon,this%xlat,this%xtime)) - allocate(this%nwp_iceT(this%xlon,this%xlat,this%xtime)) + if (wcstart == 'cold' .OR. itype == ' FVCOM') then + allocate(this%nwp_mask_c(this%xlon,this%xlat)) + allocate(this%nwp_sst_c(this%xlon,this%xlat,this%xtime)) + allocate(this%nwp_ice_c(this%xlon,this%xlat,this%xtime)) + allocate(this%nwp_sfcT_c(this%xlon,this%xlat,this%xtime)) + allocate(this%nwp_iceT_c(this%xlon,this%xlat,this%xtime)) ! Get variables from the data file, but only if the variable is ! defined for that data type. - if (this%i_mask .gt. 0) then - call ncdata%get_var(this%varnames(this%i_mask),this%xlon, & - this%xlat,this%xtime,this%nwp_mask) - mask = this%nwp_mask(:,:,1) - end if - if (this%i_sst .gt. 0) then - call ncdata%get_var(this%varnames(this%i_sst),this%xlon, & - this%xlat,this%xtime,this%nwp_sst) - sst = this%nwp_sst(:,:,time_to_get) - end if - if (this%i_ice .gt. 0) then - call ncdata%get_var(this%varnames(this%i_ice),this%xlon, & - this%xlat,this%xtime,this%nwp_ice) - ice = this%nwp_ice(:,:,time_to_get) - end if - if (this%i_sfcT .gt. 0) then - call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, & - this%xlat,this%xtime,this%nwp_sfcT) - sfcT = this%nwp_sfcT(:,:,time_to_get) + write(*,*) 'itype = ', itype + write(*,*) 'wcstart = ', wcstart + write(*,*) 'xlat = ', this%xlat + write(*,*) 'xlon = ', this%xlon + write(*,*) 'xtime = ', this%xtime + + if (this%i_mask .gt. 0) then + call ncdata%get_var(this%varnames(this%i_mask),this%xlon, & + this%xlat,this%nwp_mask_c) + mask = this%nwp_mask_c(:,:) + end if + if (this%i_sst .gt. 0) then + write(*,*) 'get sst for cold or FVCOM' + call ncdata%get_var(this%varnames(this%i_sst),this%xlon, & + this%xlat,this%xtime,this%nwp_sst_c) + sst = this%nwp_sst_c(:,:,time_to_get) + end if + if (this%i_ice .gt. 0) then + call ncdata%get_var(this%varnames(this%i_ice),this%xlon, & + this%xlat,this%xtime,this%nwp_ice_c) + ice = this%nwp_ice_c(:,:,time_to_get) + end if + if (this%i_sfcT .gt. 0) then + call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, & + this%xlat,this%xtime,this%nwp_sfcT_c) + sfcT = this%nwp_sfcT_c(:,:,time_to_get) + end if + if (this%i_iceT .gt. 0) then + call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, & + this%xlat,this%xtime,this%nwp_iceT_c) + iceT = this%nwp_iceT_c(:,:,time_to_get) + end if + else if (wcstart == 'warm') then + allocate(this%nwp_mask_w(this%xlon,this%xlat)) + allocate(this%nwp_sst_w(this%xlon,this%xlat)) + allocate(this%nwp_ice_w(this%xlon,this%xlat)) + allocate(this%nwp_sfcT_w(this%xlon,this%xlat)) + allocate(this%nwp_iceT_w(this%xlon,this%xlat)) + allocate(this%nwp_sfcTl_w(this%xlon,this%xlat)) +! Get variables from the data file, but only if the variable is +! defined for that data type. + + write(*,*) 'itype = ', itype + write(*,*) 'wcstart =', wcstart + write(*,*) 'xlat = ', this%xlat + write(*,*) 'xlon = ', this%xlon + write(*,*) 'xtime = ', this%xtime + + + + if (this%i_mask .gt. 0) then + call ncdata%get_var(this%varnames(this%i_mask),this%xlon, & + this%xlat,this%nwp_mask_w) + mask = this%nwp_mask_w(:,:) + end if + if (this%i_sst .gt. 0) then + call ncdata%get_var(this%varnames(this%i_sst),this%xlon, & + this%xlat,this%nwp_sst_w) + sst = this%nwp_sst_w(:,:) + end if + if (this%i_ice .gt. 0) then + call ncdata%get_var(this%varnames(this%i_ice),this%xlon, & + this%xlat,this%nwp_ice_w) + ice = this%nwp_ice_w(:,:) + end if + if (this%i_sfcT .gt. 0) then + call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, & + this%xlat,this%nwp_sfcT_w) + sfcT = this%nwp_sfcT_w(:,:) + end if + if (this%i_iceT .gt. 0) then + call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, & + this%xlat,this%nwp_iceT_w) + iceT = this%nwp_iceT_w(:,:) + end if + if (this%i_sfcTl .gt. 0) then + call ncdata%get_var(this%varnames(this%i_sfcTl),this%xlon, & + this%xlat,this%nwp_sfcTl_w) + sfcTl = this%nwp_sfcTl_w(:,:) + end if + else + write(*,*) 'Choose either "warm" or "cold" for file' + stop 'Error in wcstart. Check spelling or if variable was assigned' end if - if (this%i_iceT .gt. 0) then - call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, & - this%xlat,this%xtime,this%nwp_iceT) - iceT = this%nwp_iceT(:,:,time_to_get) - end if - ! Close the netCDF file. call ncdata%close @@ -275,10 +384,14 @@ end subroutine read_nwp !> Finish and deallocate. !! !! @param this fcst_nwp object + !! @param[in] itype either ' FVCOM' or 'FV3LAM' + !! @param[in] wcstart either 'warm' or 'cold'. !! @author David Wright, University of Michigan and GLERL - subroutine finish_nwp(this) + subroutine finish_nwp(this,itype,wcstart) class(fcst_nwp) :: this + character(len=6), intent(in) :: itype + character(len=4), intent(in) :: wcstart type(nwpbase), pointer :: thisobs,thisobsnext @@ -288,11 +401,21 @@ subroutine finish_nwp(this) deallocate(this%dimnameEW) deallocate(this%dimnameNS) deallocate(this%dimnameTIME) - deallocate(this%nwp_mask) - deallocate(this%nwp_sst) - deallocate(this%nwp_ice) - deallocate(this%nwp_sfcT) - deallocate(this%nwp_iceT) + if (wcstart == 'cold' .OR. itype==' FVCOM') then + deallocate(this%nwp_mask_c) + deallocate(this%nwp_sst_c) + deallocate(this%nwp_ice_c) + deallocate(this%nwp_sfcT_c) + deallocate(this%nwp_iceT_c) + else if (wcstart == 'warm') then + deallocate(this%nwp_mask_w) + deallocate(this%nwp_sst_w) + deallocate(this%nwp_ice_w) + deallocate(this%nwp_sfcT_w) + deallocate(this%nwp_iceT_w) + else + write(*,*) 'no deallocation' + end if thisobs => this%head if(.NOT.associated(thisobs)) then @@ -312,4 +435,60 @@ subroutine finish_nwp(this) end subroutine finish_nwp + !> This subroutine searches the FVCOM 'Times' variable + !! and returns the matching index + !! + !! @param this fcst_nwp ojbect + !! @param[in] filename netcdf file name + !! @param[in] instr string of requested time + !! @param[out] outindex int index that matches instr + !! + !! @author David Wright, University of Michigan and GLERL + subroutine get_time_ind_nwp(this,filename,instr,outindex) + + class(fcst_nwp) :: this + + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: instr + integer, intent(out) :: outindex + + character(len=26) :: temp + integer :: foundind + integer :: k,i + +! Open the file using module_ncio.f90 code, and find the length of +! time in the file + call ncdata%open(trim(filename),'r',200) + call ncdata%get_dim(this%dimnameTIME,this%xtime) + call ncdata%get_dim(this%dimnameDATE,this%datelen) + write(*,*) 'xtime = ', this%xtime + write(*,*) 'datelen = ', this%datelen + allocate(this%times(this%datelen,this%xtime)) + call ncdata%get_var('Times',this%datelen,this%xtime,this%times) + + foundind = 0 + + do k=1,this%xtime,1 + do i = 1,len(temp),1 + temp(i:i) = this%times(i,k) + end do + if (trim(temp) == trim(instr)) then !If times are equal return k + outindex = k + foundind = 1 + end if + end do + if (foundind == 0) then + outindex = -999 + deallocate(this%times) + call ncdata%close + write(*,*) 'WARNING: Supplied time not found in file: ', trim(instr) + write(*,*) 'Stoppping fvcom_to_FV3 and proceeding without using FVCOM data' + stop + end if + + deallocate(this%times) + call ncdata%close + + end subroutine get_time_ind_nwp + end module module_nwp diff --git a/sorc/fvcom_tools.fd/process_FVCOM.f90 b/sorc/fvcom_tools.fd/process_FVCOM.f90 index 960980cc7..bbcffcec9 100755 --- a/sorc/fvcom_tools.fd/process_FVCOM.f90 +++ b/sorc/fvcom_tools.fd/process_FVCOM.f90 @@ -8,14 +8,19 @@ !! GLERL-provided FVCOM forecast files (which have already been mapped !! to the FV3-LAM grid) into sfc_data.nc. !! -!! This script will take two variables from the command line: +!! This script will take four variables from the command line: !! 1. Name of FV3 sfc data file (e.g. sfc_data.tile7.halo0.nc) !! 2. Name of FVCOM data file (e.g. fvcom.nc) -!! +!! 3. "warm" or "cold" start. "warm" start will read in +!! sfc_data.nc files generated from a restart of UFS-SRW. +!! "cold" start will read in sfc_data.nc files generated +!! from chgres_cube. +!! 4. String of time slice to use in the fvcom.nc file. This string +!! should match exactly what is in the Times variable of the .nc file. !! To run the script, use the following example, modifying file !! names as needed: -!! ./fvcom_to_FV3 sfc_data.tile7.halo0.nc fvcom.nc -!! +!! ./fvcom_to_FV3 sfc_data.tile7.halo0.nc fvcom.nc cold \ +!! 2020-01-31T18:00:00.000000 !! Code is strongly based upon Eric James' (ESRL/GSL) work to update !! HRRR/WRF Great Lakes' temperature data with FVCOM. Code also !! relies heavily on Ming Hu's ncio module. @@ -53,6 +58,7 @@ program process_FVCOM integer :: lbclon, lbclat, lbctimes integer :: i, j, t1, t2 integer :: num_args, ix + integer :: indexFVCOMsel real :: rad2deg = 180.0/3.1415926 real :: userDX, userDY, CEN_LAT, CEN_LON @@ -63,11 +69,13 @@ program process_FVCOM character(len=180) :: fv3file character(len=180) :: fvcomfile + character(len=180) :: wcstart + character(len=180) :: inputFVCOMselStr character(len=180), dimension(:), allocatable :: args real(r_kind), allocatable :: fv3ice(:,:), fv3sst(:,:) real(r_kind), allocatable :: fv3sfcT(:,:), fv3mask(:,:) - real(r_kind), allocatable :: fv3iceT(:,:) + real(r_kind), allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) real(r_kind), allocatable :: lbcice(:,:), lbcsst(:,:) real(r_kind), allocatable :: lbcsfcT(:,:), lbcmask(:,:) real(r_kind), allocatable :: lbciceT(:,:) @@ -96,13 +104,20 @@ program process_FVCOM do ix = 1, num_args call get_command_argument(ix,args(ix)) end do - +! fv3file: location of UFS grid +! fvcomfile: location of FVCOM data file +! wcstart: warm (restart) or cold start +! inputFVCOMtimes: string of time to use fv3file=trim(args(1)) write(*,*) trim(fv3file) fvcomfile=trim(args(2)) write(*,*) trim(fvcomfile) + wcstart=trim(args(3)) + write(*,*) 'warm or cold start = ', wcstart + inputFVCOMselStr=trim(args(4)) +! read(inputFVCOMselStr,*) inputFVCOMsel + write(*,*) 'select time = ', inputFVCOMselStr - t2 = 1 ! Obtain grid parameters workPath='./' @@ -124,6 +139,7 @@ program process_FVCOM allocate(fv3sst(nlon,nlat)) allocate(fv3mask(nlon,nlat)) allocate(fv3iceT(nlon,nlat)) + allocate(fv3sfcTl(nlon,nlat)) allocate(lbcice(nlon,nlat)) allocate(lbcsfcT(nlon,nlat)) @@ -134,12 +150,15 @@ program process_FVCOM ! Read fv3 sfc_data.nc before update ! fv3file='sfc_data.nc' +! fv3times: length of time dimension of UFS atmospheric grid (should be 1) +! t1: index of time dimension to pull (should be 1) + fv3times=1 t1=1 - call fcst%initial('FV3LAM') + call fcst%initial('FV3LAM',wcstart) call fcst%list_initial - call fcst%read_n(trim(fv3file),'FV3LAM',fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT) - call fcst%finish + call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl) + call fcst%finish('FV3LAM',wcstart) write(*,*) 'fv3times: ', fv3times @@ -148,57 +167,101 @@ program process_FVCOM ! Read FVCOM input datasets ! fvcomfile='fvcom.nc' +! lbctimes: length of time dimension of FVCOM input data (command line input) ! Space infront of ' FVCOM' below is important!! - call fcst%initial(' FVCOM') + call fcst%initial(' FVCOM',wcstart) call fcst%list_initial - call fcst%read_n(trim(fvcomfile),' FVCOM',lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT) - call fcst%finish + call fcst%get_time_ind(trim(fvcomfile),inputFVCOMselStr,indexFVCOMsel) +! t2: index of time dimension to pull from FVCOM + t2=indexFVCOMsel + write(*,*) 'time asked for =', trim(inputFVCOMselStr) + write(*,*) 'time index selected = ', t2 + call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl) + call fcst%finish(' FVCOM',wcstart) ! Check that the dimensions match if (lbclon .ne. nlon .or. lbclat .ne. nlat) then - write(*,*) 'ERROR: FVCOM/FV3 dimensions do not match:' + write(*,*) 'ERROR: FVCOM/FV3 dimensions do not match:' write(*,*) 'lbclon: ', lbclon write(*,*) 'nlon: ', nlon write(*,*) 'lbclat: ', lbclat write(*,*) 'nlat: ', nlat - stop 135 + stop 'error' endif write(*,*) 'lbctimes: ', lbctimes write(*,*) 'time to use: ', t2 + if (t2 .gt. lbctimes) then + write(*,*) 'ERROR: Requested time dimension out of range' + write(*,*) 'Length of time dimension: ', lbctimes + write(*,*) 'Time index to use: ', t2 + stop 'error' + endif + ! Update with FVCOM fields and process ! ice cover data. Ice fraction is set ! to a minimum of 15% due to FV3-LAM ! raising any value below 15% to 15%. - - do j=1,nlat - do i=1,nlon - if (lbcmask(i,j) > 0. .and. lbcsst(i,j) .ge. -90.0) then - !If ice fraction below 15%, set to 0 - if (lbcice(i,j) < 0.15) then - lbcice(i,j) = 0.0 - endif - fv3ice(i,j) = lbcice(i,j) - !If ice in FVCOM, but not in FV3-LAM, change to ice - if (lbcice(i,j) > 0. .and. fv3mask(i,j) == 0.) then - fv3mask(i,j) = 2. - endif - !If ice in FV3-LAM and not FVCOM, remove it from FV3-LAM - if (fv3mask(i,j) == 2. .and. lbcice(i,j) == 0.) then - fv3mask(i,j) = 0. - endif - fv3sst(i,j) = lbcsst(i,j) + 273.15 - fv3sfcT(i,j) = lbcsst(i,j) + 273.15 - fv3iceT(i,j) = lbcsst(i,j) + 273.15 - !If ice exists in FVCOM, change ice surface temp - if (lbcice(i,j) > 0.) then - fv3iceT(i,j) = lbciceT(i,j) + 273.15 - end if - endif - enddo - enddo + if (wcstart == 'warm') then + do j=1,nlat + do i=1,nlon + if (lbcmask(i,j) > 0. .and. lbcsst(i,j) .ge. -90.0) then + !If ice fraction below 15%, set to 0 + if (lbcice(i,j) < 0.15) then + lbcice(i,j) = 0.0 + endif + fv3ice(i,j) = lbcice(i,j) + !If ice in FVCOM, but not in FV3-LAM, change to ice + if (lbcice(i,j) > 0. .and. fv3mask(i,j) == 0.) then + fv3mask(i,j) = 2. + endif + !If ice in FV3-LAM and not FVCOM, remove it from FV3-LAM + if (fv3mask(i,j) == 2. .and. lbcice(i,j) == 0.) then + fv3mask(i,j) = 0. + endif + fv3sst(i,j) = lbcsst(i,j) + 273.15 + fv3sfcT(i,j) = lbcsst(i,j) + 273.15 + fv3iceT(i,j) = lbcsst(i,j) + 273.15 + fv3sfcTl(i,j)= lbcsst(i,j) + 273.15 + !If ice exists in FVCOM, change ice surface temp + if (lbcice(i,j) > 0.) then + fv3iceT(i,j) = lbciceT(i,j) + 273.15 + end if + end if + enddo + enddo + else if (wcstart == 'cold') then + do j=1,nlat + do i=1,nlon + if (lbcmask(i,j) > 0. .and. lbcsst(i,j) .ge. -90.0) then + !If ice fraction below 15%, set to 0 + if (lbcice(i,j) < 0.15) then + lbcice(i,j) = 0.0 + endif + fv3ice(i,j) = lbcice(i,j) + !If ice in FVCOM, but not in FV3-LAM, change to ice + if (lbcice(i,j) > 0. .and. fv3mask(i,j) == 0.) then + fv3mask(i,j) = 2. + endif + !If ice in FV3-LAM and not FVCOM, remove it from FV3-LAM + if (fv3mask(i,j) == 2. .and. lbcice(i,j) == 0.) then + fv3mask(i,j) = 0. + endif + fv3sst(i,j) = lbcsst(i,j) + 273.15 + fv3sfcT(i,j) = lbcsst(i,j) + 273.15 + fv3iceT(i,j) = lbcsst(i,j) + 273.15 + !If ice exists in FVCOM, change ice surface temp + if (lbcice(i,j) > 0.) then + fv3iceT(i,j) = lbciceT(i,j) + 273.15 + end if + end if + enddo + enddo + else + write(*,*) 'Variable wcstart is not set to either warm or cold' + end if ! Write out sfc file again @@ -207,9 +270,18 @@ program process_FVCOM call geo%replace_var("fice",NLON,NLAT,fv3ice) call geo%replace_var("slmsk",NLON,NLAT,fv3mask) call geo%replace_var("tisfc",NLON,NLAT,fv3iceT) + + if (wcstart == 'cold') then ! Add_New_Var takes names of (Variable,Dim1,Dim2,Dim3,Long_Name,Units) - call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') - call geo%replace_var('glmsk',NLON,NLAT,lbcmask) + call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') + call geo%replace_var('glmsk',NLON,NLAT,lbcmask) + end if + if (wcstart == 'warm') then + call geo%replace_var("tsfc",NLON,NLAT,fv3sfcT) + call geo%replace_var("tsfcl",NLON,NLAT,fv3sfcTl) + call geo%add_new_var('glmsk','xaxis_1','yaxis_1','glmsk','none') + call geo%replace_var('glmsk',NLON,NLAT,lbcmask) + end if call geo%close write(6,*) "=== LOWBC UPDATE SUCCESS ===" diff --git a/tests/fvcom_tools/CMakeLists.txt b/tests/fvcom_tools/CMakeLists.txt new file mode 100644 index 000000000..50ac42441 --- /dev/null +++ b/tests/fvcom_tools/CMakeLists.txt @@ -0,0 +1,26 @@ +# This is the cmake build file for the tests directory of the +# UFS_UTILS project. +# +# David Wright + +if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -assume byterecl") +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-0 -fdefault-real-8") +endif() + +include_directories(${PROJECT_SOURCE_DIR}) + +# Copy necessary test files from the source data directory to the +# build data directory. +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_CURRENT_SOURCE_DIR}/data/sfcdata_unittest.nc ${CMAKE_CURRENT_BINARY_DIR}/sfcdata_unittest.nc) +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_CURRENT_SOURCE_DIR}/data/fvcom_unittest.nc ${CMAKE_CURRENT_BINARY_DIR}/fvcom_unittest.nc) +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_CURRENT_SOURCE_DIR}/LSanSuppress.supp ${CMAKE_CURRENT_BINARY_DIR}/LSanSuppress.supp) + +add_executable(ftst_readfvcomnetcdf ftst_readfvcomnetcdf.F90) +add_test(NAME fvcom_tools-ftst_readfvcomnetcdf COMMAND ftst_readfvcomnetcdf) +target_link_libraries(ftst_readfvcomnetcdf fvcom_tools_lib) + diff --git a/tests/fvcom_tools/LSanSuppress.supp b/tests/fvcom_tools/LSanSuppress.supp new file mode 100644 index 000000000..5a129f48e --- /dev/null +++ b/tests/fvcom_tools/LSanSuppress.supp @@ -0,0 +1,2 @@ +leak:ESMCI +leak:esmf diff --git a/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 new file mode 100644 index 000000000..0f8f68e2c --- /dev/null +++ b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 @@ -0,0 +1,146 @@ + program readfvcomnetcdf + +! Unit test for the fvcom_tools routines. +! +! Reads in a 5x5 user generated grid to see if +! file is read in correctly. Grid generated via +! netCDF4 python library. Expected values come +! from those used in the python generation +! script. +! +! Author David Wright + + + use module_ncio, only: ncio + use module_nwp, only: fcst_nwp + + implicit none + + integer, parameter :: NUM_VALUES=2 !number of values to check + + real, parameter :: EPSILON=0.0001 !error difference to check against + + integer :: nlat, nlon, t1, t2 + integer :: fv3lon, fv3lat, fv3times + integer :: lbclon, lbclat, lbctimes + integer :: t2_expected + logical :: fv3_exists, fvcom_exists + + integer :: lat_lon_expected_values(NUM_VALUES) !expected number of lat/lons + integer :: fv3mask_expected(NUM_VALUES) !expected fv3 mask values + integer :: fv3sst_expected(NUM_VALUES) !expected fv3 sst values + real :: fv3ice_expected(NUM_VALUES) !expected fv3 ice values + real :: fv3iceT_expected(NUM_VALUES) !expected fv3 ice temp values + integer :: lbcmask_expected(NUM_VALUES) !expected fvcom mask values + real :: lbcsst_expected(NUM_VALUES) !expected fvcom sst values + real :: lbcice_expected(NUM_VALUES) !expected fvcom ice values + real :: lbciceT_expected(NUM_VALUES) !expected fvcom ice temp values + +! Create allocabable arrays to read from .nc files + real, allocatable :: fv3ice(:,:), fv3sst(:,:) + real, allocatable :: fv3sfcT(:,:), fv3mask(:,:) + real, allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) + real, allocatable :: lbcice(:,:), lbcsst(:,:) + real, allocatable :: lbcsfcT(:,:), lbcmask(:,:) + real, allocatable :: lbciceT(:,:) + +! Expected values from the dummy files + data lat_lon_expected_values /5, 5/ + data fv3mask_expected /1, 0/ + data fv3sst_expected /1, 0/ + data fv3ice_expected /.1, 0/ + data fv3iceT_expected /.1, 0/ + data lbcmask_expected /1, 0/ + data lbcsst_expected /1, -99.99999/ + data lbcice_expected /1, -99.99999/ + data lbciceT_expected /1, -99.99999/ + data t2_expected /2 / !expect second time index from fvcom file + + type(ncio) :: geo !grid data object + type(fcst_nwp) :: fcst !object to read data into + + character(len=180) :: fv3file !fv3 file name + character(len=180) :: fvcomfile !fvcom file name + character(len=180) :: wcstart !warm or cold start + character(len=180) :: inputFVCOMselStr !time str in fvcom file + + + print*,"Starting test of fvcom_tools." +!Set default file names, cold start, and time str + fv3file = 'sfcdata_unittest.nc' + fvcomfile = 'fvcom_unittest.nc' + wcstart = 'cold' + inputFVCOMselStr = '3333-44-55T66:77:88.000000' + t1 = 1 + +!If files do not exist, stop + INQUIRE(FILE=trim(fv3file), EXIST=fv3_exists) + if(.not.fv3_exists) stop 1 + INQUIRE(FILE=trim(fvcomfile), EXIST=fvcom_exists) + if(.not.fvcom_exists) stop 2 +!Open grid file and read in number of lat/lon points + call geo%open(trim(fv3file), 'r', 200) + call geo%get_dim("xaxis_1",nlon) + call geo%get_dim("yaxis_1",nlat) + call geo%close +!If file does not have expected lat/lon points, stop + if (abs(nlon - lat_lon_expected_values(2)) > EPSILON) stop 3 + if (abs(nlat - lat_lon_expected_values(1)) > EPSILON) stop 4 + + allocate(fv3ice(nlon,nlat)) + allocate(fv3sfcT(nlon,nlat)) + allocate(fv3sst(nlon,nlat)) + allocate(fv3mask(nlon,nlat)) + allocate(fv3iceT(nlon,nlat)) + allocate(fv3sfcTl(nlon,nlat)) + + allocate(lbcice(nlon,nlat)) + allocate(lbcsfcT(nlon,nlat)) + allocate(lbcsst(nlon,nlat)) + allocate(lbcmask(nlon,nlat)) + allocate(lbciceT(nlon,nlat)) + +!Initialize and read in fv3 sfc data + call fcst%initial('FV3LAM',wcstart) + call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl) + call fcst%finish('FV3LAM',wcstart) +!If variables in fv3 sfc file do not match expected, stop + if (abs(fv3mask(1,1) - fv3mask_expected(1)) > EPSILON) stop 5 + if (abs(fv3mask(5,5) - fv3mask_expected(2)) > EPSILON) stop 6 + + if (abs(fv3sst(1,1) - fv3sst_expected(1)) > EPSILON) stop 7 + if (abs(fv3sst(5,5) - fv3sst_expected(2)) > EPSILON) stop 8 + + if (abs(fv3ice(1,1) - fv3ice_expected(1)) > EPSILON) stop 7 + if (abs(fv3ice(5,5) - fv3ice_expected(2)) > EPSILON) stop 8 + + if (abs(fv3iceT(1,1) - fv3iceT_expected(1)) > EPSILON) stop 9 + if (abs(fv3iceT(5,5) - fv3iceT_expected(2)) > EPSILON) stop 10 + +!Initialize and read in fvcom data + call fcst%initial(' FVCOM',wcstart) + call fcst%get_time_ind(trim(fvcomfile),inputFVCOMselStr,t2) +!If second time index is not returned, stop + if (abs(t2 - t2_expected) > EPSILON) stop 11 + call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl) + call fcst%finish(' FVCOM',wcstart) +!If variables in fvcom file do not match expected, stop + if (abs(lbcmask(1,1) - lbcmask_expected(1)) > EPSILON) stop 12 + if (abs(lbcmask(5,5) - lbcmask_expected(2)) > EPSILON) stop 13 + + if (abs(lbcsst(1,1) - lbcsst_expected(1)) > EPSILON) stop 14 + if (abs(lbcsst(5,5) - lbcsst_expected(2)) > EPSILON) stop 15 + + if (abs(lbcice(1,1) - lbcice_expected(1)) > EPSILON) stop 16 + if (abs(lbcice(5,5) - lbcice_expected(2)) > EPSILON) stop 17 + + if (abs(lbciceT(1,1) - lbciceT_expected(1)) > EPSILON) stop 18 + if (abs(lbciceT(5,5) - lbciceT_expected(2)) > EPSILON) stop 19 + + + print*,"OK" + + print*,"SUCCESS!" + + end program readfvcomnetcdf + From f30740edc06c5a815722f67838ea6af1e515fb45 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 5 Nov 2021 16:49:11 -0400 Subject: [PATCH 011/109] Update more documentation after move to ufs-community (#597) Fixes #593. --- sorc/chgres_cube.fd/docs/user_guide.md | 4 +- sorc/emcsfc_ice_blend.fd/docs/user_guide.md | 8 +- sorc/emcsfc_snow2mdl.fd/docs/user_guide.md | 6 +- sorc/fvcom_tools.fd/docs/user_guide.md | 84 ++++++++++--------- sorc/gblevents.fd/docs/user_guide.md | 8 +- sorc/global_cycle.fd/docs/user_guide.md | 4 +- sorc/grid_tools.fd/docs/user_guide.md | 7 +- sorc/lsm_routines.fd/docs/user_guide.md | 4 +- .../noah.fd/docs/user_guide.md | 4 +- sorc/orog_mask_tools.fd/docs/user_guide.md | 6 +- sorc/sfc_climo_gen.fd/docs/user_guide.md | 6 +- sorc/vcoord_gen.fd/docs/user_guide.md | 6 +- 12 files changed, 68 insertions(+), 79 deletions(-) diff --git a/sorc/chgres_cube.fd/docs/user_guide.md b/sorc/chgres_cube.fd/docs/user_guide.md index d2cb6f290..6b2be5019 100644 --- a/sorc/chgres_cube.fd/docs/user_guide.md +++ b/sorc/chgres_cube.fd/docs/user_guide.md @@ -11,8 +11,8 @@ Common Data Form (NetCDF) data. This document is part of the UFS_UTILS documentation. -The chgres_cube program is part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. +The chgres_cube program is part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. ## Where to find GFS GRIB2, NEMSIO and NetCDF data diff --git a/sorc/emcsfc_ice_blend.fd/docs/user_guide.md b/sorc/emcsfc_ice_blend.fd/docs/user_guide.md index b09aaa049..b8d53252e 100644 --- a/sorc/emcsfc_ice_blend.fd/docs/user_guide.md +++ b/sorc/emcsfc_ice_blend.fd/docs/user_guide.md @@ -10,9 +10,5 @@ analysis used to update the GFS once per day. This document is part of the UFS_UTILS documentation. -The emcsfc_ice_blend program is part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - - - +The emcsfc_ice_blend program is part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/emcsfc_snow2mdl.fd/docs/user_guide.md b/sorc/emcsfc_snow2mdl.fd/docs/user_guide.md index a680c4004..ef109c64f 100644 --- a/sorc/emcsfc_snow2mdl.fd/docs/user_guide.md +++ b/sorc/emcsfc_snow2mdl.fd/docs/user_guide.md @@ -10,7 +10,5 @@ analysis used to update the GFS snow field once per day. This document is part of the UFS_UTILS documentation. -The emcsfc_snow2mdl program is part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - +The emcsfc_snow2mdl program is part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/fvcom_tools.fd/docs/user_guide.md b/sorc/fvcom_tools.fd/docs/user_guide.md index e0dd50c53..f24124ade 100644 --- a/sorc/fvcom_tools.fd/docs/user_guide.md +++ b/sorc/fvcom_tools.fd/docs/user_guide.md @@ -1,48 +1,56 @@ -@brief replaces lake surface and lake ice temperature @anchor user_guide - -**fvcom_to_FV3.exe** - -**Introduction:** - This code replaces lake surface and lake ice temperature along - with aerial ice concentration generated from Great Lakes - Operational Forecast System (GLOFS), an FVCOM-based model, into - sfc_data.nc. - **NOTE** that the variables in the input files must reside on - the same grid. This means data from FVCOM must be horizontally - interpolated to the FV3 grid. This routine will also force a - minimum ice concentration of 15%. If ice concentration is less - than 15% in FVCOM, it will be set to 0% to avoid FV3 from - changing values less than 15% to 15% and generating unrealistic - lake ice temperatures. - -**Library Dependencies:** - Installation depends on the netCDF library and cmake. - -**Running:** - This routine will take four variables from the command line: - 1. Name of FV3 sfc data file (e.g. sfc_data.tile7.halo0.nc) +# fvcom_tools + +# Introduction + +This code replaces lake surface and lake ice temperature along +with aerial ice concentration generated from Great Lakes +Operational Forecast System (GLOFS), an FVCOM-based model, into +sfc_data.nc. + +This document is part of the UFS_UTILS +documentation. + +The fvcom_tools program is part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. + +## NOTE + +The variables in the input files must reside on +the same grid. This means data from FVCOM must be horizontally +interpolated to the FV3 grid. This routine will also force a +minimum ice concentration of 15%. If ice concentration is less +than 15% in FVCOM, it will be set to 0% to avoid FV3 from +changing values less than 15% to 15% and generating unrealistic +lake ice temperatures. + +## Library Dependencies: + +Installation depends on the netCDF library and cmake. + +## Running + +This routine will take four variables from the command line: +1. Name of FV3 sfc data file (e.g. sfc_data.tile7.halo0.nc) which is generated from chgres_cube.exe. - 2. Name of FVCOM data file in netcdf format (e.g. fvcom.nc) - 3. "warm" or "cold" start. "warm" start will read in +2. Name of FVCOM data file in netcdf format (e.g. fvcom.nc) +3. "warm" or "cold" start. "warm" start will read in sfc_data.nc files generated from a restart of UFS-SRW. "cold" start will read in sfc_data.nc files generated from chgres_cube. - 4. String of time slice to use in the fvcom.nc file. This string +4. String of time slice to use in the fvcom.nc file. This string should match exactly what is in the Times variable of the .nc file. - To run the script, use the following example, modifying file - names as needed: +To run the script, use the following example, modifying file +names as needed: ./fvcom_to_FV3 sfc_data.tile7.halo0.nc fvcom.nc cold \ 2020-01-31T18:00:00.000000 - Output will be to the sfc data file and include lake surface - and lake ice temperature, and lake ice concentration from the - first time in the FVCOM file. - +Output will be to the sfc data file and include lake surface +and lake ice temperature, and lake ice concentration from the +first time in the FVCOM file. This routine is *strongly* based upon Eric James' (ESRL/GSL) work - to update HRRR/WRF Great Lakes' temperature data with FVCOM. - It also relies heavily on Ming Hu's (ESRL/GSL) ncio module. +to update HRRR/WRF Great Lakes' temperature data with FVCOM. +It also relies heavily on Ming Hu's (ESRL/GSL) ncio module. + +## For more information, please contact: -**For more information, please contact:** - David Wright - University of Michigan and GLERL - dmwright@umich.edu +David Wright, University of Michigan and GLERL: dmwright@umich.edu diff --git a/sorc/gblevents.fd/docs/user_guide.md b/sorc/gblevents.fd/docs/user_guide.md index bd2ac1b93..2de2c6d90 100644 --- a/sorc/gblevents.fd/docs/user_guide.md +++ b/sorc/gblevents.fd/docs/user_guide.md @@ -8,9 +8,5 @@ The gblevents program performs pre and post processing of prepbufr events. This document is part of the UFS_UTILS documentation. -The gblevents program is part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - - - +The gblevents program is part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/global_cycle.fd/docs/user_guide.md b/sorc/global_cycle.fd/docs/user_guide.md index cfd05706b..2df4f8cdc 100644 --- a/sorc/global_cycle.fd/docs/user_guide.md +++ b/sorc/global_cycle.fd/docs/user_guide.md @@ -11,5 +11,5 @@ the GFS and GDAS cycles. This document is part of the UFS_UTILS documentation. -The global_cycle program is part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. +The global_cycle program is part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/grid_tools.fd/docs/user_guide.md b/sorc/grid_tools.fd/docs/user_guide.md index cef921ba5..2acf0c492 100644 --- a/sorc/grid_tools.fd/docs/user_guide.md +++ b/sorc/grid_tools.fd/docs/user_guide.md @@ -14,8 +14,5 @@ The grid_tools include: This document is part of the UFS_UTILS documentation. -The grid_tools programs are part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - - +The grid_tools programs are part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/lsm_routines.fd/docs/user_guide.md b/sorc/lsm_routines.fd/docs/user_guide.md index 94e301939..5829de1a2 100644 --- a/sorc/lsm_routines.fd/docs/user_guide.md +++ b/sorc/lsm_routines.fd/docs/user_guide.md @@ -13,5 +13,5 @@ The land models included are: - Noah - routines for the Noah land surface model. -The lsm_routines libraries are used in the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. +The lsm_routines libraries are used in the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/lsm_routines.fd/noah.fd/docs/user_guide.md b/sorc/lsm_routines.fd/noah.fd/docs/user_guide.md index 18c4936c9..2937b6fe5 100644 --- a/sorc/lsm_routines.fd/noah.fd/docs/user_guide.md +++ b/sorc/lsm_routines.fd/noah.fd/docs/user_guide.md @@ -21,5 +21,5 @@ This document is part of the UFS_UTILS documentation.lsm_routines directory. -The NOAH library created here is used in the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. +The NOAH library created here is used in the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/orog_mask_tools.fd/docs/user_guide.md b/sorc/orog_mask_tools.fd/docs/user_guide.md index 285dde897..3f085055c 100644 --- a/sorc/orog_mask_tools.fd/docs/user_guide.md +++ b/sorc/orog_mask_tools.fd/docs/user_guide.md @@ -11,7 +11,5 @@ The orog_mask_tools include: This document is part of the UFS_UTILS documentation. -The orog_mask_tools programs are part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - +The orog_mask_tools programs are part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/sfc_climo_gen.fd/docs/user_guide.md b/sorc/sfc_climo_gen.fd/docs/user_guide.md index e7fae3a5c..aa9c6a80a 100644 --- a/sorc/sfc_climo_gen.fd/docs/user_guide.md +++ b/sorc/sfc_climo_gen.fd/docs/user_guide.md @@ -9,7 +9,5 @@ fields, such as vegetation type and albedo, for an FV3 grid. This document is part of the UFS_UTILS documentation. -The orog_mask_tools programs are part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - +The orog_mask_tools programs are part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. diff --git a/sorc/vcoord_gen.fd/docs/user_guide.md b/sorc/vcoord_gen.fd/docs/user_guide.md index cb689eb25..0c8a01306 100644 --- a/sorc/vcoord_gen.fd/docs/user_guide.md +++ b/sorc/vcoord_gen.fd/docs/user_guide.md @@ -11,7 +11,5 @@ by the forecast model to define the hybrid levels. This document is part of the UFS_UTILS documentation. -The vcoord_gen programs are part of the [NCEPLIBS -UFS_UTILS](https://github.com/NOAA-EMC/UFS_UTILS) project. - - +The vcoord_gen programs are part of the +[UFS_UTILS](https://github.com/ufs-community/UFS_UTILS) project. From fd3fb6ceb9c82bbb30fa8c98027b8ebbce4c3a7a Mon Sep 17 00:00:00 2001 From: JeffBeck-NOAA <55201531+JeffBeck-NOAA@users.noreply.github.com> Date: Wed, 8 Dec 2021 09:06:58 -0700 Subject: [PATCH 012/109] Run consistency tests on Jet using role account. (#607) Move the input and baseline consistency test data under a directory owned by the role account. Update the Jet consistency test driver scripts to point to this new directory. Part of #600 --- reg_tests/chgres_cube/driver.jet.sh | 2 +- reg_tests/global_cycle/driver.jet.sh | 2 +- reg_tests/grid_gen/driver.jet.sh | 2 +- reg_tests/ice_blend/driver.jet.sh | 2 +- reg_tests/rt.sh | 2 +- reg_tests/snow2mdl/driver.jet.sh | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/reg_tests/chgres_cube/driver.jet.sh b/reg_tests/chgres_cube/driver.jet.sh index 155bb6660..f1eb2e1a4 100755 --- a/reg_tests/chgres_cube/driver.jet.sh +++ b/reg_tests/chgres_cube/driver.jet.sh @@ -47,7 +47,7 @@ export HDF5_DISABLE_VERSION_CHECK=2 export HOMEufs=$PWD/../.. -export HOMEreg=/lfs4/HFIP/emcda/George.Gayno/reg_tests/chgres_cube +export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/chgres_cube LOG_FILE=consistency.log SUM_FILE=summary.log diff --git a/reg_tests/global_cycle/driver.jet.sh b/reg_tests/global_cycle/driver.jet.sh index f5f488415..0d2a1dd7c 100755 --- a/reg_tests/global_cycle/driver.jet.sh +++ b/reg_tests/global_cycle/driver.jet.sh @@ -36,7 +36,7 @@ QUEUE="${QUEUE:-batch}" export DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" -export HOMEreg=/lfs4/HFIP/emcda/George.Gayno/reg_tests/global_cycle +export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/global_cycle export OMP_NUM_THREADS_CY=2 diff --git a/reg_tests/grid_gen/driver.jet.sh b/reg_tests/grid_gen/driver.jet.sh index 3674f0c2f..38033430a 100755 --- a/reg_tests/grid_gen/driver.jet.sh +++ b/reg_tests/grid_gen/driver.jet.sh @@ -44,7 +44,7 @@ export APRUN=time export APRUN_SFC=srun export OMP_STACKSIZE=2048m export machine=JET -export HOMEreg=/lfs4/HFIP/emcda/George.Gayno/reg_tests/grid_gen/baseline_data +export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/grid_gen/baseline_data ulimit -a ulimit -s unlimited diff --git a/reg_tests/ice_blend/driver.jet.sh b/reg_tests/ice_blend/driver.jet.sh index f11191bfb..cbdf11682 100755 --- a/reg_tests/ice_blend/driver.jet.sh +++ b/reg_tests/ice_blend/driver.jet.sh @@ -46,7 +46,7 @@ export COPYGB=/lfs4/HFIP/emcda/George.Gayno/ufs_utils.git/jet_port/grib_util/cop export COPYGB2=/lfs4/HFIP/emcda/George.Gayno/ufs_utils.git/jet_port/grib_util/copygb2 export CNVGRIB=/apps/cnvgrib/1.4.0/bin/cnvgrib -export HOMEreg=/lfs4/HFIP/emcda/George.Gayno/reg_tests/ice_blend +export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/ice_blend export HOMEgfs=$PWD/../.. rm -fr $DATA diff --git a/reg_tests/rt.sh b/reg_tests/rt.sh index 9630f178d..dd25f276a 100755 --- a/reg_tests/rt.sh +++ b/reg_tests/rt.sh @@ -16,7 +16,7 @@ cd ${WORK_DIR} rm -f reg_test_results.txt rm -rf UFS_UTILS -git clone --recursive https://github.com/NOAA-EMC/UFS_UTILS.git +git clone --recursive https://github.com/ufs-community/UFS_UTILS.git cd UFS_UTILS source sorc/machine-setup.sh diff --git a/reg_tests/snow2mdl/driver.jet.sh b/reg_tests/snow2mdl/driver.jet.sh index 2b8345b97..6da755ff9 100755 --- a/reg_tests/snow2mdl/driver.jet.sh +++ b/reg_tests/snow2mdl/driver.jet.sh @@ -40,7 +40,7 @@ export DATA="${DATA}/reg-tests/snow2mdl" # Should not have to change anything below. #----------------------------------------------------------------------------- -export HOMEreg=/lfs4/HFIP/emcda/George.Gayno/reg_tests/snow2mdl +export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/apps/wgrib/1.8.1.0b/bin/wgrib export WGRIB2=/apps/wgrib2/0.1.9.6a/bin/wgrib2 From d22be2239cbf677fef987d27ea3d106241e5aacd Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Wed, 8 Dec 2021 14:27:15 -0500 Subject: [PATCH 013/109] Run consistency tests on Hera using role account (#605) Move the input and baseline consistency test data under a directory owned by the Hera role account. Update the Hera consistency test driver scripts to point to this new directory. Part of #600. --- reg_tests/chgres_cube/driver.hera.sh | 2 +- reg_tests/global_cycle/driver.hera.sh | 2 +- reg_tests/grid_gen/driver.hera.sh | 2 +- reg_tests/ice_blend/driver.hera.sh | 2 +- reg_tests/snow2mdl/driver.hera.sh | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/reg_tests/chgres_cube/driver.hera.sh b/reg_tests/chgres_cube/driver.hera.sh index f68e2726b..dd911d241 100755 --- a/reg_tests/chgres_cube/driver.hera.sh +++ b/reg_tests/chgres_cube/driver.hera.sh @@ -46,7 +46,7 @@ QUEUE="${QUEUE:-batch}" export HOMEufs=$PWD/../.. -export HOMEreg=/scratch1/NCEPDEV/da/George.Gayno/noscrub/reg_tests/chgres_cube +export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/chgres_cube LOG_FILE=consistency.log SUM_FILE=summary.log diff --git a/reg_tests/global_cycle/driver.hera.sh b/reg_tests/global_cycle/driver.hera.sh index a7058347a..a781020d0 100755 --- a/reg_tests/global_cycle/driver.hera.sh +++ b/reg_tests/global_cycle/driver.hera.sh @@ -38,7 +38,7 @@ QUEUE="${QUEUE:-batch}" DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" -export HOMEreg=/scratch1/NCEPDEV/da/George.Gayno/noscrub/reg_tests/global_cycle +export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/global_cycle export OMP_NUM_THREADS_CY=2 diff --git a/reg_tests/grid_gen/driver.hera.sh b/reg_tests/grid_gen/driver.hera.sh index 11ebb7c76..b8de3f8d2 100755 --- a/reg_tests/grid_gen/driver.hera.sh +++ b/reg_tests/grid_gen/driver.hera.sh @@ -46,7 +46,7 @@ export APRUN=time export APRUN_SFC=srun export OMP_STACKSIZE=2048m export machine=HERA -export HOMEreg=/scratch1/NCEPDEV/da/George.Gayno/noscrub/reg_tests/grid_gen/baseline_data +export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/grid_gen/baseline_data ulimit -a #ulimit -s unlimited diff --git a/reg_tests/ice_blend/driver.hera.sh b/reg_tests/ice_blend/driver.hera.sh index 3b7d9c4da..3ce993fe4 100755 --- a/reg_tests/ice_blend/driver.hera.sh +++ b/reg_tests/ice_blend/driver.hera.sh @@ -49,7 +49,7 @@ export COPYGB=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/copy export COPYGB2=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/copygb2 export CNVGRIB=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/cnvgrib -export HOMEreg=/scratch1/NCEPDEV/da/George.Gayno/noscrub/reg_tests/ice_blend +export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/ice_blend export HOMEgfs=$PWD/../.. rm -fr $DATA diff --git a/reg_tests/snow2mdl/driver.hera.sh b/reg_tests/snow2mdl/driver.hera.sh index 9885f0ac9..d83b501e0 100755 --- a/reg_tests/snow2mdl/driver.hera.sh +++ b/reg_tests/snow2mdl/driver.hera.sh @@ -45,7 +45,7 @@ export DATA="${DATA}/reg-tests/snow2mdl" rm -fr $DATA -export HOMEreg=/scratch1/NCEPDEV/da/George.Gayno/noscrub/reg_tests/snow2mdl +export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/wgrib export WGRIB2=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/wgrib2 From 3705dab08f24b9c50e0ac0ea3bdc8191ae860f95 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Thu, 9 Dec 2021 08:31:03 -0500 Subject: [PATCH 014/109] Run consistency tests on Orion using role account (#606) Move the input and baseline consistency test data under a directory owned by the Orion role account. Update the Orion consistency test driver scripts to point to this new directory. Part of #600. --- reg_tests/chgres_cube/driver.orion.sh | 2 +- reg_tests/global_cycle/driver.orion.sh | 2 +- reg_tests/grid_gen/driver.orion.sh | 2 +- reg_tests/ice_blend/driver.orion.sh | 2 +- reg_tests/snow2mdl/driver.orion.sh | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/reg_tests/chgres_cube/driver.orion.sh b/reg_tests/chgres_cube/driver.orion.sh index 0c2b72c4a..e416f5964 100755 --- a/reg_tests/chgres_cube/driver.orion.sh +++ b/reg_tests/chgres_cube/driver.orion.sh @@ -46,7 +46,7 @@ QUEUE="${QUEUE:-batch}" export HOMEufs=$PWD/../.. -export HOMEreg=/work/noaa/da/ggayno/save/ufs_utils.git/reg_tests/chgres_cube +export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/chgres_cube LOG_FILE=consistency.log SUM_FILE=summary.log diff --git a/reg_tests/global_cycle/driver.orion.sh b/reg_tests/global_cycle/driver.orion.sh index 27d138c8d..bf4164e43 100755 --- a/reg_tests/global_cycle/driver.orion.sh +++ b/reg_tests/global_cycle/driver.orion.sh @@ -36,7 +36,7 @@ QUEUE="${QUEUE:-batch}" export DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" -export HOMEreg=/work/noaa/da/ggayno/save/ufs_utils.git/reg_tests/global_cycle +export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/global_cycle export OMP_NUM_THREADS_CY=2 diff --git a/reg_tests/grid_gen/driver.orion.sh b/reg_tests/grid_gen/driver.orion.sh index f5902cf15..ba48afe21 100755 --- a/reg_tests/grid_gen/driver.orion.sh +++ b/reg_tests/grid_gen/driver.orion.sh @@ -46,7 +46,7 @@ export APRUN_SFC=srun export OMP_STACKSIZE=2048m export OMP_NUM_THREADS=24 export machine=ORION -export HOMEreg=/work/noaa/da/ggayno/save/ufs_utils.git/reg_tests/grid_gen/baseline_data +export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/grid_gen/baseline_data rm -fr $WORK_DIR diff --git a/reg_tests/ice_blend/driver.orion.sh b/reg_tests/ice_blend/driver.orion.sh index 73d917ea2..9f63483ba 100755 --- a/reg_tests/ice_blend/driver.orion.sh +++ b/reg_tests/ice_blend/driver.orion.sh @@ -49,7 +49,7 @@ export COPYGB=/apps/contrib/NCEPLIBS/lib/NCEPLIBS-grib_util/v1.1.1/exec/copygb export COPYGB2=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/copygb2 export CNVGRIB=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/cnvgrib -export HOMEreg=/work/noaa/da/ggayno/save/ufs_utils.git/reg_tests/ice_blend +export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/ice_blend export HOMEgfs=$PWD/../.. rm -fr $DATA diff --git a/reg_tests/snow2mdl/driver.orion.sh b/reg_tests/snow2mdl/driver.orion.sh index e4c707eaa..8ca5ed51b 100755 --- a/reg_tests/snow2mdl/driver.orion.sh +++ b/reg_tests/snow2mdl/driver.orion.sh @@ -45,7 +45,7 @@ export DATA="${DATA}/reg-tests/snow2mdl" rm -fr $DATA -export HOMEreg=/work/noaa/da/ggayno/save/ufs_utils.git/reg_tests/snow2mdl +export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/wgrib export WGRIB2=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/wgrib2 From beca8088ea6dceedf864619cdd3870eabeea9c52 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Thu, 9 Dec 2021 13:58:28 -0500 Subject: [PATCH 015/109] Use copy of grib_util under Jet role account. (#608) Compile a copy of grib_util under the Jet role account (the hpc-stack version of grib_util does not work). Previously, a local copy under my directory was being used. Update the ice_blend regression test script accordingly. Part of #600. --- reg_tests/ice_blend/driver.jet.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/reg_tests/ice_blend/driver.jet.sh b/reg_tests/ice_blend/driver.jet.sh index cbdf11682..417385dc1 100755 --- a/reg_tests/ice_blend/driver.jet.sh +++ b/reg_tests/ice_blend/driver.jet.sh @@ -42,8 +42,8 @@ export DATA="${DATA}/reg-tests/ice-blend" export WGRIB=/apps/wgrib/1.8.1.0b/bin/wgrib export WGRIB2=/apps/wgrib2/0.1.9.6a/bin/wgrib2 -export COPYGB=/lfs4/HFIP/emcda/George.Gayno/ufs_utils.git/jet_port/grib_util/copygb -export COPYGB2=/lfs4/HFIP/emcda/George.Gayno/ufs_utils.git/jet_port/grib_util/copygb2 +export COPYGB=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/grib_util/NCEPLIBS-grib_util/exec/bin/copygb +export COPYGB2=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/grib_util/NCEPLIBS-grib_util/exec/bin/copygb2 export CNVGRIB=/apps/cnvgrib/1.4.0/bin/cnvgrib export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/ice_blend From 2a08859a1a591e3e8297042710bd1a9bf522b6a3 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 10 Dec 2021 15:10:43 -0500 Subject: [PATCH 016/109] Update the requested memory in the Orion chgres_cube consistency test script (#611) Done to prevent 'bus' errors, which are due to lack of memory. Fixes #609. --- reg_tests/chgres_cube/driver.orion.sh | 32 +++++++++++++-------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/reg_tests/chgres_cube/driver.orion.sh b/reg_tests/chgres_cube/driver.orion.sh index e416f5964..53da13cfc 100755 --- a/reg_tests/chgres_cube/driver.orion.sh +++ b/reg_tests/chgres_cube/driver.orion.sh @@ -68,7 +68,7 @@ rm -fr $OUTDIR LOG_FILE1=${LOG_FILE}01 export OMP_NUM_THREADS=1 # needs to match cpus-per-task -TEST1=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.restart \ +TEST1=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 --mem=75G -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.restart \ -o $LOG_FILE1 -e $LOG_FILE1 ./c96.fv3.restart.sh) #----------------------------------------------------------------------------- @@ -77,7 +77,7 @@ TEST1=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_C LOG_FILE2=${LOG_FILE}02 export OMP_NUM_THREADS=1 # needs to match cpus-per-task -TEST2=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c192.fv3.history \ +TEST2=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 --mem=75G -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c192.fv3.history \ --open-mode=append -o $LOG_FILE2 -e $LOG_FILE2 ./c192.fv3.history.sh) #----------------------------------------------------------------------------- @@ -86,7 +86,7 @@ TEST2=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_C LOG_FILE3=${LOG_FILE}03 export OMP_NUM_THREADS=1 # needs to match cpus-per-task -TEST3=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.nemsio \ +TEST3=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 --mem=75G -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.nemsio \ --open-mode=append -o $LOG_FILE3 -e $LOG_FILE3 ./c96.fv3.nemsio.sh) #----------------------------------------------------------------------------- @@ -95,7 +95,7 @@ TEST3=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_C LOG_FILE4=${LOG_FILE}04 export OMP_NUM_THREADS=6 # needs to match cpus-per-task -TEST4=$(sbatch --parsable --ntasks-per-node=3 --cpus-per-task=6 --nodes=2 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.gfs.sigio \ +TEST4=$(sbatch --parsable --ntasks-per-node=3 --cpus-per-task=6 --nodes=2 --mem=50G -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.gfs.sigio \ --open-mode=append -o $LOG_FILE4 -e $LOG_FILE4 ./c96.gfs.sigio.sh) #----------------------------------------------------------------------------- @@ -104,7 +104,7 @@ TEST4=$(sbatch --parsable --ntasks-per-node=3 --cpus-per-task=6 --nodes=2 -t 0:1 LOG_FILE5=${LOG_FILE}05 export OMP_NUM_THREADS=1 # needs to match cpus-per-task -TEST5=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.gfs.nemsio \ +TEST5=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 --mem=75G -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.gfs.nemsio \ --open-mode=append -o $LOG_FILE5 -e $LOG_FILE5 ./c96.gfs.nemsio.sh) #----------------------------------------------------------------------------- @@ -113,7 +113,7 @@ TEST5=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_C LOG_FILE6=${LOG_FILE}06 export OMP_NUM_THREADS=1 # needs to match cpus-per-task -TEST6=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.regional \ +TEST6=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 --mem=75G -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.regional \ --open-mode=append -o $LOG_FILE6 -e $LOG_FILE6 ./c96.regional.sh) #----------------------------------------------------------------------------- @@ -122,7 +122,7 @@ TEST6=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_C LOG_FILE7=${LOG_FILE}07 export OMP_NUM_THREADS=1 # needs to match cpus-per-task -TEST7=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J c192.gfs.grib2 \ +TEST7=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 --mem=75G -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J c192.gfs.grib2 \ --open-mode=append -o $LOG_FILE7 -e $LOG_FILE7 ./c192.gfs.grib2.sh) #----------------------------------------------------------------------------- @@ -131,7 +131,7 @@ TEST7=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_C LOG_FILE8=${LOG_FILE}08 export OMP_NUM_THREADS=1 # needs to match cpus-per-task -TEST8=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.netcdf \ +TEST8=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.netcdf \ --open-mode=append -o $LOG_FILE8 -e $LOG_FILE8 ./c96.fv3.netcdf.sh) #----------------------------------------------------------------------------- @@ -140,7 +140,7 @@ TEST8=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 -t 0:10:00 -A $PROJECT_C LOG_FILE9=${LOG_FILE}09 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST9=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.netcdf2wam \ +TEST9=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 --mem=100G -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.netcdf2wam \ --open-mode=append -o $LOG_FILE9 -e $LOG_FILE9 ./c96.fv3.netcdf2wam.sh) #----------------------------------------------------------------------------- @@ -149,7 +149,7 @@ TEST9=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:15:00 -A $PROJECT_ LOG_FILE10=${LOG_FILE}10 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST10=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 25km.conus.gfs.grib2 \ +TEST10=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 25km.conus.gfs.grib2 \ --open-mode=append -o $LOG_FILE10 -e $LOG_FILE10 ./25km.conus.gfs.grib2.sh) #----------------------------------------------------------------------------- @@ -158,7 +158,7 @@ TEST10=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT LOG_FILE11=${LOG_FILE}11 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST11=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 3km.conus.hrrr.gfssdf.grib2 \ +TEST11=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 3km.conus.hrrr.gfssdf.grib2 \ --open-mode=append -o $LOG_FILE11 -e $LOG_FILE11 ./3km.conus.hrrr.gfssdf.grib2.sh) #----------------------------------------------------------------------------- @@ -167,7 +167,7 @@ TEST11=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:10:00 -A $PROJECT_ LOG_FILE12=${LOG_FILE}12 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST12=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 3km.conus.hrrr.newsfc.grib2 \ +TEST12=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 3km.conus.hrrr.newsfc.grib2 \ --open-mode=append -o $LOG_FILE12 -e $LOG_FILE12 ./3km.conus.hrrr.newsfc.grib2.sh) #----------------------------------------------------------------------------- @@ -176,7 +176,7 @@ TEST12=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 -t 0:10:00 -A $PROJECT_ LOG_FILE13=${LOG_FILE}13 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST13=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 13km.conus.nam.grib2 \ +TEST13=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 13km.conus.nam.grib2 \ --open-mode=append -o $LOG_FILE13 -e $LOG_FILE13 ./13km.conus.nam.grib2.sh) #----------------------------------------------------------------------------- @@ -185,7 +185,7 @@ TEST13=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT LOG_FILE14=${LOG_FILE}14 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST14=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 13km.conus.rap.grib2 \ +TEST14=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 13km.conus.rap.grib2 \ --open-mode=append -o $LOG_FILE14 -e $LOG_FILE14 ./13km.conus.rap.grib2.sh) #----------------------------------------------------------------------------- @@ -194,7 +194,7 @@ TEST14=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT LOG_FILE15=${LOG_FILE}15 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST15=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 13km.na.gfs.ncei.grib2 \ +TEST15=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 13km.na.gfs.ncei.grib2 \ --open-mode=append -o $LOG_FILE15 -e $LOG_FILE15 ./13km.na.gfs.ncei.grib2.sh) #----------------------------------------------------------------------------- @@ -203,7 +203,7 @@ TEST15=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT LOG_FILE16=${LOG_FILE}16 export OMP_NUM_THREADS=1 # should match cpus-per-task -TEST16=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 25km.conus.gfs.pbgrib2 \ +TEST16=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 --mem=75G -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 25km.conus.gfs.pbgrib2 \ --open-mode=append -o $LOG_FILE16 -e $LOG_FILE16 ./25km.conus.gfs.pbgrib2.sh) #----------------------------------------------------------------------------- From f41d894e13053c535b2caa0f5e819d315806ffeb Mon Sep 17 00:00:00 2001 From: David Wright Date: Wed, 15 Dec 2021 15:09:52 -0500 Subject: [PATCH 017/109] Allow FVCOM tools to Update Ice Surface Roughness Length (#604) * Update zorl for ice points in surface data file * Change warm start ice roughness length variable name to zorli * Change warm/cold start surface roughness var names in output nc file * Include ice thickness processing * Change ice roughness length from 1.0 to 1.1 * Zorli set to Fill_Value when ice is removed Co-authored-by: JeffBeck-NOAA <55201531+JeffBeck-NOAA@users.noreply.github.com> --- sorc/fvcom_tools.fd/module_nwp.f90 | 61 ++++++++++++++++++++++++--- sorc/fvcom_tools.fd/process_FVCOM.f90 | 30 ++++++++++--- 2 files changed, 78 insertions(+), 13 deletions(-) diff --git a/sorc/fvcom_tools.fd/module_nwp.f90 b/sorc/fvcom_tools.fd/module_nwp.f90 index a4894b6c0..d0b7b2376 100644 --- a/sorc/fvcom_tools.fd/module_nwp.f90 +++ b/sorc/fvcom_tools.fd/module_nwp.f90 @@ -38,6 +38,8 @@ module module_nwp integer :: i_sfcT !< Index of sst temp var. integer :: i_iceT !< Index of ice temp var. integer :: i_sfcTl !< Index of sfcTl + integer :: i_zorl !< Index of surface roughness + integer :: i_hice !< Index of ice thickness character(len=20), allocatable :: varnames(:) !< Variable names. character(len=20), allocatable :: latname !< Latitude name. character(len=20), allocatable :: lonname !< Longitude name. @@ -52,6 +54,8 @@ module module_nwp real(r_kind), allocatable :: nwp_ice_c(:,:,:) !< cold start over water ice concentration 3d array real(r_kind), allocatable :: nwp_sfct_c(:,:,:) !< cold start skin temperature 3d array real(r_kind), allocatable :: nwp_icet_c(:,:,:) !< cold start ice skin temperature 3d array + real(r_kind), allocatable :: nwp_zorl_c(:,:,:) !< cold start surface roughness + real(r_kind), allocatable :: nwp_hice_c(:,:,:) !< cold start ice thickness real(r_kind), allocatable :: nwp_mask_w(:,:) !< warm start land/water mask 3d array real(r_kind), allocatable :: nwp_sst_w(:,:) !< warm start sst 3d array @@ -59,6 +63,8 @@ module module_nwp real(r_kind), allocatable :: nwp_sfct_w(:,:) !< warm start skin temperature 3d array real(r_kind), allocatable :: nwp_icet_w(:,:) !< warm start ice skin temperature 3d array real(r_kind), allocatable :: nwp_sfctl_w(:,:) !< warm start skin temperature 3d array + real(r_kind), allocatable :: nwp_zorl_w(:,:) !< warm start surface roughness + real(r_kind), allocatable :: nwp_hice_w(:,:) !< warm start ice thickness end type nwp_type @@ -99,19 +105,22 @@ subroutine initial_nwp(this,itype,wcstart) ! FVCOM grid if (itype==' FVCOM') then this%datatype = itype - this%numvar = 4 + this%numvar = 5 this%i_mask = 1 this%i_sst = 2 this%i_ice = 3 this%i_iceT = 4 + this%i_hice = 5 this%i_sfcT = 0 + this%i_zorl = 0 allocate(this%varnames(this%numvar)) this%varnames(1) = 'glmask' this%varnames(2) = 'tsfc' this%varnames(3) = 'aice' this%varnames(4) = 'tisfc' + this%varnames(5) = 'vice' allocate(this%latname) allocate(this%lonname) @@ -131,7 +140,7 @@ subroutine initial_nwp(this,itype,wcstart) else if (trim(itype)=='FV3LAM' .AND. wcstart=='warm') then this%datatype = itype - this%numvar = 6 + this%numvar = 8 this%i_mask = 1 this%i_sst = 2 @@ -139,6 +148,8 @@ subroutine initial_nwp(this,itype,wcstart) this%i_iceT = 4 this%i_sfcT = 5 this%i_sfcTl= 6 + this%i_zorl = 7 + this%i_hice = 8 allocate(this%varnames(this%numvar)) this%varnames(1) = 'slmsk' @@ -147,6 +158,8 @@ subroutine initial_nwp(this,itype,wcstart) this%varnames(4) = 'tisfc' this%varnames(5) = 'tsfc' this%varnames(6) = 'tsfcl' + this%varnames(7) = 'zorli' + this%varnames(8) = 'hice' allocate(this%latname) allocate(this%lonname) @@ -162,12 +175,14 @@ subroutine initial_nwp(this,itype,wcstart) else if (trim(itype)=='FV3LAM' .AND. wcstart=='cold') then this%datatype = itype - this%numvar = 4 + this%numvar = 6 this%i_mask = 1 this%i_sst = 2 this%i_ice = 3 this%i_iceT = 4 + this%i_zorl = 5 + this%i_hice = 6 this%i_sfcT = 0 allocate(this%varnames(this%numvar)) @@ -175,6 +190,8 @@ subroutine initial_nwp(this,itype,wcstart) this%varnames(2) = 'tsea' this%varnames(3) = 'fice' this%varnames(4) = 'tisfc' + this%varnames(5) = 'zorl' + this%varnames(6) = 'hice' allocate(this%latname) allocate(this%lonname) @@ -246,9 +263,11 @@ end subroutine list_initial_nwp !! @param[inout] sfcT Skin Temperature !! @param[inout] iceT Ice Skin Temperature !! @param[inout] sfcTl Skin Temperature in restart file + !! @param[inout] zorl Surface roughness length + !! @param[inout] hice Ice thickness !! !! @author David Wright, University of Michigan and GLERL - subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl) + subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl,zorl,hice) class(fcst_nwp) :: this @@ -260,7 +279,7 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g integer, intent(inout) :: numlon, numlat, numtimes ! real(r_single), intent(inout) :: mask(:,:), sst(:,:), ice(:,:), sfcT(:,:) real(r_kind), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) & - ,iceT(:,:),sfcTl(:,:) + ,iceT(:,:),sfcTl(:,:),zorl(:,:),hice(:,:) ! Open the file using module_ncio.f90 code, and find the number of ! lat/lon points @@ -284,6 +303,8 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g allocate(this%nwp_ice_c(this%xlon,this%xlat,this%xtime)) allocate(this%nwp_sfcT_c(this%xlon,this%xlat,this%xtime)) allocate(this%nwp_iceT_c(this%xlon,this%xlat,this%xtime)) + allocate(this%nwp_zorl_c(this%xlon,this%xlat,this%xtime)) + allocate(this%nwp_hice_c(this%xlon,this%xlat,this%xtime)) ! Get variables from the data file, but only if the variable is ! defined for that data type. @@ -319,7 +340,18 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, & this%xlat,this%xtime,this%nwp_iceT_c) iceT = this%nwp_iceT_c(:,:,time_to_get) + end if + if (this%i_zorl .gt. 0) then + call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, & + this%xlat,this%xtime,this%nwp_zorl_c) + zorl = this%nwp_zorl_c(:,:,time_to_get) end if + if (this%i_hice .gt. 0) then + call ncdata%get_var(this%varnames(this%i_hice),this%xlon, & + this%xlat,this%xtime,this%nwp_hice_c) + hice = this%nwp_hice_c(:,:,time_to_get) + end if + else if (wcstart == 'warm') then allocate(this%nwp_mask_w(this%xlon,this%xlat)) allocate(this%nwp_sst_w(this%xlon,this%xlat)) @@ -327,6 +359,8 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g allocate(this%nwp_sfcT_w(this%xlon,this%xlat)) allocate(this%nwp_iceT_w(this%xlon,this%xlat)) allocate(this%nwp_sfcTl_w(this%xlon,this%xlat)) + allocate(this%nwp_zorl_w(this%xlon,this%xlat)) + allocate(this%nwp_hice_w(this%xlon,this%xlat)) ! Get variables from the data file, but only if the variable is ! defined for that data type. @@ -336,8 +370,6 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g write(*,*) 'xlon = ', this%xlon write(*,*) 'xtime = ', this%xtime - - if (this%i_mask .gt. 0) then call ncdata%get_var(this%varnames(this%i_mask),this%xlon, & this%xlat,this%nwp_mask_w) @@ -368,6 +400,17 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g this%xlat,this%nwp_sfcTl_w) sfcTl = this%nwp_sfcTl_w(:,:) end if + if (this%i_zorl .gt. 0) then + call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, & + this%xlat,this%nwp_zorl_w) + zorl = this%nwp_zorl_w(:,:) + end if + if (this%i_hice .gt. 0) then + call ncdata%get_var(this%varnames(this%i_hice),this%xlon, & + this%xlat,this%nwp_hice_w) + hice = this%nwp_hice_w(:,:) + end if + else write(*,*) 'Choose either "warm" or "cold" for file' stop 'Error in wcstart. Check spelling or if variable was assigned' @@ -407,12 +450,16 @@ subroutine finish_nwp(this,itype,wcstart) deallocate(this%nwp_ice_c) deallocate(this%nwp_sfcT_c) deallocate(this%nwp_iceT_c) + deallocate(this%nwp_zorl_c) + deallocate(this%nwp_hice_c) else if (wcstart == 'warm') then deallocate(this%nwp_mask_w) deallocate(this%nwp_sst_w) deallocate(this%nwp_ice_w) deallocate(this%nwp_sfcT_w) deallocate(this%nwp_iceT_w) + deallocate(this%nwp_zorl_w) + deallocate(this%nwp_hice_w) else write(*,*) 'no deallocation' end if diff --git a/sorc/fvcom_tools.fd/process_FVCOM.f90 b/sorc/fvcom_tools.fd/process_FVCOM.f90 index bbcffcec9..a9a017717 100755 --- a/sorc/fvcom_tools.fd/process_FVCOM.f90 +++ b/sorc/fvcom_tools.fd/process_FVCOM.f90 @@ -66,6 +66,7 @@ program process_FVCOM real :: truelat1, truelat2, stdlon, lat1, lon1, r_earth real :: knowni, knownj, dx real :: one, pi, deg2rad + real :: zero character(len=180) :: fv3file character(len=180) :: fvcomfile @@ -76,9 +77,11 @@ program process_FVCOM real(r_kind), allocatable :: fv3ice(:,:), fv3sst(:,:) real(r_kind), allocatable :: fv3sfcT(:,:), fv3mask(:,:) real(r_kind), allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) + real(r_kind), allocatable :: fv3zorl(:,:), fv3hice(:,:) real(r_kind), allocatable :: lbcice(:,:), lbcsst(:,:) real(r_kind), allocatable :: lbcsfcT(:,:), lbcmask(:,:) - real(r_kind), allocatable :: lbciceT(:,:) + real(r_kind), allocatable :: lbciceT(:,:), lbczorl(:,:) + real(r_kind), allocatable :: lbchice(:,:) ! Declare namelists ! SETUP (general control namelist) : @@ -97,6 +100,7 @@ program process_FVCOM ! if(mype==0) then + zero = 0.0 ! Get file names from command line arguements num_args = command_argument_count() allocate(args(num_args)) @@ -140,13 +144,16 @@ program process_FVCOM allocate(fv3mask(nlon,nlat)) allocate(fv3iceT(nlon,nlat)) allocate(fv3sfcTl(nlon,nlat)) + allocate(fv3zorl(nlon,nlat)) + allocate(fv3hice(nlon,nlat)) allocate(lbcice(nlon,nlat)) allocate(lbcsfcT(nlon,nlat)) allocate(lbcsst(nlon,nlat)) allocate(lbcmask(nlon,nlat)) allocate(lbciceT(nlon,nlat)) - + allocate(lbczorl(nlon,nlat)) + allocate(lbchice(nlon,nlat)) ! Read fv3 sfc_data.nc before update ! fv3file='sfc_data.nc' @@ -157,7 +164,7 @@ program process_FVCOM call fcst%initial('FV3LAM',wcstart) call fcst%list_initial - call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl) + call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl,fv3zorl,fv3hice) call fcst%finish('FV3LAM',wcstart) @@ -176,7 +183,7 @@ program process_FVCOM t2=indexFVCOMsel write(*,*) 'time asked for =', trim(inputFVCOMselStr) write(*,*) 'time index selected = ', t2 - call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl) + call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl,lbczorl,lbchice) call fcst%finish(' FVCOM',wcstart) ! Check that the dimensions match @@ -207,19 +214,24 @@ program process_FVCOM if (wcstart == 'warm') then do j=1,nlat do i=1,nlon - if (lbcmask(i,j) > 0. .and. lbcsst(i,j) .ge. -90.0) then + if (lbcmask(i,j) > 0. .and. lbcsst(i,j) .ge. -90.0) then !GL Points !If ice fraction below 15%, set to 0 if (lbcice(i,j) < 0.15) then lbcice(i,j) = 0.0 + lbchice(i,j) = 0.0 !remove ice thickness endif fv3ice(i,j) = lbcice(i,j) + fv3hice(i,j) = lbchice(i,j) + !If ice in FVCOM, but not in FV3-LAM, change to ice if (lbcice(i,j) > 0. .and. fv3mask(i,j) == 0.) then fv3mask(i,j) = 2. + fv3zorl(i,j) = 1.1 endif !If ice in FV3-LAM and not FVCOM, remove it from FV3-LAM if (fv3mask(i,j) == 2. .and. lbcice(i,j) == 0.) then fv3mask(i,j) = 0. + fv3zorl(i,j) = zero / zero !Use Fill_Value endif fv3sst(i,j) = lbcsst(i,j) + 273.15 fv3sfcT(i,j) = lbcsst(i,j) + 273.15 @@ -239,15 +251,19 @@ program process_FVCOM !If ice fraction below 15%, set to 0 if (lbcice(i,j) < 0.15) then lbcice(i,j) = 0.0 + lbchice(i,j) = 0.0 !remove ice thickness endif fv3ice(i,j) = lbcice(i,j) + fv3hice(i,j) = lbchice(i,j) !If ice in FVCOM, but not in FV3-LAM, change to ice if (lbcice(i,j) > 0. .and. fv3mask(i,j) == 0.) then fv3mask(i,j) = 2. + fv3zorl(i,j) = 1.1 endif !If ice in FV3-LAM and not FVCOM, remove it from FV3-LAM if (fv3mask(i,j) == 2. .and. lbcice(i,j) == 0.) then fv3mask(i,j) = 0. + fv3zorl(i,j) = zero / zero !Use Fill_Value endif fv3sst(i,j) = lbcsst(i,j) + 273.15 fv3sfcT(i,j) = lbcsst(i,j) + 273.15 @@ -270,13 +286,15 @@ program process_FVCOM call geo%replace_var("fice",NLON,NLAT,fv3ice) call geo%replace_var("slmsk",NLON,NLAT,fv3mask) call geo%replace_var("tisfc",NLON,NLAT,fv3iceT) - + call geo%replace_var("hice",NLON,NLAT,fv3hice) if (wcstart == 'cold') then ! Add_New_Var takes names of (Variable,Dim1,Dim2,Dim3,Long_Name,Units) + call geo%replace_var("zorl",NLON,NLAT,fv3zorl) call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') call geo%replace_var('glmsk',NLON,NLAT,lbcmask) end if if (wcstart == 'warm') then + call geo%replace_var("zorli",NLON,NLAT,fv3zorl) call geo%replace_var("tsfc",NLON,NLAT,fv3sfcT) call geo%replace_var("tsfcl",NLON,NLAT,fv3sfcTl) call geo%add_new_var('glmsk','xaxis_1','yaxis_1','glmsk','none') From 04ad17e27163b93a53ba3bfdbf38fd0ea82d9b1b Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Thu, 13 Jan 2022 15:53:11 -0500 Subject: [PATCH 018/109] Update build modules to be lua compliant (#614) Update build modules for Hera, Jet, Orion and WCOSS-Dell to be "lua" compliant. This is required on our new WCOSS2 machine. So update the rest of the repository accordingly. Allow default library versions to be overridden by environment variables. Update to ESMF v8.1.1 on Hera, because the version that was being used (ESMF v8.1.0 beta snapshot 27) was removed without warning. Minor consistency test script updates to prevent a namelist read error when using the GNU compiler. Fixes #613 --- modulefiles/build.hera.gnu | 28 ------- modulefiles/build.hera.gnu.lua | 64 ++++++++++++++++ modulefiles/build.hera.intel | 31 -------- modulefiles/build.hera.intel.lua | 67 +++++++++++++++++ modulefiles/build.jet.intel | 27 ------- modulefiles/build.jet.intel.lua | 64 ++++++++++++++++ modulefiles/build.orion.intel | 30 -------- modulefiles/build.orion.intel.lua | 64 ++++++++++++++++ modulefiles/build.wcoss_dell_p3.intel | 35 --------- modulefiles/build.wcoss_dell_p3.intel.lua | 75 +++++++++++++++++++ reg_tests/chgres_cube/13km.conus.rap.grib2.sh | 4 +- .../3km.conus.hrrr.gfssdf.grib2.sh | 4 +- .../3km.conus.hrrr.newsfc.grib2.sh | 4 +- 13 files changed, 340 insertions(+), 157 deletions(-) delete mode 100644 modulefiles/build.hera.gnu create mode 100644 modulefiles/build.hera.gnu.lua delete mode 100644 modulefiles/build.hera.intel create mode 100644 modulefiles/build.hera.intel.lua delete mode 100644 modulefiles/build.jet.intel create mode 100644 modulefiles/build.jet.intel.lua delete mode 100644 modulefiles/build.orion.intel create mode 100644 modulefiles/build.orion.intel.lua delete mode 100644 modulefiles/build.wcoss_dell_p3.intel create mode 100644 modulefiles/build.wcoss_dell_p3.intel.lua diff --git a/modulefiles/build.hera.gnu b/modulefiles/build.hera.gnu deleted file mode 100644 index 15702b39e..000000000 --- a/modulefiles/build.hera.gnu +++ /dev/null @@ -1,28 +0,0 @@ -#%Module##################################################### -## Build and run module for Hera -############################################################# - -module load hpss -module load cmake/3.16.1 - -module use /scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack - -module load hpc/1.1.0 -module load hpc-gnu/9.2.0 -module load hpc-mpich/3.3.2 - -module load netcdf/4.7.4 -module load esmf/8_1_0_beta_snapshot_27 -module load bacio/2.4.1 -module load g2/3.4.1 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3nco/2.4.1 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load wgrib2/2.0.8 -module load nccmp/1.8.7.0 -module load png/1.6.35 -module load zlib/1.2.11 -module load jasper/2.0.22 diff --git a/modulefiles/build.hera.gnu.lua b/modulefiles/build.hera.gnu.lua new file mode 100644 index 000000000..88aa5ef57 --- /dev/null +++ b/modulefiles/build.hera.gnu.lua @@ -0,0 +1,64 @@ +help([[ +Load environment to compile UFS_UTILS on Hera using Gnu +]]) + +cmake_ver=os.getenv("cmake_ver") or "3.16.1" +load(pathJoin("cmake", cmake_ver)) + +hpss_ver=os.getenv("hpss_ver") or "" +load(pathJoin("hpss", hpss_ver)) + +prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") + +hpc_ver=os.getenv("hpc_ver") or "1.1.0" +load(pathJoin("hpc", hpc_ver)) + +hpc_gnu_ver=os.getenv("hpc_gnu_ver") or "9.2.0" +load(pathJoin("hpc-gnu", hpc_gnu_ver)) + +mpich_ver=os.getenv("mpich_ver") or "3.3.2" +load(pathJoin("hpc-mpich", mpich_ver)) + +netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" +load(pathJoin("netcdf", netcdf_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8_1_1" +load(pathJoin("esmf", esmf_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.1" +load(pathJoin("g2", g2_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)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_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)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) + +nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +load(pathJoin("nccmp", nccmp_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +png_ver=os.getenv("png_ver") or "1.6.35" +load(pathJoin("png", png_ver)) + +whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.hera.intel b/modulefiles/build.hera.intel deleted file mode 100644 index 7c68b4143..000000000 --- a/modulefiles/build.hera.intel +++ /dev/null @@ -1,31 +0,0 @@ -#%Module##################################################### -## Build and run module for Hera -############################################################# - -module load hpss -module load cmake/3.16.1 - -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 bacio/2.4.1 -module load g2/3.4.1 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3nco/2.4.1 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load wgrib2/2.0.8 - -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 nccmp/1.8.7.0 -module load esmf/8_1_0_beta_snapshot_27 diff --git a/modulefiles/build.hera.intel.lua b/modulefiles/build.hera.intel.lua new file mode 100644 index 000000000..4921502fe --- /dev/null +++ b/modulefiles/build.hera.intel.lua @@ -0,0 +1,67 @@ +help([[ +Load environment to compile UFS_UTILS on Hera using Intel +]]) + +cmake_ver=os.getenv("cmake_ver") or "3.16.1" +load(pathJoin("cmake", cmake_ver)) + +hpss_ver=os.getenv("hpss_ver") or "" +load(pathJoin("hpss", hpss_ver)) + +prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") + +hpc_ver=os.getenv("hpc_ver") or "1.1.0" +load(pathJoin("hpc", hpc_ver)) + +hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" +load(pathJoin("hpc-intel", hpc_intel_ver)) + +impi_ver=os.getenv("impi_ver") or "2018.0.4" +load(pathJoin("hpc-impi", impi_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.1" +load(pathJoin("g2", g2_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)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_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)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +png_ver=os.getenv("png_ver") or "1.6.35" +load(pathJoin("png", png_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)) + +nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +load(pathJoin("nccmp", nccmp_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8_1_1" +load(pathJoin("esmf", esmf_ver)) + +whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.jet.intel b/modulefiles/build.jet.intel deleted file mode 100644 index 4161fcff0..000000000 --- a/modulefiles/build.jet.intel +++ /dev/null @@ -1,27 +0,0 @@ -#%Module##################################################### -## Build and run module for Jet -############################################################# -module load cmake/3.16.1 -module load hpss - -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 hdf5/1.10.6 -module load netcdf/4.7.4 -module load nccmp/1.8.7.0 -module load esmf/8_1_0_beta_snapshot_27 -module load jasper/2.0.22 - -module load w3nco/2.4.1 -module load sp/2.3.3 -module load ip/3.3.3 -module load bacio/2.4.1 -module load sigio/2.3.2 -module load sfcio/1.4.1 -module load nemsio/2.5.2 -module load g2/3.4.1 -module load wgrib2/2.0.8 -module load prod_util/1.2.2 diff --git a/modulefiles/build.jet.intel.lua b/modulefiles/build.jet.intel.lua new file mode 100644 index 000000000..a0a6d7c54 --- /dev/null +++ b/modulefiles/build.jet.intel.lua @@ -0,0 +1,64 @@ +help([[ +Load environment to compile UFS_UTILS on Jet +]]) + +cmake_ver=os.getenv("cmake_ver") or "3.16.1" +load(pathJoin("cmake", cmake_ver)) + +hpss_ver=os.getenv("hpss_ver") or "" +load(pathJoin("hpss", hpss_ver)) + +prepend_path("MODULEPATH", "/lfs4/HFIP/hfv3gfs/nwprod/hpc-stack/libs/modulefiles/stack") + +hpc_ver=os.getenv("hpc_ver") or "1.1.0" +load(pathJoin("hpc", hpc_ver)) + +hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" +load(pathJoin("hpc-intel", hpc_intel_ver)) + +impi_ver=os.getenv("impi_ver") or "2018.4.274" +load(pathJoin("hpc-impi", impi_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)) + +nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +load(pathJoin("nccmp", nccmp_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8_1_0_beta_snapshot_27" +load(pathJoin("esmf", esmf_ver)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_ver)) + +sp_ver=os.getenv("sp_ver") or "2.3.3" +load(pathJoin("sp", sp_ver)) + +ip_ver=os.getenv("ip_ver") or "3.3.3" +load(pathJoin("ip", ip_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +sigio_ver=os.getenv("sigio_ver") or "2.3.2" +load(pathJoin("sigio", sigio_ver)) + +sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" +load(pathJoin("sfcio", sfcio_ver)) + +nemsio_ver=os.getenv("nemsio_ver") or "2.5.2" +load(pathJoin("nemsio", nemsio_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.1" +load(pathJoin("g2", g2_ver)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) + +prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +load(pathJoin("prod_util", prod_util_ver)) + +whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.orion.intel b/modulefiles/build.orion.intel deleted file mode 100644 index 891623680..000000000 --- a/modulefiles/build.orion.intel +++ /dev/null @@ -1,30 +0,0 @@ -#%Module##################################################### -## Build module for Orion -############################################################# - -module load cmake/3.17.3 - -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 bacio/2.4.1 -module load g2/3.4.1 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3nco/2.4.1 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load wgrib2/2.0.8 - -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 nccmp/1.8.7.0 -module load esmf/8_1_0_beta_snapshot_27 diff --git a/modulefiles/build.orion.intel.lua b/modulefiles/build.orion.intel.lua new file mode 100644 index 000000000..78ba117c2 --- /dev/null +++ b/modulefiles/build.orion.intel.lua @@ -0,0 +1,64 @@ +help([[ +Load environment to compile UFS_UTILS on Orion +]]) + +cmake_ver=os.getenv("cmake_ver") or "3.17.3" +load(pathJoin("cmake", cmake_ver)) + +prepend_path("MODULEPATH", "/apps/contrib/NCEP/libs/hpc-stack/modulefiles/stack") + +hpc_ver=os.getenv("hpc_ver") or "1.1.0" +load(pathJoin("hpc", hpc_ver)) + +hpc_intel_ver=os.getenv("hpc_intel_ver") or "2018.4" +load(pathJoin("hpc-intel", hpc_intel_ver)) + +impi_ver=os.getenv("impi_ver") or "2018.4" +load(pathJoin("hpc-impi", impi_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.1" +load(pathJoin("g2", g2_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)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_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)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +png_ver=os.getenv("png_ver") or "1.6.35" +load(pathJoin("png", png_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)) + +nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +load(pathJoin("nccmp", nccmp_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8_1_0_beta_snapshot_27" +load(pathJoin("esmf", esmf_ver)) + +whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.wcoss_dell_p3.intel b/modulefiles/build.wcoss_dell_p3.intel deleted file mode 100644 index 4e44018e8..000000000 --- a/modulefiles/build.wcoss_dell_p3.intel +++ /dev/null @@ -1,35 +0,0 @@ -#%Module##################################################### -## Build and run module for WCOSS-Dell P3 -############################################################# - -module load lsf/10.1 -module load HPSS/5.0.2.5 -module load cmake/3.16.2 - -module use /usrx/local/nceplibs/dev/hpc-stack/libs/hpc-stack/modulefiles/stack - -module load hpc/1.1.0 -module load hpc-ips/18.0.1.163 -module load hpc-impi/18.0.1 - -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 nccmp/1.8.7.0 -module load esmf/8_1_0_beta_snapshot_27 - -module load bacio/2.4.1 -module load g2/3.4.1 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3nco/2.4.1 -module load sfcio/1.4.1 -module load sigio/2.3.2 -module load wgrib2/2.0.8 - -module use /usrx/local/dev/modulefiles -module load prod_util/1.1.3 diff --git a/modulefiles/build.wcoss_dell_p3.intel.lua b/modulefiles/build.wcoss_dell_p3.intel.lua new file mode 100644 index 000000000..bc741a8e3 --- /dev/null +++ b/modulefiles/build.wcoss_dell_p3.intel.lua @@ -0,0 +1,75 @@ +help([[ +Load environment to compile UFS_UTILS on WCOSS-Dell P3 +]]) + +lsf_ver=os.getenv("lsf_ver") or "10.1" +load(pathJoin("lsf", lsf_ver)) + +HPSS_ver=os.getenv("HPSS_ver") or "5.0.2.5" +load(pathJoin("HPSS", HPSS_ver)) + +cmake_ver=os.getenv("cmake_ver") or "3.16.2" +load(pathJoin("cmake", cmake_ver)) + +prepend_path("MODULEPATH", "/usrx/local/nceplibs/dev/hpc-stack/libs/hpc-stack/modulefiles/stack") + +hpc_ver=os.getenv("hpc_ver") or "1.1.0" +load(pathJoin("hpc", hpc_ver)) + +ips_ver=os.getenv("ips_ver") or "18.0.1.163" +load(pathJoin("hpc-ips", ips_ver)) + +impi_ver=os.getenv("impi_ver") or "18.0.1" +load(pathJoin("hpc-impi", impi_ver)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +png_ver=os.getenv("png_ver") or "1.6.35" +load(pathJoin("png", png_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)) + +nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +load(pathJoin("nccmp", nccmp_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8_1_0_beta_snapshot_27" +load(pathJoin("esmf", esmf_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.1" +load(pathJoin("g2", g2_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)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_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)) + +wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" +load(pathJoin("wgrib2", wgrib2_ver)) + +prepend_path("MODULEPATH", "/usrx/local/dev/modulefiles") + +prod_util_ver=os.getenv("prod_util_ver") or "1.1.3" +load(pathJoin("prod_util", prod_util_ver)) + +whatis("Description: UFS_UTILS build environment") diff --git a/reg_tests/chgres_cube/13km.conus.rap.grib2.sh b/reg_tests/chgres_cube/13km.conus.rap.grib2.sh index 441f953fe..1fa10c20b 100755 --- a/reg_tests/chgres_cube/13km.conus.rap.grib2.sh +++ b/reg_tests/chgres_cube/13km.conus.rap.grib2.sh @@ -30,8 +30,8 @@ export HALO_BNDY=4 export CDATE=2019080100 export EXTERNAL_MODEL="RAP" export NSOILL_OUT=9 -export TRACERS_TARGET="NULL" -export TRACERS_INPUT="NULL" +export TRACERS_TARGET='"NULL"' +export TRACERS_INPUT='"NULL"' export SOTYP_FROM_CLIMO=.false. export VGTYP_FROM_CLIMO=.false. export VGFRC_FROM_CLIMO=.true. diff --git a/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh b/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh index 67711b8f6..abfea41cb 100755 --- a/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh +++ b/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh @@ -30,8 +30,8 @@ export HALO_BNDY=4 export CDATE=2019080100 export EXTERNAL_MODEL="HRRR" export NSOILL_OUT=4 -export TRACERS_TARGET="NULL" -export TRACERS_INPUT="NULL" +export TRACERS_TARGET='"NULL"' +export TRACERS_INPUT='"NULL"' export GEOGRID_FILE_INPUT=${HOMEufs}/fix/fix_am/geo_em.d01.nc_HRRRX export OMP_NUM_THREADS_CH=${OMP_NUM_THREADS:-1} diff --git a/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh b/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh index 30be5e98e..de24e72b4 100755 --- a/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh +++ b/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh @@ -30,8 +30,8 @@ export HALO_BNDY=4 export CDATE=2019080100 export EXTERNAL_MODEL="HRRR" export NSOILL_OUT=9 -export TRACERS_TARGET="NULL" -export TRACERS_INPUT="NULL" +export TRACERS_TARGET='"NULL"' +export TRACERS_INPUT='"NULL"' export SOTYP_FROM_CLIMO=.false. export VGTYP_FROM_CLIMO=.false. export VGFRC_FROM_CLIMO=.false. From 76e73d91735fa6a562e4f0573332d08c12c79c9c Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 14 Jan 2022 13:44:03 -0500 Subject: [PATCH 019/109] Update workflow files to use newer versions of ESMF and NCEPLIBS. (#617) A later version of the G2 library is required for issue #591. Upgrade to ESMF v8.1.1 to be consistent with the build modules. Fixes #615 --- .github/workflows/debug-docs-test_coverage.yml | 18 +++++++++--------- .github/workflows/intel.yml | 18 +++++++++--------- .github/workflows/linux-mac-nceplibs-mpi.yml | 16 ++++++++-------- .github/workflows/netcdf-versions.yml | 18 +++++++++--------- 4 files changed, 35 insertions(+), 35 deletions(-) diff --git a/.github/workflows/debug-docs-test_coverage.yml b/.github/workflows/debug-docs-test_coverage.yml index 0f920f471..8aef6c911 100644 --- a/.github/workflows/debug-docs-test_coverage.yml +++ b/.github/workflows/debug-docs-test_coverage.yml @@ -26,16 +26,16 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.0.1-${{ runner.os }}3 + key: esmf-8.1.1-${{ runner.os }}3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' run: | pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_0_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_0_1.tar.gz &> /dev/null - tar zxf ESMF_8_0_1.tar.gz - cd esmf-ESMF_8_0_1 + export ESMF_DIR=~/esmf-ESMF_8_1_1 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null + tar zxf ESMF_8_1_1.tar.gz + cd esmf-ESMF_8_1_1 export ESMF_COMM=mpich3 export ESMF_INSTALL_BINDIR=bin export ESMF_INSTALL_LIBDIR=lib @@ -71,14 +71,14 @@ jobs: uses: actions/cache@v2 with: path: ~/nceplibs - key: nceplibs-1.3.0-${{ runner.os }}3 + key: nceplibs-1.4.0-${{ runner.os }}3 - name: build-nceplibs if: steps.cache-nceplibs.outputs.cache-hit != 'true' run: | - wget https://github.com/NOAA-EMC/NCEPLIBS/archive/v1.3.0.tar.gz &> /dev/null - tar zxf v1.3.0.tar.gz - cd NCEPLIBS-1.3.0 + wget https://github.com/NOAA-EMC/NCEPLIBS/archive/v1.4.0.tar.gz &> /dev/null + tar zxf v1.4.0.tar.gz + cd NCEPLIBS-1.4.0 export ESMFMKFILE=~/esmf/lib/esmf.mk mkdir build && cd build cmake .. -DCMAKE_PREFIX_PATH='~;~/jasper' -DCMAKE_INSTALL_PREFIX='~/nceplibs' -DFLAT=ON diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index cb0231749..c4fc4aca0 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -85,16 +85,16 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.0.1-${{ runner.os }}-intel3 + key: esmf-8.1.1-${{ runner.os }}-intel3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' run: | pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_0_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_0_1.tar.gz &> /dev/null - tar zxf ESMF_8_0_1.tar.gz - cd esmf-ESMF_8_0_1 + export ESMF_DIR=~/esmf-ESMF_8_1_1 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null + tar zxf ESMF_8_1_1.tar.gz + cd esmf-ESMF_8_1_1 export ESMF_COMM=intelmpi export ESMF_INSTALL_BINDIR=bin export ESMF_INSTALL_LIBDIR=lib @@ -137,15 +137,15 @@ jobs: uses: actions/cache@v2 with: path: ~/nceplibs - key: nceplibs-1.3.0-${{ runner.os }}-intel3 + key: nceplibs-1.4.0-${{ runner.os }}-intel3 - name: build-nceplibs if: steps.cache-nceplibs.outputs.cache-hit != 'true' run: | export ESMFMKFILE=~/esmf/lib/esmf.mk - wget https://github.com/NOAA-EMC/NCEPLIBS/archive/v1.3.0.tar.gz &> /dev/null - tar zxf v1.3.0.tar.gz - cd NCEPLIBS-1.3.0 + wget https://github.com/NOAA-EMC/NCEPLIBS/archive/v1.4.0.tar.gz &> /dev/null + tar zxf v1.4.0.tar.gz + cd NCEPLIBS-1.4.0 mkdir build && cd build cmake .. -DCMAKE_PREFIX_PATH='~;~/jasper;~/netcdf' -DCMAKE_INSTALL_PREFIX='~/nceplibs' -DFLAT=ON make -j2 diff --git a/.github/workflows/linux-mac-nceplibs-mpi.yml b/.github/workflows/linux-mac-nceplibs-mpi.yml index 4776bec3b..1cf8df4f1 100644 --- a/.github/workflows/linux-mac-nceplibs-mpi.yml +++ b/.github/workflows/linux-mac-nceplibs-mpi.yml @@ -16,7 +16,7 @@ jobs: matrix: os: [macos-10.15, ubuntu-20.04] compiler: [gcc-9] - nceplibs_version: [develop, 1.3.0] + nceplibs_version: [develop, 1.4.0] mpi_type: [mpich, openmpi] netcdf_version: [4.7.4] @@ -123,17 +123,17 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf--8.0.1-${{ runner.os }}-${{ matrix.mpi_type }}-netcdf-${{ matrix.netcdf_version }}3 + key: esmf--8.1.1-${{ runner.os }}-${{ matrix.mpi_type }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' run: | set -x pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_0_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_0_1.tar.gz &> /dev/null - tar zxf ESMF_8_0_1.tar.gz - cd esmf-ESMF_8_0_1 + export ESMF_DIR=~/esmf-ESMF_8_1_1 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null + tar zxf ESMF_8_1_1.tar.gz + cd esmf-ESMF_8_1_1 if [[ ${{ matrix.mpi_type}} == "mpich" ]]; then export ESMF_COMM=mpich3 elif [[ ${{ matrix.mpi_type}} == "openmpi" ]]; then @@ -175,8 +175,8 @@ jobs: run: | git clone https://github.com/NOAA-EMC/NCEPLIBS.git nceplibs cd nceplibs - if [[ ${{ matrix.nceplibs_version }} == "1.3.0" ]]; then - git checkout v1.3.0 + if [[ ${{ matrix.nceplibs_version }} == "1.4.0" ]]; then + git checkout v1.4.0 fi - name: get-git-hash diff --git a/.github/workflows/netcdf-versions.yml b/.github/workflows/netcdf-versions.yml index c286011a7..bc8b4e1a9 100644 --- a/.github/workflows/netcdf-versions.yml +++ b/.github/workflows/netcdf-versions.yml @@ -76,16 +76,16 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.0.1-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 + key: esmf-8.1.1-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-esmf #if: steps.cache-esmf.outputs.cache-hit != 'true' run: | pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_0_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_0_1.tar.gz &> /dev/null - tar zxf ESMF_8_0_1.tar.gz - cd esmf-ESMF_8_0_1 + export ESMF_DIR=~/esmf-ESMF_8_1_1 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null + tar zxf ESMF_8_1_1.tar.gz + cd esmf-ESMF_8_1_1 export ESMF_COMM=mpich3 export ESMF_INSTALL_BINDIR=bin export ESMF_INSTALL_LIBDIR=lib @@ -122,14 +122,14 @@ jobs: uses: actions/cache@v2 with: path: ~/nceplibs - key: nceplibs-1.3.0-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 + key: nceplibs-1.4.0-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-nceplibs if: steps.cache-nceplibs.outputs.cache-hit != 'true' run: | - wget https://github.com/NOAA-EMC/NCEPLIBS/archive/v1.3.0.tar.gz &> /dev/null - tar zxf v1.3.0.tar.gz - cd NCEPLIBS-1.3.0 + wget https://github.com/NOAA-EMC/NCEPLIBS/archive/v1.4.0.tar.gz &> /dev/null + tar zxf v1.4.0.tar.gz + cd NCEPLIBS-1.4.0 export ESMFMKFILE=~/esmf/lib/esmf.mk mkdir build && cd build cmake .. -DCMAKE_PREFIX_PATH='~;~/jasper;~/netcdf' -DCMAKE_INSTALL_PREFIX='~/nceplibs' -DFLAT=ON From 04700f9951419629c6a0e5ed057f66aff7144dac Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Thu, 20 Jan 2022 11:25:06 -0500 Subject: [PATCH 020/109] Automate update of consistency test baseline data. (#603) Add logic to the consistency test scripts to automatically update the baseline data when code updates change results. Fixes #574 --- reg_tests/chgres_cube/13km.conus.nam.grib2.sh | 3 + reg_tests/chgres_cube/13km.conus.rap.grib2.sh | 3 + .../chgres_cube/13km.na.gfs.ncei.grib2.sh | 3 + reg_tests/chgres_cube/25km.conus.gfs.grib2.sh | 3 + .../chgres_cube/25km.conus.gfs.pbgrib2.sh | 3 + .../3km.conus.hrrr.gfssdf.grib2.sh | 3 + .../3km.conus.hrrr.newsfc.grib2.sh | 3 + reg_tests/chgres_cube/c192.fv3.history.sh | 3 + reg_tests/chgres_cube/c192.gfs.grib2.sh | 3 + reg_tests/chgres_cube/c96.fv3.nemsio.sh | 3 + reg_tests/chgres_cube/c96.fv3.netcdf.sh | 3 + reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh | 3 + reg_tests/chgres_cube/c96.fv3.restart.sh | 3 + reg_tests/chgres_cube/c96.gfs.nemsio.sh | 3 + reg_tests/chgres_cube/c96.gfs.sigio.sh | 3 + reg_tests/chgres_cube/c96.regional.sh | 3 + reg_tests/chgres_cube/driver.hera.sh | 7 +++ reg_tests/chgres_cube/driver.jet.sh | 7 +++ reg_tests/chgres_cube/driver.orion.sh | 7 +++ reg_tests/chgres_cube/driver.wcoss_cray.sh | 7 +++ reg_tests/chgres_cube/driver.wcoss_dell_p3.sh | 7 +++ reg_tests/get_hash.sh | 11 ++++ reg_tests/global_cycle/C768.fv3gfs.sh | 3 + reg_tests/global_cycle/C768.lndincsnow.sh | 3 + reg_tests/global_cycle/C768.lndincsoil.sh | 3 + reg_tests/global_cycle/driver.hera.sh | 7 +++ reg_tests/global_cycle/driver.jet.sh | 7 +++ reg_tests/global_cycle/driver.orion.sh | 7 +++ reg_tests/global_cycle/driver.wcoss_cray.sh | 7 +++ .../global_cycle/driver.wcoss_dell_p3.sh | 7 +++ reg_tests/grid_gen/c96.uniform.sh | 3 + reg_tests/grid_gen/c96.viirs.vegt.sh | 3 + reg_tests/grid_gen/driver.hera.sh | 7 +++ reg_tests/grid_gen/driver.jet.sh | 7 +++ reg_tests/grid_gen/driver.orion.sh | 8 +++ reg_tests/grid_gen/driver.wcoss_cray.sh | 7 +++ reg_tests/grid_gen/driver.wcoss_dell_p3.sh | 7 +++ reg_tests/grid_gen/esg.regional.sh | 3 + reg_tests/grid_gen/gfdl.regional.sh | 3 + reg_tests/grid_gen/regional.gsl.gwd.sh | 3 + reg_tests/ice_blend/driver.hera.sh | 7 +++ reg_tests/ice_blend/driver.jet.sh | 8 +++ reg_tests/ice_blend/driver.orion.sh | 7 +++ reg_tests/ice_blend/driver.wcoss_cray.sh | 7 +++ reg_tests/ice_blend/driver.wcoss_dell_p3.sh | 8 +++ reg_tests/ice_blend/ice_blend.sh | 6 +- reg_tests/snow2mdl/driver.hera.sh | 7 +++ reg_tests/snow2mdl/driver.jet.sh | 7 +++ reg_tests/snow2mdl/driver.orion.sh | 7 +++ reg_tests/snow2mdl/driver.wcoss_cray.sh | 7 +++ reg_tests/snow2mdl/driver.wcoss_dell_p3.sh | 8 +++ reg_tests/snow2mdl/snow2mdl.sh | 6 +- reg_tests/update_baseline.sh | 56 +++++++++++++++++++ 53 files changed, 328 insertions(+), 2 deletions(-) create mode 100755 reg_tests/get_hash.sh create mode 100755 reg_tests/update_baseline.sh diff --git a/reg_tests/chgres_cube/13km.conus.nam.grib2.sh b/reg_tests/chgres_cube/13km.conus.nam.grib2.sh index 7d97800db..f293f3874 100755 --- a/reg_tests/chgres_cube/13km.conus.nam.grib2.sh +++ b/reg_tests/chgres_cube/13km.conus.nam.grib2.sh @@ -82,6 +82,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< 13-KM CONUS NAM GRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "13km_conus_nam_grib2" $commit_num + fi else echo "<<< 13-KM CONUS NAM GRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/13km.conus.rap.grib2.sh b/reg_tests/chgres_cube/13km.conus.rap.grib2.sh index 1fa10c20b..4c4f6df8b 100755 --- a/reg_tests/chgres_cube/13km.conus.rap.grib2.sh +++ b/reg_tests/chgres_cube/13km.conus.rap.grib2.sh @@ -90,6 +90,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< 13-km CONUS RAP W/ GSD PHYSICS AND SFC FROM FILE GRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "13km_conus_rap_grib2" $commit_num + fi else echo "<<< 13-km CONUS RAP W/ GSD PHYSICS AND SFC FROM FILE GRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/13km.na.gfs.ncei.grib2.sh b/reg_tests/chgres_cube/13km.na.gfs.ncei.grib2.sh index c98df7122..b8122703c 100755 --- a/reg_tests/chgres_cube/13km.na.gfs.ncei.grib2.sh +++ b/reg_tests/chgres_cube/13km.na.gfs.ncei.grib2.sh @@ -79,6 +79,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< 13-KM NA GFS NCEI GRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "13km_na_gfs_ncei_grib2" $commit_num + fi else echo "<<< 13-KM NA GFS NCEI GRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/25km.conus.gfs.grib2.sh b/reg_tests/chgres_cube/25km.conus.gfs.grib2.sh index 61bbe7e50..10ead8ce6 100755 --- a/reg_tests/chgres_cube/25km.conus.gfs.grib2.sh +++ b/reg_tests/chgres_cube/25km.conus.gfs.grib2.sh @@ -80,6 +80,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< 25-KM CONUS GFS GRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "25km_conus_gfs_grib2" $commit_num + fi else echo "<<< 25-KM CONUS GFS GRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/25km.conus.gfs.pbgrib2.sh b/reg_tests/chgres_cube/25km.conus.gfs.pbgrib2.sh index bb23c3004..d56ebeef1 100755 --- a/reg_tests/chgres_cube/25km.conus.gfs.pbgrib2.sh +++ b/reg_tests/chgres_cube/25km.conus.gfs.pbgrib2.sh @@ -79,6 +79,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< 25-KM CONUS GFS PGRIB2+BGRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "25km_conus_gfs_pbgrib2" $commit_num + fi else echo "<<< 25-KM CONUS GFS PGRIB2+BGRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh b/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh index abfea41cb..f9cf35edc 100755 --- a/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh +++ b/reg_tests/chgres_cube/3km.conus.hrrr.gfssdf.grib2.sh @@ -84,6 +84,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< 3-km CONUS HRRR W/ GFS PHYSICS GRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "3km_conus_hrrr_gfssdf_grib2" $commit_num + fi else echo "<<< 3-km CONUS HRRR W/ GFS PHYSICS GRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh b/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh index de24e72b4..4f26a3f2d 100755 --- a/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh +++ b/reg_tests/chgres_cube/3km.conus.hrrr.newsfc.grib2.sh @@ -90,6 +90,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< 3-km CONUS HRRR W/ GSD PHYSICS AND SFC FROM FILE GRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "3km_conus_hrrr_newsfc_grib2" $commit_num + fi else echo "<<< 3-km CONUS HRRR W/ GSD PHYSICS AND SFC FROM FILE GRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c192.fv3.history.sh b/reg_tests/chgres_cube/c192.fv3.history.sh index 44fd8ae81..7bb587ff6 100755 --- a/reg_tests/chgres_cube/c192.fv3.history.sh +++ b/reg_tests/chgres_cube/c192.fv3.history.sh @@ -72,6 +72,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C192 FV3 HISTORY TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c192_fv3_history" $commit_num + fi else echo "<<< C192 FV3 HISTORY TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c192.gfs.grib2.sh b/reg_tests/chgres_cube/c192.gfs.grib2.sh index 5b8cf2bac..6d6e0cba5 100755 --- a/reg_tests/chgres_cube/c192.gfs.grib2.sh +++ b/reg_tests/chgres_cube/c192.gfs.grib2.sh @@ -67,6 +67,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C192 GFS GRIB2 TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c192_gfs_grib2" $commit_num + fi else echo "<<< C192 GFS GRIB2 TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c96.fv3.nemsio.sh b/reg_tests/chgres_cube/c96.fv3.nemsio.sh index e0271c15b..7a6463f70 100755 --- a/reg_tests/chgres_cube/c96.fv3.nemsio.sh +++ b/reg_tests/chgres_cube/c96.fv3.nemsio.sh @@ -63,6 +63,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 FV3 GAUSSIAN NEMSIO TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c96_fv3_nemsio" $commit_num + fi else echo "<<< C96 FV3 GAUSSIAN NEMSIO TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c96.fv3.netcdf.sh b/reg_tests/chgres_cube/c96.fv3.netcdf.sh index 4f5618737..acd21c81d 100755 --- a/reg_tests/chgres_cube/c96.fv3.netcdf.sh +++ b/reg_tests/chgres_cube/c96.fv3.netcdf.sh @@ -64,6 +64,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 FV3 GAUSSIAN NETCDF TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c96_fv3_netcdf" $commit_num + fi else echo "<<< C96 FV3 GAUSSIAN NETCDF TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh b/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh index 7adf8f04b..74f301f87 100755 --- a/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh +++ b/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh @@ -71,6 +71,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 FV3 GAUSSIAN NETCDF2WAM TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c96_fv3_netcdf2wam" $commit_num + fi else echo "<<< C96 FV3 GAUSSIAN NETCDF2WAM TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c96.fv3.restart.sh b/reg_tests/chgres_cube/c96.fv3.restart.sh index bcc38ea44..c4f8ca95b 100755 --- a/reg_tests/chgres_cube/c96.fv3.restart.sh +++ b/reg_tests/chgres_cube/c96.fv3.restart.sh @@ -73,6 +73,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 FV3 RESTART TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c96_fv3_restart" $commit_num + fi else echo "<<< C96 FV3 RESTART TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c96.gfs.nemsio.sh b/reg_tests/chgres_cube/c96.gfs.nemsio.sh index 36ea52843..a965bfa10 100755 --- a/reg_tests/chgres_cube/c96.gfs.nemsio.sh +++ b/reg_tests/chgres_cube/c96.gfs.nemsio.sh @@ -67,6 +67,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 GFS GAUSSIAN NEMSIO TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c96_gfs_nemsio" $commit_num + fi else echo "<<< C96 GFS GAUSSIAN NEMSIO TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c96.gfs.sigio.sh b/reg_tests/chgres_cube/c96.gfs.sigio.sh index b04765603..daf1145c9 100755 --- a/reg_tests/chgres_cube/c96.gfs.sigio.sh +++ b/reg_tests/chgres_cube/c96.gfs.sigio.sh @@ -69,6 +69,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 GFS SIGIO TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c96_gfs_sigio" $commit_num + fi else echo "<<< C96 GFS SIGIO TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/c96.regional.sh b/reg_tests/chgres_cube/c96.regional.sh index 8cde6a50a..b4807aa5e 100755 --- a/reg_tests/chgres_cube/c96.regional.sh +++ b/reg_tests/chgres_cube/c96.regional.sh @@ -72,6 +72,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 REGIONAL TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $HOMEufs/reg_tests/update_baseline.sh $HOMEreg "c96_regional" $commit_num + fi else echo "<<< C96 REGIONAL TEST PASSED. >>>" fi diff --git a/reg_tests/chgres_cube/driver.hera.sh b/reg_tests/chgres_cube/driver.hera.sh index dd911d241..d95cbadf9 100755 --- a/reg_tests/chgres_cube/driver.hera.sh +++ b/reg_tests/chgres_cube/driver.hera.sh @@ -44,6 +44,13 @@ QUEUE="${QUEUE:-batch}" # and baseline data for each test. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEufs=$PWD/../.. export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/chgres_cube diff --git a/reg_tests/chgres_cube/driver.jet.sh b/reg_tests/chgres_cube/driver.jet.sh index f1eb2e1a4..4b7a29786 100755 --- a/reg_tests/chgres_cube/driver.jet.sh +++ b/reg_tests/chgres_cube/driver.jet.sh @@ -45,6 +45,13 @@ export HDF5_DISABLE_VERSION_CHECK=2 # and baseline data for each test. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEufs=$PWD/../.. export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/chgres_cube diff --git a/reg_tests/chgres_cube/driver.orion.sh b/reg_tests/chgres_cube/driver.orion.sh index 53da13cfc..bfa1c543c 100755 --- a/reg_tests/chgres_cube/driver.orion.sh +++ b/reg_tests/chgres_cube/driver.orion.sh @@ -44,6 +44,13 @@ QUEUE="${QUEUE:-batch}" # and baseline data for each test. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEufs=$PWD/../.. export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/chgres_cube diff --git a/reg_tests/chgres_cube/driver.wcoss_cray.sh b/reg_tests/chgres_cube/driver.wcoss_cray.sh index d08b9cdb9..96337cc03 100755 --- a/reg_tests/chgres_cube/driver.wcoss_cray.sh +++ b/reg_tests/chgres_cube/driver.wcoss_cray.sh @@ -42,6 +42,13 @@ PROJECT_CODE="${PROJECT_CODE:-GFS-DEV}" export HOMEufs=$PWD/../.. +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEreg=/gpfs/hps3/emc/global/noscrub/George.Gayno/ufs_utils.git/reg_tests/chgres_cube LOG_FILE=consistency.log diff --git a/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh b/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh index 20cc13003..04ab66c72 100755 --- a/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh +++ b/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh @@ -40,6 +40,13 @@ PROJECT_CODE="${PROJECT_CODE:-GFS-DEV}" # and baseline data for each test. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEufs=$PWD/../.. export HOMEreg=/gpfs/dell2/emc/modeling/noscrub/George.Gayno/ufs_utils.git/reg_tests/chgres_cube diff --git a/reg_tests/get_hash.sh b/reg_tests/get_hash.sh new file mode 100755 index 000000000..443c62098 --- /dev/null +++ b/reg_tests/get_hash.sh @@ -0,0 +1,11 @@ +#!/bin/bash + +#set -x + +commit_string=$(git log -1 --oneline) + +commit_num=$(echo $commit_string | cut -c1-7) + +echo ${commit_num} + +export commit_num diff --git a/reg_tests/global_cycle/C768.fv3gfs.sh b/reg_tests/global_cycle/C768.fv3gfs.sh index 5bb326c42..c86792ff6 100755 --- a/reg_tests/global_cycle/C768.fv3gfs.sh +++ b/reg_tests/global_cycle/C768.fv3gfs.sh @@ -70,6 +70,9 @@ if [ $test_failed -ne 0 ]; then echo "*********************************" echo "<<< C768 GLOBAL CYCLE TEST FAILED. >>>" echo "*********************************" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $BASE_GSM/reg_tests/update_baseline.sh $HOMEreg "c768.fv3gfs" $commit_num + fi else echo echo "*********************************" diff --git a/reg_tests/global_cycle/C768.lndincsnow.sh b/reg_tests/global_cycle/C768.lndincsnow.sh index 62a91fa7a..c98d443ba 100755 --- a/reg_tests/global_cycle/C768.lndincsnow.sh +++ b/reg_tests/global_cycle/C768.lndincsnow.sh @@ -75,6 +75,9 @@ if [ $test_failed -ne 0 ]; then echo "****************************************" echo "<<< C768 LANDINC SNOW CYCLE TEST FAILED. >>>" echo "****************************************" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $BASE_GSM/reg_tests/update_baseline.sh $HOMEreg "c768.lndincsnow" $commit_num + fi else echo echo "***************************************" diff --git a/reg_tests/global_cycle/C768.lndincsoil.sh b/reg_tests/global_cycle/C768.lndincsoil.sh index 5d50c4221..5e3a1da57 100755 --- a/reg_tests/global_cycle/C768.lndincsoil.sh +++ b/reg_tests/global_cycle/C768.lndincsoil.sh @@ -77,6 +77,9 @@ if [ $test_failed -ne 0 ]; then echo "*****************************************" echo "<<< C768 LANDINC SOILT CYCLE TEST FAILED. >>>" echo "*****************************************" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $BASE_GSM/reg_tests/update_baseline.sh $HOMEreg "c768.lndincsoil" $commit_num + fi else echo echo "*****************************************" diff --git a/reg_tests/global_cycle/driver.hera.sh b/reg_tests/global_cycle/driver.hera.sh index a781020d0..c049f51fd 100755 --- a/reg_tests/global_cycle/driver.hera.sh +++ b/reg_tests/global_cycle/driver.hera.sh @@ -36,6 +36,13 @@ QUEUE="${QUEUE:-batch}" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/global_cycle diff --git a/reg_tests/global_cycle/driver.jet.sh b/reg_tests/global_cycle/driver.jet.sh index 0d2a1dd7c..0f0ab0c4d 100755 --- a/reg_tests/global_cycle/driver.jet.sh +++ b/reg_tests/global_cycle/driver.jet.sh @@ -34,6 +34,13 @@ QUEUE="${QUEUE:-batch}" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/global_cycle diff --git a/reg_tests/global_cycle/driver.orion.sh b/reg_tests/global_cycle/driver.orion.sh index bf4164e43..3bd5d6dc0 100755 --- a/reg_tests/global_cycle/driver.orion.sh +++ b/reg_tests/global_cycle/driver.orion.sh @@ -34,6 +34,13 @@ QUEUE="${QUEUE:-batch}" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/global_cycle diff --git a/reg_tests/global_cycle/driver.wcoss_cray.sh b/reg_tests/global_cycle/driver.wcoss_cray.sh index f18242917..4c98a52d3 100755 --- a/reg_tests/global_cycle/driver.wcoss_cray.sh +++ b/reg_tests/global_cycle/driver.wcoss_cray.sh @@ -32,6 +32,13 @@ QUEUE="${QUEUE:-dev}" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" export HOMEreg=/gpfs/hps3/emc/global/noscrub/George.Gayno/ufs_utils.git/reg_tests/global_cycle diff --git a/reg_tests/global_cycle/driver.wcoss_dell_p3.sh b/reg_tests/global_cycle/driver.wcoss_dell_p3.sh index 13896deb0..9b1c0cc10 100755 --- a/reg_tests/global_cycle/driver.wcoss_dell_p3.sh +++ b/reg_tests/global_cycle/driver.wcoss_dell_p3.sh @@ -34,6 +34,13 @@ QUEUE="${QUEUE:-dev}" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" export HOMEreg=/gpfs/dell2/emc/modeling/noscrub/George.Gayno/ufs_utils.git/reg_tests/global_cycle diff --git a/reg_tests/grid_gen/c96.uniform.sh b/reg_tests/grid_gen/c96.uniform.sh index 72e4f90f9..6811c71af 100755 --- a/reg_tests/grid_gen/c96.uniform.sh +++ b/reg_tests/grid_gen/c96.uniform.sh @@ -55,6 +55,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 UNIFORM TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $home_dir/reg_tests/update_baseline.sh "${HOMEreg}/.." "c96.uniform" $commit_num + fi else echo "<<< C96 UNIFORM TEST PASSED. >>>" fi diff --git a/reg_tests/grid_gen/c96.viirs.vegt.sh b/reg_tests/grid_gen/c96.viirs.vegt.sh index dd593680d..d0db44538 100755 --- a/reg_tests/grid_gen/c96.viirs.vegt.sh +++ b/reg_tests/grid_gen/c96.viirs.vegt.sh @@ -57,6 +57,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< C96 VIIRS VEGT TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $home_dir/reg_tests/update_baseline.sh "${HOMEreg}/.." "c96.viirs.vegt" $commit_num + fi else echo "<<< C96 VIIRS VEGT TEST PASSED. >>>" fi diff --git a/reg_tests/grid_gen/driver.hera.sh b/reg_tests/grid_gen/driver.hera.sh index b8de3f8d2..9c5b9b97a 100755 --- a/reg_tests/grid_gen/driver.hera.sh +++ b/reg_tests/grid_gen/driver.hera.sh @@ -39,6 +39,13 @@ PROJECT_CODE="${PROJECT_CODE:-fv3-cpu}" # Should not have to change anything below here. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + LOG_FILE=consistency.log SUM_FILE=summary.log export home_dir=$PWD/../.. diff --git a/reg_tests/grid_gen/driver.jet.sh b/reg_tests/grid_gen/driver.jet.sh index 38033430a..f6778a5b7 100755 --- a/reg_tests/grid_gen/driver.jet.sh +++ b/reg_tests/grid_gen/driver.jet.sh @@ -37,6 +37,13 @@ export WORK_DIR="${WORK_DIR}/reg-tests/grid-gen" # Should not have to change anything below here. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + LOG_FILE=consistency.log SUM_FILE=summary.log export home_dir=$PWD/../.. diff --git a/reg_tests/grid_gen/driver.orion.sh b/reg_tests/grid_gen/driver.orion.sh index ba48afe21..8b00621b8 100755 --- a/reg_tests/grid_gen/driver.orion.sh +++ b/reg_tests/grid_gen/driver.orion.sh @@ -46,6 +46,14 @@ export APRUN_SFC=srun export OMP_STACKSIZE=2048m export OMP_NUM_THREADS=24 export machine=ORION + +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/grid_gen/baseline_data rm -fr $WORK_DIR diff --git a/reg_tests/grid_gen/driver.wcoss_cray.sh b/reg_tests/grid_gen/driver.wcoss_cray.sh index 5887676ff..de85aade2 100755 --- a/reg_tests/grid_gen/driver.wcoss_cray.sh +++ b/reg_tests/grid_gen/driver.wcoss_cray.sh @@ -35,6 +35,13 @@ export WORK_DIR="${WORK_DIR}/reg-tests/grid-gen" # Should not have to change anything below here. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export home_dir=$PWD/../.. LOG_FILE=consistency.log SUM_FILE=summary.log diff --git a/reg_tests/grid_gen/driver.wcoss_dell_p3.sh b/reg_tests/grid_gen/driver.wcoss_dell_p3.sh index 3def7e696..9d6bb3eba 100755 --- a/reg_tests/grid_gen/driver.wcoss_dell_p3.sh +++ b/reg_tests/grid_gen/driver.wcoss_dell_p3.sh @@ -35,6 +35,13 @@ export WORK_DIR="${WORK_DIR}/reg-tests/grid-gen" # Should not have to change anything below here. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + LOG_FILE=consistency.log SUM_FILE=summary.log export home_dir=$PWD/../.. diff --git a/reg_tests/grid_gen/esg.regional.sh b/reg_tests/grid_gen/esg.regional.sh index d88a260dc..55963531f 100755 --- a/reg_tests/grid_gen/esg.regional.sh +++ b/reg_tests/grid_gen/esg.regional.sh @@ -61,6 +61,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< ESG REGIONAL TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $home_dir/reg_tests/update_baseline.sh "${HOMEreg}/.." "esg.regional" $commit_num + fi else echo "<<< ESG REGIONAL TEST PASSED. >>>" fi diff --git a/reg_tests/grid_gen/gfdl.regional.sh b/reg_tests/grid_gen/gfdl.regional.sh index 985b498d2..76f94a4f4 100755 --- a/reg_tests/grid_gen/gfdl.regional.sh +++ b/reg_tests/grid_gen/gfdl.regional.sh @@ -64,6 +64,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< GFDL REGIONAL TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $home_dir/reg_tests/update_baseline.sh "${HOMEreg}/.." "gfdl.regional" $commit_num + fi else echo "<<< GFDL REGIONAL TEST PASSED. >>>" fi diff --git a/reg_tests/grid_gen/regional.gsl.gwd.sh b/reg_tests/grid_gen/regional.gsl.gwd.sh index 0a66daeeb..415ca3813 100755 --- a/reg_tests/grid_gen/regional.gsl.gwd.sh +++ b/reg_tests/grid_gen/regional.gsl.gwd.sh @@ -62,6 +62,9 @@ done set +x if [ $test_failed -ne 0 ]; then echo "<<< REGIONAL GSL GWD TEST FAILED. >>>" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + $home_dir/reg_tests/update_baseline.sh "${HOMEreg}/.." "regional.gsl.gwd" $commit_num + fi else echo "<<< REGIONAL GSL GWD TEST PASSED. >>>" fi diff --git a/reg_tests/ice_blend/driver.hera.sh b/reg_tests/ice_blend/driver.hera.sh index 3ce993fe4..b86f370d1 100755 --- a/reg_tests/ice_blend/driver.hera.sh +++ b/reg_tests/ice_blend/driver.hera.sh @@ -43,6 +43,13 @@ export DATA="${DATA}/reg-tests/ice-blend" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export WGRIB=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/wgrib export WGRIB2=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/wgrib2 export COPYGB=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/copygb diff --git a/reg_tests/ice_blend/driver.jet.sh b/reg_tests/ice_blend/driver.jet.sh index 417385dc1..c66b3922b 100755 --- a/reg_tests/ice_blend/driver.jet.sh +++ b/reg_tests/ice_blend/driver.jet.sh @@ -40,6 +40,13 @@ export DATA="${DATA}/reg-tests/ice-blend" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export WGRIB=/apps/wgrib/1.8.1.0b/bin/wgrib export WGRIB2=/apps/wgrib2/0.1.9.6a/bin/wgrib2 export COPYGB=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/grib_util/NCEPLIBS-grib_util/exec/bin/copygb @@ -47,6 +54,7 @@ export COPYGB2=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/grib_util export CNVGRIB=/apps/cnvgrib/1.4.0/bin/cnvgrib export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/ice_blend + export HOMEgfs=$PWD/../.. rm -fr $DATA diff --git a/reg_tests/ice_blend/driver.orion.sh b/reg_tests/ice_blend/driver.orion.sh index 9f63483ba..cf8d559b7 100755 --- a/reg_tests/ice_blend/driver.orion.sh +++ b/reg_tests/ice_blend/driver.orion.sh @@ -43,6 +43,13 @@ export DATA="${DATA}/reg-tests/ice-blend" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export WGRIB=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/wgrib export WGRIB2=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/wgrib2 export COPYGB=/apps/contrib/NCEPLIBS/lib/NCEPLIBS-grib_util/v1.1.1/exec/copygb diff --git a/reg_tests/ice_blend/driver.wcoss_cray.sh b/reg_tests/ice_blend/driver.wcoss_cray.sh index 7556b9b55..3b1250143 100755 --- a/reg_tests/ice_blend/driver.wcoss_cray.sh +++ b/reg_tests/ice_blend/driver.wcoss_cray.sh @@ -40,6 +40,13 @@ export DATA="${DATA}/reg-tests/ice-blend" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export WGRIB=/gpfs/hps/nco/ops/nwprod/grib_util.v1.0.5/exec/wgrib export WGRIB2=/gpfs/hps/nco/ops/nwprod/grib_util.v1.0.5/exec/wgrib2 export COPYGB2=/gpfs/hps/nco/ops/nwprod/grib_util.v1.0.5/exec/copygb2 diff --git a/reg_tests/ice_blend/driver.wcoss_dell_p3.sh b/reg_tests/ice_blend/driver.wcoss_dell_p3.sh index 2d91a3417..be2940dea 100755 --- a/reg_tests/ice_blend/driver.wcoss_dell_p3.sh +++ b/reg_tests/ice_blend/driver.wcoss_dell_p3.sh @@ -29,6 +29,7 @@ source ../../sorc/machine-setup.sh > /dev/null 2>&1 module use ../../modulefiles module load build.$target.intel +module load git module list set -x @@ -40,6 +41,13 @@ export DATA="${DATA}/reg-tests/ice-blend" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export WGRIB="/gpfs/dell1/nco/ops/nwprod/grib_util.v1.1.1/exec/wgrib" export WGRIB2="/gpfs/dell1/nco/ops/nwprod/grib_util.v1.1.1/exec/wgrib2" export COPYGB2="/gpfs/dell1/nco/ops/nwprod/grib_util.v1.1.1/exec/copygb2" diff --git a/reg_tests/ice_blend/ice_blend.sh b/reg_tests/ice_blend/ice_blend.sh index b1c193ca3..fcd90fa35 100755 --- a/reg_tests/ice_blend/ice_blend.sh +++ b/reg_tests/ice_blend/ice_blend.sh @@ -18,7 +18,7 @@ if [ $iret -ne 0 ]; then exit $iret fi -cmp ${DATA}/seaice.5min.blend $HOMEreg/baseline_data/seaice.5min.blend +cmp ${DATA}/seaice.5min.blend $HOMEreg/baseline_data/t1534/seaice.5min.blend iret=$? test_failed=0 if [ $iret -ne 0 ]; then @@ -32,6 +32,10 @@ if [ $test_failed -ne 0 ]; then echo "<<< ICE BLEND TEST FAILED. >>>" echo "*********************************" echo "<<< ICE BLEND TEST FAILED. >>>" > ./summary.log + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + cd $DATA + $HOMEgfs/reg_tests/update_baseline.sh $HOMEreg "t1534" $commit_num + fi else echo echo "*********************************" diff --git a/reg_tests/snow2mdl/driver.hera.sh b/reg_tests/snow2mdl/driver.hera.sh index d83b501e0..11e854954 100755 --- a/reg_tests/snow2mdl/driver.hera.sh +++ b/reg_tests/snow2mdl/driver.hera.sh @@ -43,6 +43,13 @@ export DATA="${DATA}/reg-tests/snow2mdl" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + rm -fr $DATA export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/snow2mdl diff --git a/reg_tests/snow2mdl/driver.jet.sh b/reg_tests/snow2mdl/driver.jet.sh index 6da755ff9..cd06cf513 100755 --- a/reg_tests/snow2mdl/driver.jet.sh +++ b/reg_tests/snow2mdl/driver.jet.sh @@ -40,6 +40,13 @@ export DATA="${DATA}/reg-tests/snow2mdl" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEreg=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/apps/wgrib/1.8.1.0b/bin/wgrib diff --git a/reg_tests/snow2mdl/driver.orion.sh b/reg_tests/snow2mdl/driver.orion.sh index 8ca5ed51b..99ad0c14f 100755 --- a/reg_tests/snow2mdl/driver.orion.sh +++ b/reg_tests/snow2mdl/driver.orion.sh @@ -43,6 +43,13 @@ export DATA="${DATA}/reg-tests/snow2mdl" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + rm -fr $DATA export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/snow2mdl diff --git a/reg_tests/snow2mdl/driver.wcoss_cray.sh b/reg_tests/snow2mdl/driver.wcoss_cray.sh index 197ecb161..c0dc69509 100755 --- a/reg_tests/snow2mdl/driver.wcoss_cray.sh +++ b/reg_tests/snow2mdl/driver.wcoss_cray.sh @@ -40,6 +40,13 @@ export DATA="${DATA}/reg-tests/snow2mdl" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEreg=/gpfs/hps3/emc/global/noscrub/George.Gayno/ufs_utils.git/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/gpfs/hps/nco/ops/nwprod/grib_util.v1.0.2/exec/wgrib diff --git a/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh b/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh index 0f315d391..f1e417587 100755 --- a/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh +++ b/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh @@ -29,6 +29,7 @@ source ../../sorc/machine-setup.sh > /dev/null 2>&1 module use ../../modulefiles module load build.$target.intel +module load git module list set -x @@ -40,6 +41,13 @@ export DATA="${DATA}/reg-tests/snow2mdl" # Should not have to change anything below. #----------------------------------------------------------------------------- +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + export HOMEreg=/gpfs/dell2/emc/modeling/noscrub/George.Gayno/ufs_utils.git/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/gpfs/dell1/nco/ops/nwprod/grib_util.v1.0.6/exec/wgrib diff --git a/reg_tests/snow2mdl/snow2mdl.sh b/reg_tests/snow2mdl/snow2mdl.sh index 4acec05b8..4743ad42b 100755 --- a/reg_tests/snow2mdl/snow2mdl.sh +++ b/reg_tests/snow2mdl/snow2mdl.sh @@ -31,7 +31,7 @@ fi test_failed=0 -cmp ${DATA}/snogrb_model $HOMEreg/baseline_data/snogrb_model +cmp ${DATA}/snogrb_model $HOMEreg/baseline_data/t1534/snogrb_model iret=$? if [ $iret -ne 0 ]; then test_failed=1 @@ -44,6 +44,10 @@ if [ $test_failed -ne 0 ]; then echo "<<< SNOW2MDL TEST FAILED. >>>" echo "*********************************" echo "<<< SNOW2MDL TEST FAILED. >>>" > ./summary.log + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + cd $DATA + $HOMEgfs/reg_tests/update_baseline.sh $HOMEreg "t1534" $commit_num + fi else echo echo "*********************************" diff --git a/reg_tests/update_baseline.sh b/reg_tests/update_baseline.sh new file mode 100755 index 000000000..d0cb329f6 --- /dev/null +++ b/reg_tests/update_baseline.sh @@ -0,0 +1,56 @@ +#!/bin/bash + +set -x + +HOMEreg=$1 +test_name=$2 +commit_num=$3 + +base_dir=$HOMEreg/baseline_data +base_dir_commit=${base_dir}/$test_name.$commit_num + +chmod 755 $base_dir + +if [ -d $base_dir_commit ];then + chmod 777 $base_dir_commit + if [ -d $base_dir_commit/fix_sfc ]; then + chmod 777 $base_dir_commit/fix_sfc + fi + rm -fr $base_dir_commit +fi + +mkdir -p $base_dir_commit + +for files in *.nc snogrb_model seaice.5min.blend +do + if [ -f $files ]; then + cp $files $base_dir_commit + chmod 444 $base_dir_commit/$files + fi +done + +# The grid_gen tests have a subdirectory for +# the surface climo fields. + +if [ -d ./fix_sfc ]; then + mkdir -p $base_dir_commit/fix_sfc + cd fix_sfc + for files in *.nc + do + if [ -f $files ]; then + cp $files $base_dir_commit/fix_sfc + chmod 444 $base_dir_commit/fix_sfc/$files + fi + done + chmod 555 $base_dir_commit/fix_sfc +fi + +chmod 555 $base_dir_commit +rm -f $base_dir/$test_name +cd $base_dir +ln -fs $test_name.$commit_num $test_name + +# move this to driver? +###chmod 555 $base_dir + +exit From 26cd024b82554a3b3f8876ab0fc1669eed96b544 Mon Sep 17 00:00:00 2001 From: Minsuk Ji <57227195+MinsukJi-NOAA@users.noreply.github.com> Date: Mon, 31 Jan 2022 16:24:57 -0500 Subject: [PATCH 021/109] Use ESMF 8.2.0 library Upgrade to version 8.2.0. Part of #143 Fixes #621. --- .github/workflows/debug-docs-test_coverage.yml | 10 +++++----- .github/workflows/intel.yml | 10 +++++----- .github/workflows/linux-mac-nceplibs-mpi.yml | 10 +++++----- .github/workflows/netcdf-versions.yml | 10 +++++----- modulefiles/build.hera.intel.lua | 2 +- modulefiles/build.jet.intel.lua | 2 +- modulefiles/build.orion.intel.lua | 2 +- modulefiles/build.wcoss_cray.intel | 4 +--- modulefiles/build.wcoss_dell_p3.intel.lua | 8 ++++---- tests/chgres_cube/LSanSuppress.supp | 3 +++ tests/sfc_climo_gen/LSanSuppress.supp | 3 +++ 11 files changed, 34 insertions(+), 30 deletions(-) diff --git a/.github/workflows/debug-docs-test_coverage.yml b/.github/workflows/debug-docs-test_coverage.yml index 8aef6c911..96face7b7 100644 --- a/.github/workflows/debug-docs-test_coverage.yml +++ b/.github/workflows/debug-docs-test_coverage.yml @@ -26,16 +26,16 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.1.1-${{ runner.os }}3 + key: esmf-8.2.0-${{ runner.os }}3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' run: | pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_1_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null - tar zxf ESMF_8_1_1.tar.gz - cd esmf-ESMF_8_1_1 + export ESMF_DIR=~/esmf-ESMF_8_2_0 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_2_0.tar.gz &> /dev/null + tar zxf ESMF_8_2_0.tar.gz + cd esmf-ESMF_8_2_0 export ESMF_COMM=mpich3 export ESMF_INSTALL_BINDIR=bin export ESMF_INSTALL_LIBDIR=lib diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index c4fc4aca0..5c747e3f9 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -85,16 +85,16 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.1.1-${{ runner.os }}-intel3 + key: esmf-8.2.0-${{ runner.os }}-intel3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' run: | pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_1_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null - tar zxf ESMF_8_1_1.tar.gz - cd esmf-ESMF_8_1_1 + export ESMF_DIR=~/esmf-ESMF_8_2_0 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_2_0.tar.gz &> /dev/null + tar zxf ESMF_8_2_0.tar.gz + cd esmf-ESMF_8_2_0 export ESMF_COMM=intelmpi export ESMF_INSTALL_BINDIR=bin export ESMF_INSTALL_LIBDIR=lib diff --git a/.github/workflows/linux-mac-nceplibs-mpi.yml b/.github/workflows/linux-mac-nceplibs-mpi.yml index 1cf8df4f1..870024a45 100644 --- a/.github/workflows/linux-mac-nceplibs-mpi.yml +++ b/.github/workflows/linux-mac-nceplibs-mpi.yml @@ -123,17 +123,17 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf--8.1.1-${{ runner.os }}-${{ matrix.mpi_type }}-netcdf-${{ matrix.netcdf_version }}3 + key: esmf--8.2.0-${{ runner.os }}-${{ matrix.mpi_type }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-esmf if: steps.cache-esmf.outputs.cache-hit != 'true' run: | set -x pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_1_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null - tar zxf ESMF_8_1_1.tar.gz - cd esmf-ESMF_8_1_1 + export ESMF_DIR=~/esmf-ESMF_8_2_0 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_2_0.tar.gz &> /dev/null + tar zxf ESMF_8_2_0.tar.gz + cd esmf-ESMF_8_2_0 if [[ ${{ matrix.mpi_type}} == "mpich" ]]; then export ESMF_COMM=mpich3 elif [[ ${{ matrix.mpi_type}} == "openmpi" ]]; then diff --git a/.github/workflows/netcdf-versions.yml b/.github/workflows/netcdf-versions.yml index bc8b4e1a9..a4ec9a5e4 100644 --- a/.github/workflows/netcdf-versions.yml +++ b/.github/workflows/netcdf-versions.yml @@ -76,16 +76,16 @@ jobs: uses: actions/cache@v2 with: path: ~/esmf - key: esmf-8.1.1-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 + key: esmf-8.2.0-${{ runner.os }}-netcdf-${{ matrix.netcdf_version }}3 - name: build-esmf #if: steps.cache-esmf.outputs.cache-hit != 'true' run: | pushd ~ - export ESMF_DIR=~/esmf-ESMF_8_1_1 - wget https://github.com/esmf-org/esmf/archive/ESMF_8_1_1.tar.gz &> /dev/null - tar zxf ESMF_8_1_1.tar.gz - cd esmf-ESMF_8_1_1 + export ESMF_DIR=~/esmf-ESMF_8_2_0 + wget https://github.com/esmf-org/esmf/archive/ESMF_8_2_0.tar.gz &> /dev/null + tar zxf ESMF_8_2_0.tar.gz + cd esmf-ESMF_8_2_0 export ESMF_COMM=mpich3 export ESMF_INSTALL_BINDIR=bin export ESMF_INSTALL_LIBDIR=lib diff --git a/modulefiles/build.hera.intel.lua b/modulefiles/build.hera.intel.lua index 4921502fe..319d7b3ed 100644 --- a/modulefiles/build.hera.intel.lua +++ b/modulefiles/build.hera.intel.lua @@ -61,7 +61,7 @@ load(pathJoin("netcdf", netcdf_ver)) nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" load(pathJoin("nccmp", nccmp_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_1_1" +esmf_ver=os.getenv("esmf_ver") or "8_2_0" load(pathJoin("esmf", esmf_ver)) whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.jet.intel.lua b/modulefiles/build.jet.intel.lua index a0a6d7c54..260fda2cc 100644 --- a/modulefiles/build.jet.intel.lua +++ b/modulefiles/build.jet.intel.lua @@ -28,7 +28,7 @@ load(pathJoin("netcdf", netcdf_ver)) nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" load(pathJoin("nccmp", nccmp_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_1_0_beta_snapshot_27" +esmf_ver=os.getenv("esmf_ver") or "8_2_0" load(pathJoin("esmf", esmf_ver)) w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" diff --git a/modulefiles/build.orion.intel.lua b/modulefiles/build.orion.intel.lua index 78ba117c2..0fabb4ebc 100644 --- a/modulefiles/build.orion.intel.lua +++ b/modulefiles/build.orion.intel.lua @@ -58,7 +58,7 @@ load(pathJoin("netcdf", netcdf_ver)) nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" load(pathJoin("nccmp", nccmp_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_1_0_beta_snapshot_27" +esmf_ver=os.getenv("esmf_ver") or "8_2_0" load(pathJoin("esmf", esmf_ver)) whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.wcoss_cray.intel b/modulefiles/build.wcoss_cray.intel index d8bdc424d..5be5083b3 100644 --- a/modulefiles/build.wcoss_cray.intel +++ b/modulefiles/build.wcoss_cray.intel @@ -31,9 +31,7 @@ setenv ZLIB_ROOT /usrx/local/prod/zlib/1.2.7/intel/haswell setenv PNG_ROOT /usrx/local/prod/png/1.2.49/intel/haswell setenv Jasper_ROOT /usrx/local/prod/jasper/1.900.1/intel/haswell -module use /gpfs/hps3/emc/nems/noscrub/emc.nemspara/soft/modulefiles -#module load esmf/8.0.0 -setenv ESMFMKFILE /gpfs/hps3/emc/nems/noscrub/emc.nemspara/soft/esmf/8.0.0/lib/esmf.mk +module load esmf/820 setenv NETCDF /opt/cray/netcdf/4.3.3.1/INTEL/14.0 module rm gcc module load gcc/6.3.0 diff --git a/modulefiles/build.wcoss_dell_p3.intel.lua b/modulefiles/build.wcoss_dell_p3.intel.lua index bc741a8e3..427692697 100644 --- a/modulefiles/build.wcoss_dell_p3.intel.lua +++ b/modulefiles/build.wcoss_dell_p3.intel.lua @@ -16,7 +16,7 @@ prepend_path("MODULEPATH", "/usrx/local/nceplibs/dev/hpc-stack/libs/hpc-stack/mo hpc_ver=os.getenv("hpc_ver") or "1.1.0" load(pathJoin("hpc", hpc_ver)) -ips_ver=os.getenv("ips_ver") or "18.0.1.163" +ips_ver=os.getenv("ips_ver") or "18.0.5.274" load(pathJoin("hpc-ips", ips_ver)) impi_ver=os.getenv("impi_ver") or "18.0.1" @@ -34,16 +34,16 @@ load(pathJoin("hdf5", hdf5_ver)) netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" load(pathJoin("netcdf", netcdf_ver)) -nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +nccmp_ver=os.getenv("nccmp_ver") or "1.8.9.0" load(pathJoin("nccmp", nccmp_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_1_0_beta_snapshot_27" +esmf_ver=os.getenv("esmf_ver") or "8_2_0" load(pathJoin("esmf", esmf_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" load(pathJoin("bacio", bacio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.1" +g2_ver=os.getenv("g2_ver") or "3.4.2" load(pathJoin("g2", g2_ver)) ip_ver=os.getenv("ip_ver") or "3.3.3" diff --git a/tests/chgres_cube/LSanSuppress.supp b/tests/chgres_cube/LSanSuppress.supp index 5a129f48e..7c73079ce 100644 --- a/tests/chgres_cube/LSanSuppress.supp +++ b/tests/chgres_cube/LSanSuppress.supp @@ -1,2 +1,5 @@ leak:ESMCI +leak:ESMC +leak:esmc leak:esmf +leak:std::vector diff --git a/tests/sfc_climo_gen/LSanSuppress.supp b/tests/sfc_climo_gen/LSanSuppress.supp index 5a129f48e..7c73079ce 100644 --- a/tests/sfc_climo_gen/LSanSuppress.supp +++ b/tests/sfc_climo_gen/LSanSuppress.supp @@ -1,2 +1,5 @@ leak:ESMCI +leak:ESMC +leak:esmc leak:esmf +leak:std::vector From d1bdd106f2c145bdd800eb3f6915bf489fa0ba0d Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 11 Feb 2022 14:14:16 -0500 Subject: [PATCH 022/109] chgres_cube - Run routine 'convert_omega' on all tasks. (#627) When using certain GRIB2 data as input, the vertical velocity must be converted from omega to dzdt. This conversion is controlled by the logical 'conv_omega'. Ensure that logical is set on all MPI tasks. Fixes #626 --- sorc/chgres_cube.fd/input_data.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index dab617f35..965c37df1 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -2457,6 +2457,7 @@ end subroutine read_input_atm_tiled_history_file !! @author George Gayno NCEP/EMC subroutine read_input_atm_grib2_file(localpet) + use mpi use wgrib2api use grib2_util, only : rh2spfh, rh2spfh_gfs, convert_omega @@ -2909,6 +2910,8 @@ subroutine read_input_atm_grib2_file(localpet) enddo endif + call mpi_bcast(conv_omega,1,MPI_LOGICAL,0,MPI_COMM_WORLD,rc) + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT DZDT." call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3081,7 +3084,7 @@ subroutine read_input_atm_grib2_file(localpet) farrayPtr=presptr, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGet", rc) - + call convert_omega(wptr,presptr,tptr,qptr,clb,cub) endif From cb0a3e56d67fd307547c3fcda48e109f7f038d67 Mon Sep 17 00:00:00 2001 From: Ming Hu Date: Thu, 17 Feb 2022 08:11:55 -0700 Subject: [PATCH 023/109] Update FVCOM code to handle sub-domain restart files using multiple cores. (#624) The large domain FV3LAM generates multiple sub-domain restart files instead of a single file. Update FVCOM to work with sub-domain restart files and with multiple cores. Update the unit test for sub-domain files and to check new variables processed by FVCOM (roughness length and sea ice depth). Fixes #623. --- sorc/fvcom_tools.fd/module_ncio.f90 | 286 ++++++++++---------- sorc/fvcom_tools.fd/module_nwp.f90 | 115 ++++---- sorc/fvcom_tools.fd/module_nwp_base.f90 | 10 +- sorc/fvcom_tools.fd/process_FVCOM.f90 | 295 ++++++++++++++------- tests/CMakeLists.txt | 1 + tests/fvcom_tools/ftst_readfvcomnetcdf.F90 | 47 +++- 6 files changed, 444 insertions(+), 310 deletions(-) diff --git a/sorc/fvcom_tools.fd/module_ncio.f90 b/sorc/fvcom_tools.fd/module_ncio.f90 index 548878979..00fc79be8 100644 --- a/sorc/fvcom_tools.fd/module_ncio.f90 +++ b/sorc/fvcom_tools.fd/module_ncio.f90 @@ -121,14 +121,14 @@ subroutine open_nc(this,filename,action,debug_level) elseif(action=="w" .or. action=="W") then status = nf90_open(path = trim(filename), mode = nf90_write, ncid = ncid) else - write(*,*) 'unknow action :', action + write(6,*) 'unknow action :', action stop 123 endif if (status /= nf90_noerr) call this%handle_err(status) this%ncid=ncid if(this%debug_level>0) then - write(*,*) '>>> open file: ',trim(this%filename) + write(6,*) '>>> open file: ',trim(this%filename) endif end subroutine open_nc @@ -280,8 +280,8 @@ subroutine replace_var_nc_char_1d(this,varname,nd1,field) ilength=nd1 ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif call this%replace_var_nc_char(varname,ilength,field) @@ -325,8 +325,8 @@ subroutine replace_var_nc_char_2d(this,varname,nd1,nd2,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) field(1,1) + write(6,*) trim(thissubname),' show samples:' + write(6,*) field(1,1) endif ! call this%replace_var_nc_char(varname,ilength,temp) @@ -377,8 +377,8 @@ subroutine replace_var_nc_char_3d(this,varname,nd1,nd2,nd3,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) field(1,1,1) + write(6,*) trim(thissubname),' show samples:' + write(6,*) field(1,1,1) endif call this%replace_var_nc_char(varname,ilength,temp) @@ -439,7 +439,7 @@ subroutine replace_var_nc_char(this,varname,ilength,field) if(xtype==NF90_CHAR) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype stop 123 endif @@ -458,7 +458,7 @@ subroutine replace_var_nc_char(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -466,7 +466,7 @@ subroutine replace_var_nc_char(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -476,18 +476,18 @@ subroutine replace_var_nc_char(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>replace variable: ',trim(varname) + write(6,'(a,a)') '>>>replace variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -520,8 +520,8 @@ subroutine replace_var_nc_real_1d(this,varname,nd1,field) ilength=nd1 ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif ! call this%replace_var_nc_real(varname,ilength,field) @@ -565,8 +565,8 @@ subroutine replace_var_nc_real_2d(this,varname,nd1,nd2,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) endif call this%replace_var_nc_real(varname,ilength,temp) @@ -620,9 +620,9 @@ subroutine replace_var_nc_real_3d(this,varname,nd1,nd2,nd3,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' + write(6,*) trim(thissubname),' show samples:' do k=1,nd3 - write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) + write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) enddo endif @@ -684,7 +684,7 @@ subroutine replace_var_nc_real(this,varname,ilength,field) if(xtype==NF90_FLOAT) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype stop 123 endif @@ -703,7 +703,7 @@ subroutine replace_var_nc_real(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -711,7 +711,7 @@ subroutine replace_var_nc_real(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -721,18 +721,18 @@ subroutine replace_var_nc_real(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>replace variable: ',trim(varname) + write(6,'(a,a)') '>>>replace variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -767,8 +767,8 @@ subroutine replace_var_nc_double_1d(this,varname,nd1,field) ilength=nd1 ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif ! call this%replace_var_nc_double(varname,ilength,field) @@ -815,8 +815,8 @@ subroutine replace_var_nc_double_2d(this,varname,nd1,nd2,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) endif call this%replace_var_nc_double(varname,ilength,temp) @@ -870,9 +870,9 @@ subroutine replace_var_nc_double_3d(this,varname,nd1,nd2,nd3,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' + write(6,*) trim(thissubname),' show samples:' do k=1,nd3 - write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) + write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) enddo endif @@ -935,7 +935,7 @@ subroutine replace_var_nc_double(this,varname,ilength,field) if(xtype==NF90_DOUBLE) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype stop 123 endif @@ -954,7 +954,7 @@ subroutine replace_var_nc_double(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -962,7 +962,7 @@ subroutine replace_var_nc_double(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -972,18 +972,18 @@ subroutine replace_var_nc_double(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>replace variable: ',trim(varname) + write(6,'(a,a)') '>>>replace variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -1015,8 +1015,8 @@ subroutine replace_var_nc_int_1d(this,varname,nd1,field) ilength=nd1 ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif call this%replace_var_nc_int(varname,ilength,field) @@ -1063,8 +1063,8 @@ subroutine replace_var_nc_int_2d(this,varname,nd1,nd2,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) endif call this%replace_var_nc_int(varname,ilength,temp) @@ -1115,9 +1115,9 @@ subroutine replace_var_nc_int_3d(this,varname,nd1,nd2,nd3,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' + write(6,*) trim(thissubname),' show samples:' do k=1,nd3 - write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) + write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) enddo endif @@ -1179,7 +1179,7 @@ subroutine replace_var_nc_int(this,varname,ilength,field) if(xtype==NF90_INT) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype stop 123 endif @@ -1198,7 +1198,7 @@ subroutine replace_var_nc_int(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -1206,7 +1206,7 @@ subroutine replace_var_nc_int(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -1216,18 +1216,18 @@ subroutine replace_var_nc_int(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims - stop 1234 + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims + stop 1634 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>replace variable: ',trim(varname) + write(6,'(a,a)') '>>>replace variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -1261,11 +1261,11 @@ subroutine get_var_nc_double_1d(this,varname,nd1,field) ! if(nd1==this%ends(1)) then if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) trim(thissubname),' ERROR: dimension does not match.' endif ! end subroutine get_var_nc_double_1d @@ -1314,8 +1314,8 @@ subroutine get_var_nc_double_2d(this,varname,nd1,nd2,field) ! write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) ! endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2) endif deallocate(temp) ! @@ -1372,8 +1372,8 @@ subroutine get_var_nc_double_3d(this,varname,nd1,nd2,nd3,field) ! enddo ! endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) endif deallocate(temp) ! @@ -1431,7 +1431,7 @@ subroutine get_var_nc_double(this,varname,ilength,field) if(xtype==NF90_DOUBLE) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_DOUBLE,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_DOUBLE,' but read in ',xtype stop 123 endif @@ -1444,14 +1444,14 @@ subroutine get_var_nc_double(this,varname,ilength,field) if(status /= nf90_NoErr) call this%handle_err(status) do i=1,nDims dimname=" " - write(*,*) 'dimids(i) = ', dimids(i) + write(6,*) 'dimids(i) = ', dimids(i) status = nf90_inquire_dimension(ncid, dimids(i), dimname, len = ndim) if (status /= nf90_noerr) call this%handle_err(status) ends(i)=ndim this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -1459,7 +1459,7 @@ subroutine get_var_nc_double(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -1469,18 +1469,18 @@ subroutine get_var_nc_double(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>read in variable: ',trim(varname) + write(6,'(a,a)') '>>>read in variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(a,I10)') ' data type : ',this%xtype - write(*,'(a,I10)')' dimension size: ',this%nDims + write(6,'(a,I10)') ' data type : ',this%xtype + write(6,'(a,I10)')' dimension size: ',this%nDims do i=1,this%nDims - write(*,'(a,I5,I10,2x,a)') ' rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(a,I5,I10,2x,a)') ' rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -1514,11 +1514,11 @@ subroutine get_var_nc_real_1d(this,varname,nd1,field) ! if(nd1==this%ends(1)) then if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) trim(thissubname),' ERROR: dimension does not match.' endif ! end subroutine get_var_nc_real_1d @@ -1566,12 +1566,12 @@ subroutine get_var_nc_real_2d(this,varname,nd1,nd2,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2) endif deallocate(temp) ! @@ -1622,14 +1622,14 @@ subroutine get_var_nc_real_3d(this,varname,nd1,nd2,nd3,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' + write(6,*) trim(thissubname),' show samples:' do k=1,nd3 - write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) + write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) enddo endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) endif deallocate(temp) ! @@ -1690,7 +1690,7 @@ subroutine get_var_nc_real(this,varname,ilength,field) if(xtype==NF90_FLOAT) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_FLOAT,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_FLOAT,' but read in ',xtype stop 123 endif @@ -1709,7 +1709,7 @@ subroutine get_var_nc_real(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -1717,7 +1717,7 @@ subroutine get_var_nc_real(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -1727,18 +1727,18 @@ subroutine get_var_nc_real(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>read in variable: ',trim(varname) + write(6,'(a,a)') '>>>read in variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -1772,11 +1772,11 @@ subroutine get_var_nc_int_1d(this,varname,nd1,field) ! if(nd1==this%ends(1)) then if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) trim(thissubname),' ERROR: dimension does not match.' endif ! end subroutine get_var_nc_int_1d @@ -1824,12 +1824,12 @@ subroutine get_var_nc_int_2d(this,varname,nd1,nd2,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2) endif deallocate(temp) ! @@ -1880,14 +1880,14 @@ subroutine get_var_nc_int_3d(this,varname,nd1,nd2,nd3,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' + write(6,*) trim(thissubname),' show samples:' do k=1,nd3 - write(*,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) + write(6,*) 'k,max,min:',k,maxval(field(:,:,k)),minval(field(:,:,k)) enddo endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) endif deallocate(temp) ! @@ -1948,7 +1948,7 @@ subroutine get_var_nc_int(this,varname,ilength,field) if(xtype==NF90_INT) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_INT,' but read in ',xtype stop 123 endif @@ -1967,7 +1967,7 @@ subroutine get_var_nc_int(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -1975,7 +1975,7 @@ subroutine get_var_nc_int(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -1985,18 +1985,18 @@ subroutine get_var_nc_int(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>read in variable: ',trim(varname) + write(6,'(a,a)') '>>>read in variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -2030,11 +2030,11 @@ subroutine get_var_nc_short_1d(this,varname,nd1,field) ! if(nd1==this%ends(1)) then if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) trim(thissubname),' ERROR: dimension does not match.' endif ! end subroutine get_var_nc_short_1d @@ -2082,12 +2082,12 @@ subroutine get_var_nc_short_2d(this,varname,nd1,nd2,field) enddo ! if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) 'max,min:',maxval(field(:,:)),minval(field(:,:)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2) endif deallocate(temp) ! @@ -2145,7 +2145,7 @@ subroutine get_var_nc_short(this,varname,ilength,field) if(xtype==NF90_SHORT) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_SHORT,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_SHORT,' but read in ',xtype stop 123 endif @@ -2164,7 +2164,7 @@ subroutine get_var_nc_short(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -2172,7 +2172,7 @@ subroutine get_var_nc_short(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -2182,18 +2182,18 @@ subroutine get_var_nc_short(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>read in variable: ',trim(varname) + write(6,'(a,a)') '>>>read in variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! @@ -2227,11 +2227,11 @@ subroutine get_var_nc_char_1d(this,varname,nd1,field) ! if(nd1==this%ends(1)) then if(this%debug_level>100) then - write(*,*) trim(thissubname),' show samples:' - write(*,*) (field(i),i=1,min(nd1,10)) + write(6,*) trim(thissubname),' show samples:' + write(6,*) (field(i),i=1,min(nd1,10)) endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) trim(thissubname),' ERROR: dimension does not match.' endif ! end subroutine get_var_nc_char_1d @@ -2280,8 +2280,8 @@ subroutine get_var_nc_char_2d(this,varname,nd1,nd2,field) ! write(*,*) field(1,1) ! endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2) endif deallocate(temp) ! @@ -2336,8 +2336,8 @@ subroutine get_var_nc_char_3d(this,varname,nd1,nd2,nd3,field) ! write(*,*) field(1,1,1) ! endif else - write(*,*) trim(thissubname),' ERROR: dimension does not match.' - write(*,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) + write(6,*) trim(thissubname),' ERROR: dimension does not match.' + write(6,*) nd1,this%ends(1),nd2,this%ends(2),nd3,this%ends(3) endif deallocate(temp) ! @@ -2398,7 +2398,7 @@ subroutine get_var_nc_char(this,varname,ilength,field) if(xtype==NF90_CHAR) then this%xtype=xtype else - write(*,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_CHAR,' but read in ',xtype + write(6,*) trim(thissubname),' ERROR: wrong data type, expect ',NF90_CHAR,' but read in ',xtype stop 123 endif @@ -2417,7 +2417,7 @@ subroutine get_var_nc_char(this,varname,ilength,field) this%ends(i)=ends(i) this%dimname(i)=trim(dimname) if(this%ends(i) < 1) then - write(*,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) + write(6,*) trim(thissubname),' Error, ends dimension should larger than 0 :', ends(i) stop 1234 endif enddo @@ -2425,7 +2425,7 @@ subroutine get_var_nc_char(this,varname,ilength,field) length3d=length2d*ends(3) length4d=length3d*ends(4) if(ilength .ne. length4d) then - write(*,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d + write(6,*) trim(thissubname),'ERROR: ',ilength,' should equal to ',length4d stop 123 endif ! @@ -2435,18 +2435,18 @@ subroutine get_var_nc_char(this,varname,ilength,field) count = ends(1:4)) if(status /= nf90_NoErr) call this%handle_err(status) else - write(*,*) trim(thissubname),'Error: too many dimensions:',nDims + write(6,*) trim(thissubname),'Error: too many dimensions:',nDims stop 1234 endif ! if(this%debug_level>0) then - write(*,'(a,a)') '>>>read in variable: ',trim(varname) + write(6,'(a,a)') '>>>read in variable: ',trim(varname) endif if(this%debug_level>10) then - write(*,'(8x,a,I10)') 'data type : ',this%xtype - write(*,'(8x,a,I10)') 'dimension size: ',this%nDims + write(6,'(8x,a,I10)') 'data type : ',this%xtype + write(6,'(8x,a,I10)') 'dimension size: ',this%nDims do i=1,this%nDims - write(*,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) + write(6,'(8x,a,I5,I10,2x,a)') 'rank, ends, name=',i,this%ends(i),trim(this%dimname(i)) enddo endif ! diff --git a/sorc/fvcom_tools.fd/module_nwp.f90 b/sorc/fvcom_tools.fd/module_nwp.f90 index d0b7b2376..19d8cd52f 100644 --- a/sorc/fvcom_tools.fd/module_nwp.f90 +++ b/sorc/fvcom_tools.fd/module_nwp.f90 @@ -208,15 +208,15 @@ subroutine initial_nwp(this,itype,wcstart) ! If the data type does not match one of the known types, exit. else - write(*,*) 'Unknown data type:', itype + write(6,*) 'Unknown data type:', itype stop 1234 end if this%head => NULL() this%tail => NULL() - write(*,*) 'Finished initial_nwp' - write(*,*) ' ' + write(6,*) 'Finished initial_nwp' + write(6,*) ' ' end subroutine initial_nwp @@ -231,18 +231,18 @@ subroutine list_initial_nwp(this) integer :: k - write(*,*) 'List initial setup for ', this%datatype - write(*,*) 'number of variables ', this%numvar - write(*,*) 'variable index: mask, sst, ice, sfcT, sfcTl' - write(*,'(15x,10I3)') this%i_mask, this%i_sst, this%i_ice, & + write(6,*) 'List initial setup for ', this%datatype + write(6,*) 'number of variables ', this%numvar + write(6,*) 'variable index: mask, sst, ice, sfcT, sfcTl' + write(6,'(15x,10I3)') this%i_mask, this%i_sst, this%i_ice, & & this%i_sfcT, this%i_sfcTl - write(*,*) 'variable name:' + write(6,*) 'variable name:' do k=1,this%numvar - write(*,*) k,trim(this%varnames(k)) + write(6,*) k,trim(this%varnames(k)) enddo - write(*,*) 'Finished list_initial_nwp' - write(*,*) ' ' + write(6,*) 'Finished list_initial_nwp' + write(6,*) ' ' end subroutine list_initial_nwp @@ -265,9 +265,11 @@ end subroutine list_initial_nwp !! @param[inout] sfcTl Skin Temperature in restart file !! @param[inout] zorl Surface roughness length !! @param[inout] hice Ice thickness + !! @param[in] ybegin Start grid point in Y direction for the domain + !! @param[in] yend End grid point in Y direction for the domain !! !! @author David Wright, University of Michigan and GLERL - subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl,zorl,hice) + subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl,zorl,hice,ybegin,yend) class(fcst_nwp) :: this @@ -276,11 +278,13 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g character(len=4), intent(in) :: wcstart integer, intent(in) :: time_to_get + integer, intent(in) :: ybegin,yend integer, intent(inout) :: numlon, numlat, numtimes ! real(r_single), intent(inout) :: mask(:,:), sst(:,:), ice(:,:), sfcT(:,:) real(r_kind), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) & ,iceT(:,:),sfcTl(:,:),zorl(:,:),hice(:,:) +! ! Open the file using module_ncio.f90 code, and find the number of ! lat/lon points @@ -289,12 +293,14 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g call ncdata%get_dim(this%dimnameNS,this%xlat) call ncdata%get_dim(this%dimnameTIME,this%xtime) - write(*,*) 'number of longitudes for file ', filename, this%xlon + write(6,*) 'number of longitudes for file ', filename, this%xlon numlon = this%xlon - write(*,*) 'number of latitudes for file ', filename, this%xlat - numlat = this%xlat - write(*,*) 'number of times for file ', filename, this%xtime + write(6,*) 'number of latitudes for file ', filename, this%xlat + !numlat = this%xlat + numlat = yend-ybegin+1 + write(6,*) 'number of times for file ', filename, this%xtime numtimes = this%xtime + write(6,*) 'the range of Y for this domain is=',ybegin,yend ! Allocate all the arrays to receive data if (wcstart == 'cold' .OR. itype == ' FVCOM') then @@ -309,47 +315,47 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g ! Get variables from the data file, but only if the variable is ! defined for that data type. - write(*,*) 'itype = ', itype - write(*,*) 'wcstart = ', wcstart - write(*,*) 'xlat = ', this%xlat - write(*,*) 'xlon = ', this%xlon - write(*,*) 'xtime = ', this%xtime + write(6,*) 'itype = ', itype + write(6,*) 'wcstart = ', wcstart + write(6,*) 'xlat = ', this%xlat + write(6,*) 'xlon = ', this%xlon + write(6,*) 'xtime = ', this%xtime if (this%i_mask .gt. 0) then call ncdata%get_var(this%varnames(this%i_mask),this%xlon, & this%xlat,this%nwp_mask_c) - mask = this%nwp_mask_c(:,:) + mask = this%nwp_mask_c(:,ybegin:yend) end if if (this%i_sst .gt. 0) then - write(*,*) 'get sst for cold or FVCOM' + write(6,*) 'get sst for cold or FVCOM' call ncdata%get_var(this%varnames(this%i_sst),this%xlon, & this%xlat,this%xtime,this%nwp_sst_c) - sst = this%nwp_sst_c(:,:,time_to_get) + sst = this%nwp_sst_c(:,ybegin:yend,time_to_get) end if if (this%i_ice .gt. 0) then call ncdata%get_var(this%varnames(this%i_ice),this%xlon, & this%xlat,this%xtime,this%nwp_ice_c) - ice = this%nwp_ice_c(:,:,time_to_get) + ice = this%nwp_ice_c(:,ybegin:yend,time_to_get) end if if (this%i_sfcT .gt. 0) then call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, & this%xlat,this%xtime,this%nwp_sfcT_c) - sfcT = this%nwp_sfcT_c(:,:,time_to_get) + sfcT = this%nwp_sfcT_c(:,ybegin:yend,time_to_get) end if if (this%i_iceT .gt. 0) then call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, & this%xlat,this%xtime,this%nwp_iceT_c) - iceT = this%nwp_iceT_c(:,:,time_to_get) + iceT = this%nwp_iceT_c(:,ybegin:yend,time_to_get) end if if (this%i_zorl .gt. 0) then call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, & this%xlat,this%xtime,this%nwp_zorl_c) - zorl = this%nwp_zorl_c(:,:,time_to_get) + zorl = this%nwp_zorl_c(:,ybegin:yend,time_to_get) end if if (this%i_hice .gt. 0) then call ncdata%get_var(this%varnames(this%i_hice),this%xlon, & this%xlat,this%xtime,this%nwp_hice_c) - hice = this%nwp_hice_c(:,:,time_to_get) + hice = this%nwp_hice_c(:,ybegin:yend,time_to_get) end if else if (wcstart == 'warm') then @@ -364,63 +370,63 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g ! Get variables from the data file, but only if the variable is ! defined for that data type. - write(*,*) 'itype = ', itype - write(*,*) 'wcstart =', wcstart - write(*,*) 'xlat = ', this%xlat - write(*,*) 'xlon = ', this%xlon - write(*,*) 'xtime = ', this%xtime + write(6,*) 'itype = ', itype + write(6,*) 'wcstart =', wcstart + write(6,*) 'xlat = ', this%xlat + write(6,*) 'xlon = ', this%xlon + write(6,*) 'xtime = ', this%xtime if (this%i_mask .gt. 0) then call ncdata%get_var(this%varnames(this%i_mask),this%xlon, & this%xlat,this%nwp_mask_w) - mask = this%nwp_mask_w(:,:) + mask = this%nwp_mask_w(:,ybegin:yend) end if if (this%i_sst .gt. 0) then call ncdata%get_var(this%varnames(this%i_sst),this%xlon, & this%xlat,this%nwp_sst_w) - sst = this%nwp_sst_w(:,:) + sst = this%nwp_sst_w(:,ybegin:yend) end if if (this%i_ice .gt. 0) then call ncdata%get_var(this%varnames(this%i_ice),this%xlon, & this%xlat,this%nwp_ice_w) - ice = this%nwp_ice_w(:,:) + ice = this%nwp_ice_w(:,ybegin:yend) end if if (this%i_sfcT .gt. 0) then call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, & this%xlat,this%nwp_sfcT_w) - sfcT = this%nwp_sfcT_w(:,:) + sfcT = this%nwp_sfcT_w(:,ybegin:yend) end if if (this%i_iceT .gt. 0) then call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, & this%xlat,this%nwp_iceT_w) - iceT = this%nwp_iceT_w(:,:) + iceT = this%nwp_iceT_w(:,ybegin:yend) end if if (this%i_sfcTl .gt. 0) then call ncdata%get_var(this%varnames(this%i_sfcTl),this%xlon, & this%xlat,this%nwp_sfcTl_w) - sfcTl = this%nwp_sfcTl_w(:,:) + sfcTl = this%nwp_sfcTl_w(:,ybegin:yend) end if if (this%i_zorl .gt. 0) then call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, & this%xlat,this%nwp_zorl_w) - zorl = this%nwp_zorl_w(:,:) + zorl = this%nwp_zorl_w(:,ybegin:yend) end if if (this%i_hice .gt. 0) then call ncdata%get_var(this%varnames(this%i_hice),this%xlon, & this%xlat,this%nwp_hice_w) - hice = this%nwp_hice_w(:,:) + hice = this%nwp_hice_w(:,ybegin:yend) end if else - write(*,*) 'Choose either "warm" or "cold" for file' + write(6,*) 'Choose either "warm" or "cold" for file' stop 'Error in wcstart. Check spelling or if variable was assigned' end if ! Close the netCDF file. call ncdata%close - write(*,*) 'Finished read_nwp' - write(*,*) ' ' + write(6,*) 'Finished read_nwp' + write(6,*) ' ' end subroutine read_nwp @@ -452,33 +458,34 @@ subroutine finish_nwp(this,itype,wcstart) deallocate(this%nwp_iceT_c) deallocate(this%nwp_zorl_c) deallocate(this%nwp_hice_c) + if (itype==' FVCOM') deallocate(this%dimnameDATE) else if (wcstart == 'warm') then deallocate(this%nwp_mask_w) deallocate(this%nwp_sst_w) deallocate(this%nwp_ice_w) deallocate(this%nwp_sfcT_w) deallocate(this%nwp_iceT_w) + deallocate(this%nwp_sfcTl_w) deallocate(this%nwp_zorl_w) deallocate(this%nwp_hice_w) else - write(*,*) 'no deallocation' + write(6,*) 'no deallocation' end if thisobs => this%head if(.NOT.associated(thisobs)) then - write(*,*) 'No memory to release' + write(6,*) 'No memory to release' return endif do while(associated(thisobs)) -! write(*,*) 'destroy ==',thisobs%name thisobsnext => thisobs%next call thisobs%destroy() thisobs => thisobsnext enddo - write(*,*) 'Finished finish_nwp' - write(*,*) ' ' + write(6,*) 'Finished finish_nwp' + write(6,*) ' ' end subroutine finish_nwp @@ -508,8 +515,8 @@ subroutine get_time_ind_nwp(this,filename,instr,outindex) call ncdata%open(trim(filename),'r',200) call ncdata%get_dim(this%dimnameTIME,this%xtime) call ncdata%get_dim(this%dimnameDATE,this%datelen) - write(*,*) 'xtime = ', this%xtime - write(*,*) 'datelen = ', this%datelen + write(6,*) 'xtime = ', this%xtime + write(6,*) 'datelen = ', this%datelen allocate(this%times(this%datelen,this%xtime)) call ncdata%get_var('Times',this%datelen,this%xtime,this%times) @@ -528,8 +535,8 @@ subroutine get_time_ind_nwp(this,filename,instr,outindex) outindex = -999 deallocate(this%times) call ncdata%close - write(*,*) 'WARNING: Supplied time not found in file: ', trim(instr) - write(*,*) 'Stoppping fvcom_to_FV3 and proceeding without using FVCOM data' + write(6,*) 'WARNING: Supplied time not found in file: ', trim(instr) + write(6,*) 'Stoppping fvcom_to_FV3 and proceeding without using FVCOM data' stop end if diff --git a/sorc/fvcom_tools.fd/module_nwp_base.f90 b/sorc/fvcom_tools.fd/module_nwp_base.f90 index 382826458..42214f262 100644 --- a/sorc/fvcom_tools.fd/module_nwp_base.f90 +++ b/sorc/fvcom_tools.fd/module_nwp_base.f90 @@ -60,7 +60,7 @@ subroutine list_obsbase(this) ! Write out the lon, lat, and time of the ob - write(*,'(a,3f10.3)') 'LIGHTNING OB: longitude, latitude, time =', & + write(6,'(a,3f10.3)') 'LIGHTNING OB: longitude, latitude, time =', & this%lon, this%lat, this%time ! Loop through all variables and print out obs and quality @@ -68,11 +68,11 @@ subroutine list_obsbase(this) numvar = this%numvar if (numvar >= 1) then ! MULTI-DIMENSIONAL EXAMPLE IN module_obs_base.f90 - write(*,'(a4,10F12.2)') 'obs=', (this%obs(i),i=1,numvar) + write(6,'(a4,10F12.2)') 'obs=', (this%obs(i),i=1,numvar) if(this%ifquality) & - write(*,'(a4,10I12)') 'qul=', (this%quality(i),i=1,numvar) + write(6,'(a4,10I12)') 'qul=', (this%quality(i),i=1,numvar) else - write(*,*) 'No obs for this location' + write(6,*) 'No obs for this location' endif end subroutine list_obsbase @@ -105,7 +105,7 @@ subroutine alloc_obsbase(this,numvar,ifquality) if(this%ifquality) allocate(this%quality(numvar)) else - write(*,*) 'alloc_obsbase Error: dimension must be larger than 0:', numvar + write(6,*) 'alloc_obsbase Error: dimension must be larger than 0:', numvar stop 1234 endif diff --git a/sorc/fvcom_tools.fd/process_FVCOM.f90 b/sorc/fvcom_tools.fd/process_FVCOM.f90 index a9a017717..c82121927 100755 --- a/sorc/fvcom_tools.fd/process_FVCOM.f90 +++ b/sorc/fvcom_tools.fd/process_FVCOM.f90 @@ -39,7 +39,8 @@ program process_FVCOM implicit none ! MPI variables - integer :: npe, mype, mypeLocal,ierror + integer :: npe, mype, mypeLocal,ierror + integer,allocatable :: mpi_layout_begin(:),mpi_layout_end(:) ! ! New object-oriented declarations @@ -49,7 +50,7 @@ program process_FVCOM ! Grid variables - character*180 :: geofile + character*180 :: thisfv3file character*2 :: workPath character*1 :: char1 @@ -73,6 +74,8 @@ program process_FVCOM character(len=180) :: wcstart character(len=180) :: inputFVCOMselStr character(len=180), dimension(:), allocatable :: args + integer :: fv3_io_layout_y + integer,allocatable :: fv3_layout_begin(:),fv3_layout_end(:) real(r_kind), allocatable :: fv3ice(:,:), fv3sst(:,:) real(r_kind), allocatable :: fv3sfcT(:,:), fv3mask(:,:) @@ -87,18 +90,21 @@ program process_FVCOM ! SETUP (general control namelist) : integer :: update_type + character(len=4) :: clayout_y + integer :: iy,iblock ! namelist/setup/update_type, t2 ! MPI setup - call MPI_INIT(ierror) - call MPI_COMM_SIZE(mpi_comm_world,npe,ierror) - call MPI_COMM_RANK(mpi_comm_world,mype,ierror) + call MPI_INIT(ierror) + call MPI_COMM_SIZE(mpi_comm_world,npe,ierror) + call MPI_COMM_RANK(mpi_comm_world,mype,ierror) ! ! NCEP LSF has to use all cores allocated to run this application ! but this if check can make sure only one core run through the real code. ! -if(mype==0) then + + write(*,*) 'number of cores=',npe zero = 0.0 ! Get file names from command line arguements @@ -113,99 +119,180 @@ program process_FVCOM ! wcstart: warm (restart) or cold start ! inputFVCOMtimes: string of time to use fv3file=trim(args(1)) - write(*,*) trim(fv3file) + write(*,*) 'surface file=',trim(fv3file) fvcomfile=trim(args(2)) - write(*,*) trim(fvcomfile) + write(*,*) 'fvcom file=',trim(fvcomfile) wcstart=trim(args(3)) - write(*,*) 'warm or cold start = ', wcstart + write(*,*) 'warm or cold start = ', trim(wcstart) inputFVCOMselStr=trim(args(4)) ! read(inputFVCOMselStr,*) inputFVCOMsel - write(*,*) 'select time = ', inputFVCOMselStr - -! Obtain grid parameters + write(*,*) 'select time = ', trim(inputFVCOMselStr) + clayout_y=trim(args(5)) + read(clayout_y,'(I2)') fv3_io_layout_y + if (wcstart == 'cold') then + fv3_io_layout_y=1 + endif + write(*,*) 'subdomain number=',fv3_io_layout_y + if(mype < fv3_io_layout_y) then + write(thisfv3file,'(a,I3.3)') 'stdout_fvcom.',mype + open(6, file=trim(thisfv3file),form='formatted',status='unknown') + write(6,*) '===> start process for core = ', mype + endif +! +! figure out subdomain grid begin and end grid index in Y for each core +! The match the subdomains to each core +! + allocate(fv3_layout_begin(fv3_io_layout_y)) + allocate(fv3_layout_end(fv3_io_layout_y)) + allocate(mpi_layout_begin(npe)) + allocate(mpi_layout_end(npe)) + fv3_layout_begin=0 + fv3_layout_end=0 workPath='./' - write(geofile,'(a,a)') trim(workPath), trim(fv3file) - write(*,*) 'sfc data file', trim(geofile) - call geo%open(trim(geofile),'r',200) - call geo%get_dim("xaxis_1",NLON) - call geo%get_dim("yaxis_1",NLAT) - write(*,*) 'NLON,NLAT:', NLON, NLAT - call geo%close - - write(*,*) 'Finished reading sfc_data grid information.' - write(*,*) ' ' + iy=0 + do ix=1,fv3_io_layout_y + if(fv3_io_layout_y > 1) then + write(thisfv3file,'(a,a,a1,I4.4)') trim(workPath), trim(fv3file),'.',ix-1 + else + write(thisfv3file,'(a,a)') trim(workPath), trim(fv3file) + endif + call geo%open(trim(thisfv3file),'r',200) + call geo%get_dim("yaxis_1",NLAT) + call geo%close + fv3_layout_begin(ix)=iy+1 + fv3_layout_end(ix)=iy+nlat + iy=fv3_layout_end(ix) + enddo ! find dimension + write(6,'(a,20I5)') 'begin index for each subdomain',fv3_layout_begin + write(6,'(a,20I5)') ' end index for each subdomain',fv3_layout_end + + mypeLocal=mype+1 + if(npe==1) then + mpi_layout_begin(mypeLocal)=1 + mpi_layout_end(mypeLocal)=fv3_io_layout_y + else + mpi_layout_begin=0 + mpi_layout_end=0 + do ix=1,fv3_io_layout_y + iy=mod(ix-1,npe)+1 + mpi_layout_end(iy)=mpi_layout_end(iy)+1 + enddo + iy=0 + do ix=1,npe + if(mpi_layout_end(ix) > 0) then + mpi_layout_begin(ix)=iy+1 + mpi_layout_end(ix)=iy+mpi_layout_end(ix) + iy=mpi_layout_end(ix) + else + mpi_layout_begin(ix)=0 + mpi_layout_end(ix)=0 + endif + enddo + endif + write(6,'(a)') 'begin and end domain index for each core:' + write(6,'(20I5)') mpi_layout_begin + write(6,'(20I5)') mpi_layout_end + +if(mypeLocal <= fv3_io_layout_y) then + + do ix=mpi_layout_begin(mypeLocal),mpi_layout_end(mypeLocal) + + write(6,*) 'process subdomain ',ix,' with core ',mype + if(fv3_io_layout_y > 1) then + write(thisfv3file,'(a,a,a1,I4.4)') trim(workPath), trim(fv3file),'.',ix-1 + else + write(thisfv3file,'(a,a)') trim(workPath), trim(fv3file) + endif + write(6,*) 'sfc data file', trim(thisfv3file) + + call geo%open(trim(thisfv3file),'r',200) + call geo%get_dim("xaxis_1",NLON) + call geo%get_dim("yaxis_1",NLAT) + write(6,*) 'NLON,NLAT:', NLON, NLAT + call geo%close + + write(6,*) 'Finished reading sfc_data grid information.' + write(6,*) ' ' +! +! figure out subdomain grid dimension in Y +! + write(6,*) 'the Y dimensions=',fv3_layout_begin(ix),fv3_layout_end(ix) ! Allocate variables for I/O - allocate(fv3ice(nlon,nlat)) - allocate(fv3sfcT(nlon,nlat)) - allocate(fv3sst(nlon,nlat)) - allocate(fv3mask(nlon,nlat)) - allocate(fv3iceT(nlon,nlat)) - allocate(fv3sfcTl(nlon,nlat)) - allocate(fv3zorl(nlon,nlat)) - allocate(fv3hice(nlon,nlat)) - - allocate(lbcice(nlon,nlat)) - allocate(lbcsfcT(nlon,nlat)) - allocate(lbcsst(nlon,nlat)) - allocate(lbcmask(nlon,nlat)) - allocate(lbciceT(nlon,nlat)) - allocate(lbczorl(nlon,nlat)) - allocate(lbchice(nlon,nlat)) + allocate(fv3ice(nlon,nlat)) + allocate(fv3sfcT(nlon,nlat)) + allocate(fv3sst(nlon,nlat)) + allocate(fv3mask(nlon,nlat)) + allocate(fv3iceT(nlon,nlat)) + allocate(fv3sfcTl(nlon,nlat)) + allocate(fv3zorl(nlon,nlat)) + allocate(fv3hice(nlon,nlat)) + + allocate(lbcice(nlon,nlat)) + allocate(lbcsfcT(nlon,nlat)) + allocate(lbcsst(nlon,nlat)) + allocate(lbcmask(nlon,nlat)) + allocate(lbciceT(nlon,nlat)) + allocate(lbczorl(nlon,nlat)) + allocate(lbchice(nlon,nlat)) ! Read fv3 sfc_data.nc before update ! fv3file='sfc_data.nc' ! fv3times: length of time dimension of UFS atmospheric grid (should be 1) ! t1: index of time dimension to pull (should be 1) - fv3times=1 - t1=1 + fv3times=1 + t1=1 - call fcst%initial('FV3LAM',wcstart) - call fcst%list_initial - call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl,fv3zorl,fv3hice) - call fcst%finish('FV3LAM',wcstart) + call fcst%initial('FV3LAM',wcstart) + call fcst%list_initial + call fcst%read_n(trim(thisfv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,& + fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl,fv3zorl,fv3hice, & + 1,nlat) + call fcst%finish('FV3LAM',wcstart) - write(*,*) 'fv3times: ', fv3times - write(*,*) 'time to use: ', t1 + write(6,*) 'fv3times: ', fv3times + write(6,*) 'time to use: ', t1 ! Read FVCOM input datasets ! fvcomfile='fvcom.nc' ! lbctimes: length of time dimension of FVCOM input data (command line input) ! Space infront of ' FVCOM' below is important!! - call fcst%initial(' FVCOM',wcstart) - call fcst%list_initial - call fcst%get_time_ind(trim(fvcomfile),inputFVCOMselStr,indexFVCOMsel) + call fcst%initial(' FVCOM',wcstart) + call fcst%list_initial + call fcst%get_time_ind(trim(fvcomfile),inputFVCOMselStr,indexFVCOMsel) ! t2: index of time dimension to pull from FVCOM - t2=indexFVCOMsel - write(*,*) 'time asked for =', trim(inputFVCOMselStr) - write(*,*) 'time index selected = ', t2 - call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl,lbczorl,lbchice) - call fcst%finish(' FVCOM',wcstart) + t2=indexFVCOMsel + write(6,*) 'time asked for =', trim(inputFVCOMselStr) + write(6,*) 'time index selected = ', t2 + call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2, & + lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl,lbczorl,lbchice, & + fv3_layout_begin(ix),fv3_layout_end(ix)) + call fcst%finish(' FVCOM',wcstart) ! Check that the dimensions match - if (lbclon .ne. nlon .or. lbclat .ne. nlat) then - write(*,*) 'ERROR: FVCOM/FV3 dimensions do not match:' - write(*,*) 'lbclon: ', lbclon - write(*,*) 'nlon: ', nlon - write(*,*) 'lbclat: ', lbclat - write(*,*) 'nlat: ', nlat - stop 'error' - endif - - write(*,*) 'lbctimes: ', lbctimes - write(*,*) 'time to use: ', t2 - - if (t2 .gt. lbctimes) then - write(*,*) 'ERROR: Requested time dimension out of range' - write(*,*) 'Length of time dimension: ', lbctimes - write(*,*) 'Time index to use: ', t2 - stop 'error' - endif + if (lbclon .ne. nlon .or. lbclat .ne. nlat) then + write(6,*) 'ERROR: FVCOM/FV3 dimensions do not match:' + write(6,*) 'lbclon: ', lbclon + write(6,*) 'nlon: ', nlon + write(6,*) 'lbclat: ', lbclat + write(6,*) 'nlat: ', nlat + stop 'error' + endif + + write(6,*) 'lbctimes: ', lbctimes + write(6,*) 'time to use: ', t2 + + if (t2 .gt. lbctimes) then + write(6,*) 'ERROR: Requested time dimension out of range' + write(6,*) 'Length of time dimension: ', lbctimes + write(6,*) 'Time index to use: ', t2 + stop 'error' + endif ! Update with FVCOM fields and process ! ice cover data. Ice fraction is set @@ -276,33 +363,53 @@ program process_FVCOM enddo enddo else - write(*,*) 'Variable wcstart is not set to either warm or cold' + write(6,*) 'Variable wcstart is not set to either warm or cold' end if ! Write out sfc file again - call geo%open(trim(fv3file),'w',300) - call geo%replace_var("tsea",NLON,NLAT,fv3sst) - call geo%replace_var("fice",NLON,NLAT,fv3ice) - call geo%replace_var("slmsk",NLON,NLAT,fv3mask) - call geo%replace_var("tisfc",NLON,NLAT,fv3iceT) - call geo%replace_var("hice",NLON,NLAT,fv3hice) - if (wcstart == 'cold') then + write(6,*) "udpate file=",trim(thisfv3file) + call geo%open(trim(thisfv3file),'w',300) + call geo%replace_var("tsea",NLON,NLAT,fv3sst) + call geo%replace_var("fice",NLON,NLAT,fv3ice) + call geo%replace_var("slmsk",NLON,NLAT,fv3mask) + call geo%replace_var("tisfc",NLON,NLAT,fv3iceT) + call geo%replace_var("hice",NLON,NLAT,fv3hice) + if (wcstart == 'cold') then ! Add_New_Var takes names of (Variable,Dim1,Dim2,Dim3,Long_Name,Units) - call geo%replace_var("zorl",NLON,NLAT,fv3zorl) - call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') - call geo%replace_var('glmsk',NLON,NLAT,lbcmask) - end if - if (wcstart == 'warm') then - call geo%replace_var("zorli",NLON,NLAT,fv3zorl) - call geo%replace_var("tsfc",NLON,NLAT,fv3sfcT) - call geo%replace_var("tsfcl",NLON,NLAT,fv3sfcTl) - call geo%add_new_var('glmsk','xaxis_1','yaxis_1','glmsk','none') - call geo%replace_var('glmsk',NLON,NLAT,lbcmask) - end if - call geo%close - - write(6,*) "=== LOWBC UPDATE SUCCESS ===" + call geo%replace_var("zorl",NLON,NLAT,fv3zorl) + call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') + call geo%replace_var('glmsk',NLON,NLAT,lbcmask) + end if + if (wcstart == 'warm') then + call geo%replace_var("zorli",NLON,NLAT,fv3zorl) + call geo%replace_var("tsfc",NLON,NLAT,fv3sfcT) + call geo%replace_var("tsfcl",NLON,NLAT,fv3sfcTl) + call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') + call geo%replace_var('glmsk',NLON,NLAT,lbcmask) + end if + call geo%close + + deallocate(fv3ice) + deallocate(fv3sfcT) + deallocate(fv3sst) + deallocate(fv3mask) + deallocate(fv3iceT) + deallocate(fv3sfcTl) + deallocate(fv3zorl) + deallocate(fv3hice) + + deallocate(lbcice) + deallocate(lbcsfcT) + deallocate(lbcsst) + deallocate(lbcmask) + deallocate(lbciceT) + deallocate(lbczorl) + deallocate(lbchice) + + write(6,*) "=== LOWBC UPDATE SUCCESS ===",ix + + enddo ! loop through subdomain endif ! mype==0 diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 30fefaa32..894b01b5f 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -4,6 +4,7 @@ # Ed Hartnett 2/11/21 # Add the test subdirecotries. +#add_subdirectory(fvcom_tools) add_subdirectory(filter_topo) add_subdirectory(chgres_cube) add_subdirectory(fre-nctools) diff --git a/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 index 0f8f68e2c..d43fb1f7f 100644 --- a/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 +++ b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 @@ -31,29 +31,36 @@ program readfvcomnetcdf integer :: fv3sst_expected(NUM_VALUES) !expected fv3 sst values real :: fv3ice_expected(NUM_VALUES) !expected fv3 ice values real :: fv3iceT_expected(NUM_VALUES) !expected fv3 ice temp values + real :: fv3zorl_expected(NUM_VALUES) !expected fv3 surface roughness values + real :: fv3hice_expected(NUM_VALUES) !exepcted fv3 ice thickness values integer :: lbcmask_expected(NUM_VALUES) !expected fvcom mask values real :: lbcsst_expected(NUM_VALUES) !expected fvcom sst values real :: lbcice_expected(NUM_VALUES) !expected fvcom ice values real :: lbciceT_expected(NUM_VALUES) !expected fvcom ice temp values + real :: lbcvice_expected(NUM_VALUES) !expected fvcom ice thickness values ! Create allocabable arrays to read from .nc files real, allocatable :: fv3ice(:,:), fv3sst(:,:) real, allocatable :: fv3sfcT(:,:), fv3mask(:,:) real, allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) + real, allocatable :: fv3zorl(:,:), fv3hice(:,:) real, allocatable :: lbcice(:,:), lbcsst(:,:) real, allocatable :: lbcsfcT(:,:), lbcmask(:,:) - real, allocatable :: lbciceT(:,:) - + real, allocatable :: lbciceT(:,:), lbchice(:,:) + real, allocatable :: lbczorl(:,:) ! Expected values from the dummy files data lat_lon_expected_values /5, 5/ data fv3mask_expected /1, 0/ data fv3sst_expected /1, 0/ data fv3ice_expected /.1, 0/ data fv3iceT_expected /.1, 0/ + data fv3zorl_expected /1.1, 0/ + data fv3hice_expected /.1, 0/ data lbcmask_expected /1, 0/ data lbcsst_expected /1, -99.99999/ data lbcice_expected /1, -99.99999/ data lbciceT_expected /1, -99.99999/ + data lbcvice_expected /1, -99.99999/ data t2_expected /2 / !expect second time index from fvcom file type(ncio) :: geo !grid data object @@ -93,16 +100,20 @@ program readfvcomnetcdf allocate(fv3mask(nlon,nlat)) allocate(fv3iceT(nlon,nlat)) allocate(fv3sfcTl(nlon,nlat)) + allocate(fv3zorl(nlon,nlat)) + allocate(fv3hice(nlon,nlat)) allocate(lbcice(nlon,nlat)) allocate(lbcsfcT(nlon,nlat)) allocate(lbcsst(nlon,nlat)) allocate(lbcmask(nlon,nlat)) allocate(lbciceT(nlon,nlat)) + allocate(lbczorl(nlon,nlat)) + allocate(lbchice(nlon,nlat)) !Initialize and read in fv3 sfc data call fcst%initial('FV3LAM',wcstart) - call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl) + call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl,fv3zorl,fv3hice,1,nlat) call fcst%finish('FV3LAM',wcstart) !If variables in fv3 sfc file do not match expected, stop if (abs(fv3mask(1,1) - fv3mask_expected(1)) > EPSILON) stop 5 @@ -117,27 +128,35 @@ program readfvcomnetcdf if (abs(fv3iceT(1,1) - fv3iceT_expected(1)) > EPSILON) stop 9 if (abs(fv3iceT(5,5) - fv3iceT_expected(2)) > EPSILON) stop 10 + if (abs(fv3zorl(1,1) - fv3zorl_expected(1)) > EPSILON) stop 11 + if (abs(fv3zorl(5,5) - fv3zorl_expected(2)) > EPSILON) stop 12 + + if (abs(fv3hice(1,1) - fv3hice_expected(1)) > EPSILON) stop 13 + if (abs(fv3hice(5,5) - fv3hice_expected(2)) > EPSILON) stop 14 + !Initialize and read in fvcom data call fcst%initial(' FVCOM',wcstart) call fcst%get_time_ind(trim(fvcomfile),inputFVCOMselStr,t2) !If second time index is not returned, stop - if (abs(t2 - t2_expected) > EPSILON) stop 11 - call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl) + if (abs(t2 - t2_expected) > EPSILON) stop 15 + call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl,lbczorl,lbchice,1,nlat) call fcst%finish(' FVCOM',wcstart) !If variables in fvcom file do not match expected, stop - if (abs(lbcmask(1,1) - lbcmask_expected(1)) > EPSILON) stop 12 - if (abs(lbcmask(5,5) - lbcmask_expected(2)) > EPSILON) stop 13 + if (abs(lbcmask(1,1) - lbcmask_expected(1)) > EPSILON) stop 16 + if (abs(lbcmask(5,5) - lbcmask_expected(2)) > EPSILON) stop 17 - if (abs(lbcsst(1,1) - lbcsst_expected(1)) > EPSILON) stop 14 - if (abs(lbcsst(5,5) - lbcsst_expected(2)) > EPSILON) stop 15 + if (abs(lbcsst(1,1) - lbcsst_expected(1)) > EPSILON) stop 18 + if (abs(lbcsst(5,5) - lbcsst_expected(2)) > EPSILON) stop 19 - if (abs(lbcice(1,1) - lbcice_expected(1)) > EPSILON) stop 16 - if (abs(lbcice(5,5) - lbcice_expected(2)) > EPSILON) stop 17 + if (abs(lbcice(1,1) - lbcice_expected(1)) > EPSILON) stop 20 + if (abs(lbcice(5,5) - lbcice_expected(2)) > EPSILON) stop 21 - if (abs(lbciceT(1,1) - lbciceT_expected(1)) > EPSILON) stop 18 - if (abs(lbciceT(5,5) - lbciceT_expected(2)) > EPSILON) stop 19 + if (abs(lbciceT(1,1) - lbciceT_expected(1)) > EPSILON) stop 22 + if (abs(lbciceT(5,5) - lbciceT_expected(2)) > EPSILON) stop 23 + + if (abs(lbchice(1,1) - lbcvice_expected(1)) > EPSILON) stop 24 + if (abs(lbchice(5,5) - lbcvice_expected(2)) > EPSILON) stop 25 - print*,"OK" print*,"SUCCESS!" From 570ea3966c125ead7e90b4342be2efc22a8b1f41 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Thu, 17 Feb 2022 10:58:03 -0500 Subject: [PATCH 024/109] Undefined symbols on macOS with Intel compiler (#628) The linker on macOS does not include `common symbols` by default. The top level CMakeLists.txt file was updated to fix this. Fixes #620. --- CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 3657c8ade..519a17200 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -32,6 +32,12 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback") set(CMAKE_Fortran_FLAGS_RELEASE "-O3 -fp-model precise") set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -check -check noarg_temp_created -check nopointer -fp-stack-check -fstack-protector-all -fpe0 -debug -ftrapuv") + if(APPLE) + # The linker on macOS does not include `common symbols` by default. + # Passing the -c flag includes them and fixes an error with undefined symbols. + set(CMAKE_Fortran_ARCHIVE_FINISH " -c ") + set(CMAKE_C_ARCHIVE_FINISH " -c ") + endif() elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -fbacktrace") if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) From 4fdee55ae2d844e1dff968f4df4fb19197455822 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Tue, 22 Mar 2022 13:49:54 -0400 Subject: [PATCH 025/109] chgres_cube - Remove the wgrib2 library from the GRIB2 data read routines. Update routines "read_input_atm_grib2_file", "read_input_sfc_grib2_file", "read_winds" and "read_grib_soil" to read input GRIB2 files using G2LIB instead of WGRIB2. Update routine "define_input_grid_gfs_grib2" to flip the pole of GFS GRIB2 data. WGRIB2 and G2LIB use different conventions for defining global gaussian grids. Update to G2LIB v3.4.3 or higher, which eliminated occasional segmentation faults and slow wall clock times. Add new units test for GRIB2 read routines "read_input_atm_grib2_file" and "read_input_sfc_grib2_file". Part of #591. --- CMakeLists.txt | 2 +- modulefiles/build.hera.gnu.lua | 2 +- modulefiles/build.hera.intel.lua | 2 +- modulefiles/build.jet.intel.lua | 2 +- modulefiles/build.orion.intel.lua | 2 +- modulefiles/build.wcoss_cray.intel | 5 +- modulefiles/build.wcoss_dell_p3.intel.lua | 2 +- reg_tests/chgres_cube/driver.wcoss_dell_p3.sh | 4 +- sorc/chgres_cube.fd/CMakeLists.txt | 1 + sorc/chgres_cube.fd/input_data.F90 | 2575 +++++++++++------ sorc/chgres_cube.fd/model_grid.F90 | 10 +- tests/chgres_cube/CMakeLists.txt | 12 + tests/chgres_cube/LSanSuppress.supp | 1 + tests/chgres_cube/data/files.txt | 1 + tests/chgres_cube/ftst_read_atm_grib2.F90 | 256 ++ tests/chgres_cube/ftst_read_sfc_grib2.F90 | 352 +++ tests/chgres_cube/ftst_sfc_input_data.F90 | 2 +- ush/chgres_cube.sh | 4 +- 18 files changed, 2277 insertions(+), 958 deletions(-) create mode 100644 tests/chgres_cube/ftst_read_atm_grib2.F90 create mode 100644 tests/chgres_cube/ftst_read_sfc_grib2.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 519a17200..38bcfb5ed 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -69,7 +69,7 @@ find_package(nemsio 2.5.0 REQUIRED) find_package(sigio 2.3.0 REQUIRED) find_package(sp 2.3.3 REQUIRED) find_package(ip 3.3.3 REQUIRED) -find_package(g2 3.4.0 REQUIRED) +find_package(g2 3.4.3 REQUIRED) find_package(wgrib2 2.0.8 REQUIRED) find_package(sigio 2.3.0 REQUIRED) diff --git a/modulefiles/build.hera.gnu.lua b/modulefiles/build.hera.gnu.lua index 88aa5ef57..90bca87ae 100644 --- a/modulefiles/build.hera.gnu.lua +++ b/modulefiles/build.hera.gnu.lua @@ -28,7 +28,7 @@ load(pathJoin("esmf", esmf_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" load(pathJoin("bacio", bacio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.1" +g2_ver=os.getenv("g2_ver") or "3.4.3" load(pathJoin("g2", g2_ver)) ip_ver=os.getenv("ip_ver") or "3.3.3" diff --git a/modulefiles/build.hera.intel.lua b/modulefiles/build.hera.intel.lua index 319d7b3ed..48335e748 100644 --- a/modulefiles/build.hera.intel.lua +++ b/modulefiles/build.hera.intel.lua @@ -22,7 +22,7 @@ load(pathJoin("hpc-impi", impi_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" load(pathJoin("bacio", bacio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.1" +g2_ver=os.getenv("g2_ver") or "3.4.3" load(pathJoin("g2", g2_ver)) ip_ver=os.getenv("ip_ver") or "3.3.3" diff --git a/modulefiles/build.jet.intel.lua b/modulefiles/build.jet.intel.lua index 260fda2cc..50f23bb96 100644 --- a/modulefiles/build.jet.intel.lua +++ b/modulefiles/build.jet.intel.lua @@ -52,7 +52,7 @@ load(pathJoin("sfcio", sfcio_ver)) nemsio_ver=os.getenv("nemsio_ver") or "2.5.2" load(pathJoin("nemsio", nemsio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.1" +g2_ver=os.getenv("g2_ver") or "3.4.3" load(pathJoin("g2", g2_ver)) wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" diff --git a/modulefiles/build.orion.intel.lua b/modulefiles/build.orion.intel.lua index 0fabb4ebc..d641cdaf5 100644 --- a/modulefiles/build.orion.intel.lua +++ b/modulefiles/build.orion.intel.lua @@ -19,7 +19,7 @@ load(pathJoin("hpc-impi", impi_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" load(pathJoin("bacio", bacio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.1" +g2_ver=os.getenv("g2_ver") or "3.4.3" load(pathJoin("g2", g2_ver)) ip_ver=os.getenv("ip_ver") or "3.3.3" diff --git a/modulefiles/build.wcoss_cray.intel b/modulefiles/build.wcoss_cray.intel index 5be5083b3..7ae0c107f 100644 --- a/modulefiles/build.wcoss_cray.intel +++ b/modulefiles/build.wcoss_cray.intel @@ -18,7 +18,6 @@ module load cray-hdf5/1.8.14 module use /usrx/local/nceplibs/NCEPLIBS/cmake/install/NCEPLIBS-v1.3.0/modules module load bacio/2.4.1 -module load g2/3.4.1 module load ip/3.3.3 module load nemsio/2.5.2 module load sp/2.3.3 @@ -31,7 +30,11 @@ setenv ZLIB_ROOT /usrx/local/prod/zlib/1.2.7/intel/haswell setenv PNG_ROOT /usrx/local/prod/png/1.2.49/intel/haswell setenv Jasper_ROOT /usrx/local/prod/jasper/1.900.1/intel/haswell +module use /usrx/local/nceplibs/NCEPLIBS/cmake/install/NCEPLIBS-v1.4.0/modules +module load g2/3.4.5 + module load esmf/820 + setenv NETCDF /opt/cray/netcdf/4.3.3.1/INTEL/14.0 module rm gcc module load gcc/6.3.0 diff --git a/modulefiles/build.wcoss_dell_p3.intel.lua b/modulefiles/build.wcoss_dell_p3.intel.lua index 427692697..0c0f3955e 100644 --- a/modulefiles/build.wcoss_dell_p3.intel.lua +++ b/modulefiles/build.wcoss_dell_p3.intel.lua @@ -43,7 +43,7 @@ load(pathJoin("esmf", esmf_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" load(pathJoin("bacio", bacio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.2" +g2_ver=os.getenv("g2_ver") or "3.4.5" load(pathJoin("g2", g2_ver)) ip_ver=os.getenv("ip_ver") or "3.3.3" diff --git a/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh b/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh index 04ab66c72..6f4e8e821 100755 --- a/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh +++ b/reg_tests/chgres_cube/driver.wcoss_dell_p3.sh @@ -76,7 +76,7 @@ bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J chgres01 -W 0:05 -x LOG_FILE=consistency.log02 export OMP_NUM_THREADS=1 -bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J chgres02 -W 0:07 -x -n 6 \ +bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J chgres02 -W 0:10 -x -n 6 \ -R "span[ptile=6]" -R "affinity[core(${OMP_NUM_THREADS}):distribute=balance]" "$PWD/3km.conus.hrrr.gfssdf.grib2.sh" #----------------------------------------------------------------------------- @@ -103,7 +103,7 @@ bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J chgres04 -W 0:05 -x LOG_FILE=consistency.log05 export OMP_NUM_THREADS=1 -bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J chgres05 -W 0:05 -x -n 6 \ +bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J chgres05 -W 0:10 -x -n 6 \ -R "span[ptile=6]" -R "affinity[core(${OMP_NUM_THREADS}):distribute=balance]" "$PWD/13km.conus.rap.grib2.sh" #----------------------------------------------------------------------------- diff --git a/sorc/chgres_cube.fd/CMakeLists.txt b/sorc/chgres_cube.fd/CMakeLists.txt index 7b6ad9388..c148cfb8c 100644 --- a/sorc/chgres_cube.fd/CMakeLists.txt +++ b/sorc/chgres_cube.fd/CMakeLists.txt @@ -42,6 +42,7 @@ target_include_directories(chgres_cube_lib INTERFACE ${mod_dir}) target_link_libraries( chgres_cube_lib PUBLIC + g2::g2_d nemsio::nemsio sfcio::sfcio sigio::sigio diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 965c37df1..420b92955 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -384,8 +384,6 @@ subroutine read_input_sfc_data(localpet) integer, intent(in) :: localpet - integer :: rc - call init_sfc_esmf_fields() !------------------------------------------------------------------------------- @@ -2458,7 +2456,7 @@ end subroutine read_input_atm_tiled_history_file subroutine read_input_atm_grib2_file(localpet) use mpi - use wgrib2api + use grib_mod use grib2_util, only : rh2spfh, rh2spfh_gfs, convert_omega @@ -2467,34 +2465,39 @@ subroutine read_input_atm_grib2_file(localpet) integer, intent(in) :: localpet integer, parameter :: ntrac_max=14 + integer, parameter :: max_levs=1000 character(len=300) :: the_file - character(len=20) :: vlevtyp, vname, lvl_str,lvl_str_space, & - trac_names_grib_1(ntrac_max), & - trac_names_grib_2(ntrac_max), & + character(len=20) :: vname, & trac_names_vmap(ntrac_max), & - tracers_input_grib_1(num_tracers_input), & - tracers_input_grib_2(num_tracers_input), & tmpstr, & method, tracers_input_vmap(num_tracers_input), & - tracers_default(ntrac_max), vname2 - character (len=500) :: metadata + tracers_default(ntrac_max) - integer :: i, j, k, n, lvl_str_space_len + integer :: i, j, k, n integer :: ii,jj integer :: rc, clb(3), cub(3) - integer :: vlev, iret,varnum - integer :: all_empty, o3n - integer :: len_str - integer :: is_missing, intrp_ier, done_print + integer :: vlev, iret,varnum, o3n + integer :: intrp_ier, done_print + integer :: trac_names_oct10(ntrac_max) + integer :: tracers_input_oct10(num_tracers_input) + integer :: trac_names_oct11(ntrac_max) + integer :: tracers_input_oct11(num_tracers_input) + integer :: lugb, lugi, jdisc, jpdt(200), jgdt(200), iscale + integer :: jids(200), jpdtn, jgdtn, octet23, octet29 + integer :: count_spfh, count_rh, count_icmr, count_scliwc + integer :: count_cice, count_rwmr, count_scllwc, count - logical :: lret logical :: conv_omega=.false., & hasspfh=.true., & isnative=.false., & - use_rh=.false. + use_rh=.false. , unpack, & + all_empty, is_missing + + real(esmf_kind_r8), allocatable :: dum2d_1(:,:) + real(esmf_kind_r8) :: rlevs_hold(max_levs) real(esmf_kind_r8), allocatable :: rlevs(:) real(esmf_kind_r4), allocatable :: dummy2d(:,:) real(esmf_kind_r8), allocatable :: dummy3d(:,:,:), dummy2d_8(:,:),& @@ -2509,20 +2512,18 @@ subroutine read_input_atm_grib2_file(localpet) real(esmf_kind_r4), parameter :: lev_no_tr_fill = 20000.0 real(esmf_kind_r4), parameter :: lev_no_o3_fill = 40000.0 + type(gribfield) :: gfld tracers(:) = "NULL" - !trac_names_grib = (/":SPFH:",":CLWR:", "O3MR",":CICE:", ":RWMR:",":SNMR:",":GRLE:", & - ! ":TCDC:", ":NCCICE:",":SPNCR:", ":NCONCD:",":PMTF:",":PMTC:",":TKE:"/) - trac_names_grib_1 = (/":var0_2", ":var0_2", ":var0_2", ":var0_2", ":var0_2",":var0_2", \ - ":var0_2", ":var0_2", ":var0_2", ":var0_2", ":var0_2",":var0_2", \ - ":var0_2", ":var0_2"/) - trac_names_grib_2 = (/"_1_0: ", "_1_22: ", "_14_192:", "_1_23: ", "_1_24: ","_1_25: ", \ - "_1_32: ", "_6_1: ", "_6_29: ", "_1_100: ", "_6_28: ","_13_193:", \ - "_13_192:", "_2_2: "/) + + trac_names_oct10 = (/1, 1, 14, 1, 1, 1, 1, 6, 6, 1, 6, 13, 13, 2 /) + trac_names_oct11 = (/0, 22, 192, 23, 24, 25, 32, 1, 29, 100, 28, 193, 192, 2 /) + trac_names_vmap = (/"sphum ", "liq_wat ", "o3mr ", "ice_wat ", & "rainwat ", "snowwat ", "graupel ", "cld_amt ", "ice_nc ", & "rain_nc ", "water_nc", "liq_aero", "ice_aero", & "sgs_tke "/) + tracers_default = (/"sphum ", "liq_wat ", "o3mr ", "ice_wat ", & "rainwat ", "snowwat ", "graupel ", "cld_amt ", "ice_nc ", & "rain_nc ", "water_nc", "liq_aero", "ice_aero", & @@ -2531,153 +2532,294 @@ subroutine read_input_atm_grib2_file(localpet) the_file = trim(data_dir_input_grid) // "/" // trim(grib2_file_input_grid) print*,"- READ ATMOS DATA FROM GRIB2 FILE: ", trim(the_file) - print*,"- USE INVENTORY FILE ", inv_file - print*,"- OPEN FILE." - inquire(file=the_file,exist=lret) - if (.not.lret) call error_handler("OPENING GRIB2 ATM FILE.", iret) + if (localpet == 0) then + + lugb=14 + lugi=0 + call baopenr(lugb,the_file,iret) + if (iret /= 0) call error_handler("ERROR OPENING GRIB2 FILE.", iret) + + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdt = -9999 ! Array of values in product definition template, set to wildcard + jids = -9999 ! Array of values in identification section, set to wildcard + jgdt = -9999 ! Array of values in grid definition template, set to wildcard + jgdtn = -1 ! Search for any grid definition number. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + +! First, check for the vertical coordinate. If temperture at the 10 hybrid +! level is found, hybrid coordinates are assumed. Otherwise, data is on +! isobaric levels. + + jpdt(1) = 0 ! Sect4/oct 10 - param category - temperature field + jpdt(2) = 0 ! Sect4/oct 11 - param number - temperature + jpdt(10) = 105 ! Sect4/oct 23 - type of level - hybrid + jpdt(12) = 10 ! oct 23 - type of level - value of hybrid level + unpack=.false. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then ! data is on hybrid levels + octet23 = 105 + octet29 = 255 + isnative=.true. + else ! data is on isobaric levels + octet23 = 100 + octet29 = 255 + endif + +! Now count the number of vertical levels by searching for u-wind. +! Store the value of each level. + + rlevs_hold = -999.9 + lev_input = 0 + iret = 0 + j = 0 + jpdt = -9999 + + do + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret /= 0) exit + + if (gfld%discipline == 0) then ! Discipline - meteorological products + if (gfld%ipdtnum == 0) then ! Product definition template number - + ! analysis or forecast at single level. + if (gfld%ipdtmpl(1) == 2 .and. gfld%ipdtmpl(2) == 2) then ! u-wind + ! Sect4/octs 10 and 11. + if (gfld%ipdtmpl(10) == octet23 .and. gfld%ipdtmpl(13) == octet29) then + ! Sect4 octs 23 and 29. + ! Hybrid or isobaric. + lev_input = lev_input + 1 + iscale = 10 ** gfld%ipdtmpl(11) + rlevs_hold(lev_input) = float(gfld%ipdtmpl(12))/float(iscale) + endif + endif + endif + endif + + j = k + enddo - print*,"- READ VERTICAL COORDINATE." - iret = grb2_inq(the_file,inv_file,":var0_2","_0_0:",":10 hybrid level:") - - if (iret <= 0) then - lvl_str = "mb:" - lvl_str_space = " mb:" - lvl_str_space_len = 4 - isnative = .false. - iret = grb2_inq(the_file,inv_file,":UGRD:",lvl_str_space) - lev_input=iret - if (localpet == 0) print*,"- DATA IS ON ", lev_input, " ISOBARIC LEVELS." - else - lvl_str = " level:" - lvl_str_space = " hybrid " - lvl_str_space_len = 7 - isnative = .true. - iret = grb2_inq(the_file,inv_file,":UGRD:",lvl_str_space, " level:") - if (iret < 0) call error_handler("READING VERTICAL LEVEL TYPE.", iret) - lev_input=iret endif + call mpi_barrier(MPI_COMM_WORLD, iret) + call MPI_BCAST(isnative,1,MPI_LOGICAL,0,MPI_COMM_WORLD,iret) + call MPI_BCAST(lev_input,1,MPI_INTEGER,0,MPI_COMM_WORLD,iret) + call MPI_BCAST(rlevs_hold, max_levs, MPI_INTEGER,0,MPI_COMM_WORLD,iret) + allocate(slevs(lev_input)) allocate(rlevs(lev_input)) allocate(dummy3d_col_in(lev_input)) allocate(dummy3d_col_out(lev_input)) levp1_input = lev_input + 1 - -! Get the vertical levels, and search string by sequential reads - - do i = 1,lev_input - iret=grb2_inq(the_file,inv_file,':UGRD:',trim(lvl_str),sequential=i-1,desc=metadata) - if (iret.ne.1) call error_handler(" IN SEQUENTIAL FILE READ.", iret) - - j = index(metadata,':UGRD:') + len(':UGRD:') - k = index(metadata,trim(lvl_str_space)) + len(trim(lvl_str_space))-1 - read(metadata(j:k),*) rlevs(i) +! Jili Dong add sort to re-order isobaric levels. - slevs(i) = metadata(j-1:k) - if (.not. isnative) rlevs(i) = rlevs(i) * 100.0 - if (localpet==0) print*, "- LEVEL = ", slevs(i) + do i = 1, lev_input + rlevs(i) = rlevs_hold(i) enddo -! Jili Dong add sort to re-order isobaric levels. - call quicksort(rlevs,1,lev_input) - if (.not. isnative) then + do i = 1, lev_input + if (isnative) then + write(slevs(i), '(i6)') nint(rlevs(i)) + slevs(i) = trim(slevs(i)) // " hybrid" + else + write(slevs(i), '(f11.2)') rlevs(i) + slevs(i) = trim(slevs(i)) // " Pa" + endif + enddo + + if(localpet == 0) then do i = 1,lev_input - write(slevs(i),"(F20.10)") rlevs(i)/100.0 - len_str = len_trim(slevs(i)) + print*, "- LEVEL AFTER SORT = ",trim(slevs(i)) + enddo + endif - do while (slevs(i)(len_str:len_str) .eq. '0') - slevs(i) = slevs(i)(:len_str-1) - len_str = len_str - 1 - end do +! Check to see if specfic humidity exists at all the same levels as ugrd. + + if (localpet == 0) then + + jpdt = -9999 + jpdt(1) = 1 ! Sect4/oct 10 - param category - moisture + jpdt(2) = 0 ! Sect4/oct 11 - param number - specific humidity + if (isnative) then + jpdt(10) = 105 ! Sect4/oct 23 - type of level - hybrid + else + jpdt(10) = 100 ! Sect4/oct 23 - type of level - isobaric + endif + unpack=.false. + + count_spfh=0 - if (slevs(i)(len_str:len_str) .eq. '.') then - slevs(i) = slevs(i)(:len_str-1) - len_str = len_str - 1 - end if + do vlev = 1, lev_input + j = 0 + jpdt(12) = nint(rlevs(vlev)) + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) - slevs(i) = trim(slevs(i)) + if (iret == 0) then + count_spfh = count_spfh + 1 + endif - slevs(i) = ":"//trim(adjustl(slevs(i)))//" mb:" - if (localpet==0) print*, "- LEVEL AFTER SORT = ",slevs(i) enddo - endif -! Is SPFH on full levels Jili Dong - do vlev = 1, lev_input - iret = grb2_inq(the_file,inv_file,':SPFH:',slevs(vlev)) - if (iret <= 0) then - use_rh = .TRUE. - if (localpet == 0) print*, ':SPFH on level '//trim(slevs(vlev))//' does not exist. & - Will read in RH and convert to SPFH instead.' - exit - end if - end do + jpdt(1) = 1 ! Sec4/oct 10 - param category - moisture + jpdt(2) = 1 ! Sec4/oct 11 - param number - rel humidity + count_rh=0 - - if (localpet == 0) print*,"- FIND SPFH OR RH IN FILE" - iret = grb2_inq(the_file,inv_file,trim(trac_names_grib_1(1)),trac_names_grib_2(1),lvl_str_space) - - if (iret <= 0 .or. use_rh) then - iret = grb2_inq(the_file,inv_file, ':var0_2','_1_1:',lvl_str_space) - if (iret <= 0) call error_handler("READING ATMOSPHERIC WATER VAPOR VARIABLE.", iret) - hasspfh = .false. - trac_names_grib_2(1)='_1_1:' - if (localpet == 0) print*,"- FILE CONTAINS RH." - else - if (localpet == 0) print*,"- FILE CONTAINS SPFH." - endif - - if (localpet == 0) print*,"- FIND ICMR, SCLIWC, OR CICE IN FILE" - iret = grb2_inq(the_file,inv_file,trac_names_grib_1(4),trac_names_grib_2(4),lvl_str_space) + do vlev = 1, lev_input + j = 0 + jpdt(12) = nint(rlevs(vlev)) - if (iret <= 0) then - vname = trac_names_vmap(4) - print*, "vname = ", vname - call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & - this_field_var_name=tmpstr,loc=varnum) - iret = grb2_inq(the_file,inv_file, ':var0_2','_1_84:',lvl_str_space) - if (iret <= 0) then - iret = grb2_inq(the_file,inv_file, ':var0_2','_6_0:',lvl_str_space) - if (iret <= 0 ) then - call handle_grib_error(vname, slevs(1),method,value,varnum,rc,var=dummy2d) - else - trac_names_grib_2(4) = '_6_0' - if (localpet == 0) print*,"- FILE CONTAINS CICE." - endif + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then + count_rh = count_rh + 1 + endif + enddo + + if (count_spfh /= lev_input) then + use_rh = .true. + endif + + if (count_spfh == 0 .or. use_rh) then + if (count_rh == 0) then + call error_handler("READING ATMOSPHERIC WATER VAPOR VARIABLE.", 2) + endif + hasspfh = .false. ! Will read rh and convert to specific humidity. + trac_names_oct10(1) = 1 + trac_names_oct11(1) = 1 + print*,"- FILE CONTAINS RH." else - trac_names_grib_2(4)='_1_84:' - if (localpet == 0) print*,"- FILE CONTAINS SCLIWC." + print*,"- FILE CONTAINS SPFH." endif - else - if (localpet == 0) print*,"- FILE CONTAINS ICMR." + endif + + call MPI_BARRIER(MPI_COMM_WORLD, rc) + call MPI_BCAST(hasspfh,1,MPI_LOGICAL,0,MPI_COMM_WORLD,rc) - if (localpet == 0) print*,"- FIND CLWMR or SCLLWC IN FILE" - iret = grb2_inq(the_file,inv_file,trac_names_grib_1(5),trac_names_grib_2(5),lvl_str_space) +! Search for and count the number of tracers in the file. - if (iret <= 0) then - vname = trac_names_vmap(5) - print*, "vname = ", vname - call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & - this_field_var_name=tmpstr,loc=varnum) - iret = grb2_inq(the_file,inv_file, ':var0_2','_1_83:',lvl_str_space) - if (iret <= 0) then - call handle_grib_error(vname, slevs(1),method,value,varnum,rc,var=dummy2d) - elseif (iret <=0 .and. rc .ne. 1) then - call error_handler("READING CLOUD WATER VARIABLE.", iret) + if (localpet == 0) then + + jpdt = -9999 + if (isnative) then + jpdt(10) = 105 ! Sect4/oct 23 - type of level - hybrid else - trac_names_grib_2(4)='_1_83:' - if (localpet == 0) print*,"- FILE CONTAINS SCLLWC." + jpdt(10) = 100 ! Sect4/oct 23 - type of level - isobaric endif - else - if (localpet == 0) print*,"- FILE CONTAINS CLWMR." - endif + unpack=.false. + + count_icmr=0 + count_scliwc=0 + count_cice=0 + count_rwmr=0 + count_scllwc=0 + + do vlev = 1, lev_input + + j = 0 + jpdt(1) = 1 ! Sect4/oct 10 - param category - moisture + jpdt(2) = 23 ! Sect4/oct 11 - param number - ice water mixing ratio + jpdt(12) = nint(rlevs(vlev)) + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then + count_icmr = count_icmr + 1 + endif + + j = 0 + jpdt(1) = 1 ! Sect4/oct 10 - param category - moisture + jpdt(2) = 84 ! Sect4/oct 11 - param number - cloud ice water content. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then + count_scliwc = count_scliwc + 1 + endif + + j = 0 + jpdt(1) = 6 ! Sect4/oct 10 - param category - clouds + jpdt(2) = 0 ! Sect4/oct 11 - param number - cloud ice + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then + count_cice = count_cice + 1 + endif + + j = 0 + jpdt(1) = 1 ! Sect4/oct 10 - param category - moisture + jpdt(2) = 24 ! Sect4/oct 11 - param number - rain mixing ratio + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then + count_rwmr = count_rwmr + 1 + endif + + j = 0 + jpdt(1) = 1 ! Sect4/oct 10 - param category - moisture + jpdt(2) = 83 ! Sect4/oct 11 - param number - specific cloud liquid + ! water content. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then + count_scllwc = count_scllwc + 1 + endif + + enddo + + if (count_icmr == 0) then + if (count_scliwc == 0) then + if (count_cice == 0) then + print*,'- FILE DOES NOT CONTAIN CICE.' + else + trac_names_oct10(4) = 6 ! Sect4/oct 10 - param category - clouds + trac_names_oct11(4) = 0 ! Sect4/oct 11 - param number - cloud ice + print*,"- FILE CONTAINS CICE." + endif + else + trac_names_oct10(4) = 1 ! Sect4/oct 10 - param category - moisture + trac_names_oct11(4) = 84 ! Sect4/oct 11 - param number - cloud ice water content. + print*,"- FILE CONTAINS SCLIWC." + endif + else + print*,"- FILE CONTAINS ICMR." + endif ! count of icmr + + if (count_rwmr == 0) then + if (count_scllwc == 0) then + print*,"- FILE DOES NOT CONTAIN SCLLWC." + else + trac_names_oct10(4) = 1 ! Sect4/oct 10 - param category - moisture + trac_names_oct11(4) = 83 ! Sect4/oct 11 - param number - specific cloud liquid + ! water content. + print*,"- FILE CONTAINS SCLLWC." + endif + else + print*,"- FILE CONTAINS CLWMR." + endif + + endif ! count of tracers/localpet = 0 + call MPI_BARRIER(MPI_COMM_WORLD, rc) + call MPI_BCAST(trac_names_oct10,ntrac_max,MPI_INTEGER,0,MPI_COMM_WORLD,rc) + call MPI_BCAST(trac_names_oct11,ntrac_max,MPI_INTEGER,0,MPI_COMM_WORLD,rc) + print*,"- COUNT NUMBER OF TRACERS TO BE READ IN BASED ON PHYSICS SUITE TABLE" do n = 1, num_tracers_input @@ -2685,17 +2827,14 @@ subroutine read_input_atm_grib2_file(localpet) i = maxloc(merge(1.,0.,trac_names_vmap == vname),dim=1) - tracers_input_grib_1(n) = trac_names_grib_1(i) - tracers_input_grib_2(n) = trac_names_grib_2(i) tracers_input_vmap(n)=trac_names_vmap(i) tracers(n)=tracers_default(i) if(trim(tracers(n)) .eq. "o3mr") o3n = n - enddo + tracers_input_oct10(n) = trac_names_oct10(i) + tracers_input_oct11(n) = trac_names_oct11(i) - if (localpet==0) then - print*, "- NUMBER OF TRACERS IN THE INPUT FILE = ", num_tracers_input - endif + enddo !--------------------------------------------------------------------------- ! Initialize esmf atmospheric fields. @@ -2707,10 +2846,12 @@ subroutine read_input_atm_grib2_file(localpet) allocate(dummy2d(i_input,j_input)) allocate(dummy2d_8(i_input,j_input)) allocate(dummy3d(i_input,j_input,lev_input)) + allocate(dum2d_1(i_input,j_input)) else allocate(dummy2d(0,0)) allocate(dummy2d_8(0,0)) allocate(dummy3d(0,0,0)) + allocate(dum2d_1(0,0)) endif !---------------------------------------------------------------------------------- @@ -2720,98 +2861,171 @@ subroutine read_input_atm_grib2_file(localpet) !---------------------------------------------------------------------------------- if (localpet == 0) then + print*,"- READ TEMPERATURE." - vname = ":TMP:" - do vlev = 1, lev_input - iret = grb2_inq(the_file,inv_file,vname,slevs(vlev),data2=dummy2d) - if (iret<=0) then - call error_handler("READING IN TEMPERATURE AT LEVEL "//trim(slevs(vlev)),iret) - endif - dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8) - print*,'temp check after read ',vlev, dummy3d(1,1,vlev) - enddo - endif + + jdisc = 0 ! search for discipline - meteorological products + j = 0 ! search at beginning of file. + jpdt = -9999 ! array of values in product definition template, set to wildcard + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + jpdt(1) = 0 ! Sect 4/oct 10 - param category - temperature + jpdt(2) = 0 ! Sect 4/oct 11 - param number - temperature + + if (isnative) then + jpdt(10) = 105 ! Sect 4/oct 23 - type of level - hybrid + else + jpdt(10) = 100 ! Sect 4/oct 23 - type of level - isobaric + endif + + unpack=.true. + + do vlev = 1, lev_input + + jpdt(12) = nint(rlevs(vlev)) + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + if (iret /= 0) then + call error_handler("READING IN TEMPERATURE AT LEVEL "//trim(slevs(vlev)),iret) + endif + + dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) ) + + dummy3d(:,:,vlev) = dum2d_1 + + enddo + + endif ! Read of temperature if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldScatter", rc) +! Read tracers + do n = 1, num_tracers_input if (localpet == 0) print*,"- READ ", trim(tracers_input_vmap(n)) + vname = tracers_input_vmap(n) call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & this_field_var_name=tmpstr,loc=varnum) + if (n==1 .and. .not. hasspfh) then - print*,"- CALL FieldGather TEMPERATURE." - call ESMF_FieldGather(temp_input_grid,dummy3d,rootPet=0, tile=1, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + print*,"- CALL FieldGather TEMPERATURE." + call ESMF_FieldGather(temp_input_grid,dummy3d,rootPet=0, tile=1, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) endif if (localpet == 0) then - vname = trim(tracers_input_grib_1(n)) - vname2 = trim(tracers_input_grib_2(n)) - iret = grb2_inq(the_file,inv_file,vname,lvl_str_space,vname2) + + jdisc = 0 ! search for discipline - meteorological products + jpdt = -9999 ! array of values in product definition template, set to wildcard + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + unpack = .false. + if (isnative) then + jpdt(10) = 105 ! Sect4/oct 23 - type of level - hybrid + else + jpdt(10) = 100 ! Sect4/oct 23 - type of level - isobaric + endif + + count = 0 + + do vlev = 1, lev_input + + j = 0 + jpdt(1) = tracers_input_oct10(n) + jpdt(2) = tracers_input_oct11(n) + jpdt(12) = nint(rlevs(vlev)) + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then + count = count + 1 + endif + + enddo + iret=count ! Check to see if file has any data for this tracer if (iret == 0) then - all_empty = 1 + all_empty = .true. else - all_empty = 0 + all_empty = .false. endif - is_missing = 0 + is_missing = .false. + do vlev = 1, lev_input - iret = grb2_inq(the_file,inv_file,vname,slevs(vlev),vname2,data2=dummy2d) - - if (iret <= 0) then - if (trim(method) .eq. 'intrp' .and. all_empty == 0) then + + unpack=.true. + j = 0 + jpdt(1) = tracers_input_oct10(n) + jpdt(2) = tracers_input_oct11(n) + jpdt(12) = nint(rlevs(vlev) ) + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret == 0) then ! found data + dummy2d = reshape(gfld%fld, (/i_input,j_input/) ) + else ! did not find data. + if (trim(method) .eq. 'intrp' .and. .not.all_empty) then dummy2d = intrp_missing - is_missing = 1 + is_missing = .true. else ! Abort if input data has some data for current tracer, but has ! missing data below 200 mb/ above 400mb - if (all_empty == 0 .and. n == o3n) then + if (.not.all_empty .and. n == o3n) then if (rlevs(vlev) .lt. lev_no_o3_fill) & call error_handler("TRACER "//trim(tracers(n))//" HAS MISSING DATA AT "//trim(slevs(vlev))//& ". SET MISSING VARIABLE CONDITION TO 'INTRP' TO AVOID THIS ERROR", 1) - elseif (all_empty == 0 .and. n .ne. o3n) then + elseif (.not.all_empty .and. n .ne. o3n) then if (rlevs(vlev) .gt. lev_no_tr_fill) & call error_handler("TRACER "//trim(tracers(n))//" HAS MISSING DATA AT "//trim(slevs(vlev))//& ". SET MISSING VARIABLE CONDITION TO 'INTRP' TO AVOID THIS ERROR.", 1) endif ! If entire array is empty and method is set to intrp, switch method to fill - if (trim(method) .eq. 'intrp' .and. all_empty == 1) method='set_to_fill' + if (trim(method) .eq. 'intrp' .and. all_empty) method='set_to_fill' call handle_grib_error(vname, slevs(vlev),method,value,varnum,iret,var=dummy2d) if (iret==1) then ! missing_var_method == skip or no entry - if (trim(vname2)=="_1_0:" .or. trim(vname2) == "_1_1:" .or. & - trim(vname2) == ":14:192:") then + if ( (tracers_input_oct10(n) == 1 .and. tracers_input_oct11(n) == 0) .or. & ! spec humidity + (tracers_input_oct10(n) == 1 .and. tracers_input_oct11(n) == 1) .or. & ! rel humidity + (tracers_input_oct10(n) == 14 .and. tracers_input_oct11(n) == 192) ) then ! ozone call error_handler("READING IN "//trim(tracers(n))//" AT LEVEL "//trim(slevs(vlev))& //". SET A FILL VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret) endif endif endif ! method intrp endif !iret<=0 - + if (n==1 .and. .not. hasspfh) then if (trim(external_model) .eq. 'GFS') then - print *,'CALRH GFS' + print *,'- CALL CALRH GFS' call rh2spfh_gfs(dummy2d,rlevs(vlev),dummy3d(:,:,vlev)) else - print *,'CALRH non-GFS' + print *,'- CALL CALRH non-GFS' call rh2spfh(dummy2d,rlevs(vlev),dummy3d(:,:,vlev)) end if endif - print*,'tracer ',vlev, maxval(dummy2d),minval(dummy2d) dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8) + enddo !vlev + ! Jili Dong interpolation for missing levels - if (is_missing .gt. 0 .and. trim(method) .eq. 'intrp') then - print *,'intrp tracer '//trim(tracers(n)) + if (is_missing .and. trim(method) .eq. 'intrp') then + print *,'- INTERPOLATE TRACER '//trim(tracers(n)) done_print = 0 do jj = 1, j_input do ii = 1, i_input @@ -2841,7 +3055,7 @@ subroutine read_input_atm_grib2_file(localpet) endif ! intrp_missing ! zero out negative tracers from interpolation/extrapolation where(dummy3d(:,:,vlev) .lt. 0.0) dummy3d(:,:,vlev) = 0.0 - print*,'tracer af intrp',vlev, maxval(dummy3d(:,:,vlev)),minval(dummy3d(:,:,vlev)) +! print*,'tracer af intrp',vlev, maxval(dummy3d(:,:,vlev)),minval(dummy3d(:,:,vlev)) end do !nlevs do end if !if intrp endif !localpet == 0 @@ -2855,7 +3069,7 @@ subroutine read_input_atm_grib2_file(localpet) deallocate(dummy3d_col_in, dummy3d_col_out) -call read_winds(the_file,inv_file,u_tmp_3d,v_tmp_3d, localpet) + call read_winds(u_tmp_3d,v_tmp_3d,localpet,isnative,rlevs,lugb) if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT U-WIND." call ESMF_FieldScatter(u_input_grid, u_tmp_3d, rootpet=0, rc=rc) @@ -2868,47 +3082,90 @@ subroutine read_input_atm_grib2_file(localpet) call error_handler("IN FieldScatter", rc) if (localpet == 0) then + print*,"- READ SURFACE PRESSURE." - vname = ":var0_2" - vname2 = "_3_0:" - vlevtyp = ":surface:" - iret = grb2_inq(the_file,inv_file,vname,vname2,vlevtyp,data2=dummy2d) - if (iret <= 0) call error_handler("READING SURFACE PRESSURE RECORD.", iret) - dummy2d_8 = real(dummy2d,esmf_kind_r8) - endif + jdisc = 0 ! search for discipline - meteorological products + j = 0 ! search at beginning of file. + jpdt = -9999 ! array of values in product definition template, set to wildcard + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + jpdt(1) = 3 ! Sect4/oct 10 - param category - mass + jpdt(2) = 0 ! Sect4/oct 11 - param number - pressure + jpdt(10) = 1 ! Sect4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + if (iret /= 0) call error_handler("READING SURFACE PRESSURE RECORD.", iret) + + dummy2d_8 = reshape(gfld%fld, (/i_input,j_input/) ) + + endif ! Read surface pressure if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE." call ESMF_FieldScatter(ps_input_grid, dummy2d_8, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldScatter", rc) +! Read dzdt. + if (localpet == 0) then + print*,"- READ DZDT." vname = "dzdt" call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & loc=varnum) - vname = ":var0_2" - vname2 = "_2_9:" + + jdisc = 0 ! search for discipline - meteorological products + j = 0 ! search at beginning of file. + jpdt = -9999 ! array of values in product definition template, set to wildcard + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + jpdt(1) = 2 ! Sect4/oct 10 - param category - momentum + jpdt(2) = 9 ! Sect4/oct 11 - param number - dzdt + + if (isnative) then + jpdt(10) = 105 ! Sect4/oct 23 - type of level - hybrid + else + jpdt(10) = 100 ! Sect4/oct 23 - type of level - isobaric + endif + + unpack=.true. + do vlev = 1, lev_input - iret = grb2_inq(the_file,inv_file,vname,vname2,slevs(vlev),data2=dummy2d) - if (iret <= 0 ) then + + jpdt(12) = nint(rlevs(vlev)) + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret /= 0) then ! dzdt not found, look for omega. print*,"DZDT not available at level ", trim(slevs(vlev)), " so checking for VVEL" - vname2 = "_2_8:" - iret = grb2_inq(the_file,inv_file,vname,vname2,slevs(vlev),data2=dummy2d) - if (iret <= 0) then - call handle_grib_error(vname, slevs(vlev),method,value,varnum,iret,var=dummy2d) - if (iret==1) then ! missing_var_method == skip - cycle - endif + jpdt(2) = 8 ! Sect4/oct 11 - parameter number - omega + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + if (iret /= 0) then + call handle_grib_error(vname, slevs(vlev),method,value,varnum,iret,var8=dum2d_1) + if (iret==1) then ! missing_var_method == skip + cycle + endif else - conv_omega = .true. + conv_omega = .true. + dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) ) endif - + else ! found dzdt + dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) ) endif - print*,'dzdt ',vlev, maxval(dummy2d),minval(dummy2d) - dummy3d(:,:,vlev) = dummy2d + + dummy3d(:,:,vlev) = dum2d_1 + enddo - endif + + endif ! Read of dzdt call mpi_bcast(conv_omega,1,MPI_LOGICAL,0,MPI_COMM_WORLD,rc) @@ -2917,15 +3174,30 @@ subroutine read_input_atm_grib2_file(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldScatter", rc) +! Read terrain + if (localpet == 0) then + print*,"- READ TERRAIN." - vname = ":var0_2" - vname2 = "_3_5:" - vlevtyp = ":surface:" - iret = grb2_inq(the_file,inv_file,vname,vname2,vlevtyp,data2=dummy2d) - if (iret <= 0) call error_handler("READING TERRAIN HEIGHT RECORD.", iret) - dummy2d_8 = real(dummy2d,esmf_kind_r8) - endif + jdisc = 0 ! search for discipline - meteorological products + j = 0 ! search at beginning of file. + jpdt = -9999 ! array of values in product definition template, set to wildcard + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + jpdt(1) = 3 ! Sect4/oct 10 - param category - mass + jpdt(2) = 5 ! Sect4/oct 11 - param number - geopotential height + jpdt(10) = 1 ! Sect4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + if (iret /= 0) call error_handler("READING TERRAIN HEIGHT RECORD.", iret) + + dummy2d_8 = reshape(gfld%fld, (/i_input,j_input/) ) + + endif ! read of terrain. if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN." call ESMF_FieldScatter(terrain_input_grid, dummy2d_8, rootpet=0, rc=rc) @@ -2935,6 +3207,7 @@ subroutine read_input_atm_grib2_file(localpet) deallocate(dummy2d, dummy2d_8) if (.not. isnative) then + !--------------------------------------------------------------------------- ! Flip 'z' indices to all 3-d variables. Data is read in from model ! top to surface. This program expects surface to model top. @@ -3018,27 +3291,51 @@ subroutine read_input_atm_grib2_file(localpet) lev_input)),minval(presptr(clb(1):cub(1),clb(2):cub(2),lev_input)) endif -else - ! For native files, read in pressure field directly from file but don't flip levels +else ! is native coordinate (hybrid). + +! For native files, read in pressure field directly from file but don't flip levels + if (localpet == 0) then + print*,"- READ PRESSURE." - vname = ":PRES:" + + jdisc = 0 ! search for discipline - meteorological products + j = 0 ! search at beginning of file. + jpdt = -9999 ! array of values in product definition template, set to wildcard + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + jpdt(1) = 3 ! Sect4/oct 10 - param category - mass + jpdt(2) = 0 ! Sect4/oct 11 - param number - pressure + jpdt(10) = 105 ! Sect4/oct 23 - type of level - hybrid + unpack=.true. + do vlev = 1, lev_input - iret = grb2_inq(the_file,inv_file,vname,slevs(vlev),data2=dummy2d) - if (iret<=0) then + + jpdt(12) = nint(rlevs(vlev)) + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + if (iret /= 0) then call error_handler("READING IN PRESSURE AT LEVEL "//trim(slevs(vlev)),iret) endif - dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8) - print*,'pres check after read ',vlev, dummy3d(1,1,vlev) + + dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) ) + + dummy3d(:,:,vlev) = dum2d_1 + enddo - endif + + endif ! localpet == 0 if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID PRESSURE." call ESMF_FieldScatter(pres_input_grid, dummy3d, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldScatter", rc) + endif - deallocate(dummy3d) + + deallocate(dummy3d, dum2d_1) !--------------------------------------------------------------------------- ! Convert from 2-d to 3-d component winds. @@ -3089,6 +3386,8 @@ subroutine read_input_atm_grib2_file(localpet) endif + if (localpet == 0) call baclose(lugb, rc) + end subroutine read_input_atm_grib2_file !> Read input grid surface data from a spectral gfs gaussian sfcio @@ -4700,55 +4999,100 @@ end subroutine read_input_sfc_netcdf_file !! @author Larissa Reames subroutine read_input_sfc_grib2_file(localpet) - use wgrib2api + use mpi + use grib_mod use program_setup, only : vgtyp_from_climo, sotyp_from_climo use model_grid, only : input_grid_type use search_util - implicit none integer, intent(in) :: localpet character(len=250) :: the_file character(len=250) :: geo_file - character(len=20) :: vname, vname_file,slev + character(len=20) :: vname, vname_file, slev character(len=50) :: method character(len=20) :: to_upper integer :: rc, varnum, iret, i, j,k integer :: ncid2d, varid, varsize + integer :: lugb, lugi + integer :: jdisc, jgdtn, jpdtn + integer :: jids(200), jgdt(200), jpdt(200) - logical :: exist, rap_latlon + logical :: rap_latlon, unpack real(esmf_kind_r4) :: value - - real(esmf_kind_r4), allocatable :: dummy2d(:,:),icec_save(:,:) + real(esmf_kind_r4), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: icec_save(:,:) real(esmf_kind_r4), allocatable :: dummy1d(:) real(esmf_kind_r8), allocatable :: dummy2d_8(:,:),dummy2d_82(:,:),tsk_save(:,:) real(esmf_kind_r8), allocatable :: dummy3d(:,:,:), dummy3d_stype(:,:,:) integer(esmf_kind_i4), allocatable :: slmsk_save(:,:) integer(esmf_kind_i8), allocatable :: dummy2d_i(:,:) + type(gribfield) :: gfld rap_latlon = trim(to_upper(external_model))=="RAP" .and. trim(input_grid_type) == "rotated_latlon" the_file = trim(data_dir_input_grid) // "/" // trim(grib2_file_input_grid) geo_file = trim(geogrid_file_input_grid) - print*,"- READ SFC DATA FROM GRIB2 FILE: ", trim(the_file) - inquire(file=the_file,exist=exist) - if (.not.exist) then - iret = 1 - call error_handler("OPENING GRIB2 FILE.", iret) - end if - - lsoil_input = grb2_inq(the_file, inv_file, ':TSOIL:',' below ground:') - print*, "- FILE HAS ", lsoil_input, " SOIL LEVELS" - if (lsoil_input <= 0) call error_handler("COUNTING SOIL LEVELS.", rc) - - !We need to recreate the soil fields if we have something other than 4 levels + +! Determine the number of soil layers in file. + + if (localpet == 0) then + + lugb=12 + call baopenr(lugb,the_file,rc) + if (rc /= 0) call error_handler("ERROR OPENING GRIB2 FILE.", rc) + + j = 0 ! search at beginning of file + lugi = 0 ! no grib index file + jdisc = -1 ! search for any discipline + jpdtn = -1 ! search for any product definition template number + jgdtn = -1 ! search for any grid definition template number + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jpdt = -9999 ! array of values in product definition template, set to wildcard + unpack = .false. ! unpack data + + lsoil_input = 0 + do + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0) exit + + if (gfld%discipline == 2) then ! discipline - land products + if (gfld%ipdtnum == 0) then ! prod template number - analysis or forecast at single level. + if (gfld%ipdtmpl(1) == 0 .and. gfld%ipdtmpl(2) == 2) then ! soil temp + ! Sect4/octs 10 and 11 + if (gfld%ipdtmpl(10) == 106 .and. gfld%ipdtmpl(13) == 106) then ! Sect4/octs 23/29. + ! Layer below ground. + lsoil_input = lsoil_input + 1 + endif + endif + endif + endif + + j = k + + enddo + + print*, "- FILE HAS ", lsoil_input, " SOIL LEVELS." + if (lsoil_input == 0) call error_handler("COUNTING SOIL LEVELS.", rc) + + endif ! localpet == 0 + + call MPI_BARRIER(MPI_COMM_WORLD, rc) + call MPI_BCAST(lsoil_input,1,MPI_INTEGER,0,MPI_COMM_WORLD,rc) + + ! We need to recreate the soil fields if we have something other than 4 levels + if (lsoil_input /= 4) then call ESMF_FieldDestroy(soil_temp_input_grid, rc=rc) @@ -4783,56 +5127,81 @@ subroutine read_input_sfc_grib2_file(localpet) call error_handler("IN FieldCreate", rc) endif - - if (localpet == 0) then - allocate(dummy2d(i_input,j_input)) - allocate(slmsk_save(i_input,j_input)) - allocate(dummy2d_i(i_input,j_input)) - allocate(tsk_save(i_input,j_input)) - allocate(icec_save(i_input,j_input)) - allocate(dummy2d_8(i_input,j_input)) - allocate(dummy2d_82(i_input,j_input)) - allocate(dummy3d(i_input,j_input,lsoil_input)) - allocate(dummy3d_stype(i_input,j_input,16)) - allocate(dummy1d(16)) - else - allocate(dummy3d(0,0,0)) - allocate(dummy2d_8(0,0)) - allocate(dummy2d_82(0,0)) - allocate(dummy2d(0,0)) - allocate(slmsk_save(0,0)) - endif + + if (localpet == 0) then + allocate(dummy2d(i_input,j_input)) + allocate(slmsk_save(i_input,j_input)) + allocate(tsk_save(i_input,j_input)) + allocate(icec_save(i_input,j_input)) + allocate(dummy2d_8(i_input,j_input)) + allocate(dummy2d_82(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lsoil_input)) + else + allocate(dummy3d(0,0,0)) + allocate(dummy2d_8(0,0)) + allocate(dummy2d_82(0,0)) + allocate(dummy2d(0,0)) + allocate(slmsk_save(0,0)) + endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! These variables are always in grib files, or are required, so no need to check for them ! in the varmap table. If they can't be found in the input file, then stop the program. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - if (localpet == 0) then - print*,"- READ TERRAIN." - rc = grb2_inq(the_file, inv_file, ':HGT:',':surface:', data2=dummy2d) - if (rc /= 1) call error_handler("READING TERRAIN.", rc) - print*,'orog ',maxval(dummy2d),minval(dummy2d) - endif + if (localpet == 0) then - print*,"- CALL FieldScatter FOR INPUT TERRAIN." - call ESMF_FieldScatter(terrain_input_grid, real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- READ TERRAIN." + + j = 0 + jdisc = 0 ! Search for discipline 0 - meteorological products + jpdt = -9999 ! array of values in product definition template, set to wildcard. + jpdtn = 0 ! search for product definition template number 0 - anl or fcst. + jpdt(1) = 3 ! Sec4/oct 10 - param cat - mass field + jpdt(2) = 5 ! Sec4/oct 11 - param number - geopotential height + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) call error_handler("READING TERRAIN.", rc) + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) +! print*,'orog ', maxval(dummy2d_8),minval(dummy2d_8) + + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) -if (localpet == 0) then - print*,"- READ SEAICE FRACTION." - rc = grb2_inq(the_file, inv_file, ':ICEC:',':surface:', data2=dummy2d) - if (rc /= 1) call error_handler("READING SEAICE FRACTION.", rc) - !dummy2d = dummy2d(i_input:1:-1,j_input:1:-1) - print*,'icec ',maxval(dummy2d),minval(dummy2d) - icec_save = dummy2d - endif + if (localpet == 0) then - print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." - call ESMF_FieldScatter(seaice_fract_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- READ SEAICE FRACTION." + + jdisc = 10 ! Search for discipline - ocean products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Array of values in Sec 4 product definition template; + ! Initialize to wildcard. + jpdt(1) = 2 ! Sec4/oct 10 - parameter category - ice + jpdt(2) = 0 ! Sec4/oct 11 - parameter number - ice cover + unpack=.true. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc) + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) +! print*,'icec ', maxval(dummy2d_8),minval(dummy2d_8) + + icec_save = dummy2d_8 + + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, dummy2d_8 ,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) !---------------------------------------------------------------------------------- ! GFS v14 and v15.2 grib data has two land masks. LANDN is created by @@ -4842,46 +5211,89 @@ subroutine read_input_sfc_grib2_file(localpet) ! '2' based on ice concentration. !---------------------------------------------------------------------------------- - if (localpet == 0) then - print*,"- READ LANDSEA MASK." - rc = grb2_inq(the_file, inv_file, ':LANDN:',':surface:', data2=dummy2d) + if (localpet == 0) then - if (rc /= 1) then - rc = grb2_inq(the_file, inv_file, ':LAND:',':surface:', data2=dummy2d) - if (rc /= 1) call error_handler("READING LANDSEA MASK.", rc) - endif + print*,"- READ LANDSEA MASK." - do j = 1, j_input - do i = 1, i_input - if(dummy2d(i,j) < 0.5_esmf_kind_r4) dummy2d(i,j)=0.0_esmf_kind_r4 - if(icec_save(i,j) > 0.15_esmf_kind_r4) then - !if (dummy2d(i,j) == 0.0_esmf_kind_r4) print*, "CONVERTING WATER TO SEA/LAKE ICE AT ", i, j - dummy2d(i,j) = 2.0_esmf_kind_r4 - endif + jdisc = 2 ! Search for discipline - land products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec 4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 218 ! Sec4/oct 11 - parameter number - land nearest neighbor + unpack=.true. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc == 0) then + + print*,'landnn ', maxval(gfld%fld),minval(gfld%fld) + + else + + jdisc = 2 ! Search for discipline - land products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec 4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 0 ! Sec4/oct 11 - parameter number - land cover (fraction) + unpack=.true. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc) + +! print*,'land ', maxval(gfld%fld),minval(gfld%fld) + + endif + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + do j = 1, j_input + do i = 1, i_input + if(dummy2d_8(i,j) < 0.5_esmf_kind_r8) dummy2d_8(i,j)=0.0 + if(icec_save(i,j) > 0.15_esmf_kind_r8) then + dummy2d_8(i,j) = 2.0_esmf_kind_r8 + endif + enddo enddo - enddo - slmsk_save = nint(dummy2d) - - deallocate(icec_save) - endif ! localpet == 0 + slmsk_save = nint(dummy2d_8) - print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." - call ESMF_FieldScatter(landsea_mask_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + deallocate(icec_save) - if (localpet == 0) then - print*,"- READ SEAICE SKIN TEMPERATURE." - rc = grb2_inq(the_file, inv_file, ':TMP:',':surface:', data2=dummy2d) - if (rc /= 1) call error_handler("READING SEAICE SKIN TEMP.", rc) - print*,'ti ',maxval(dummy2d),minval(dummy2d) - endif + endif ! read land mask - print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." - call ESMF_FieldScatter(seaice_skin_temp_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, dummy2d_8 ,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + + print*,"- READ SEAICE SKIN TEMPERATURE." + + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec4 + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - temperature + jpdt(2) = 0 ! Sec4/oct 11 - parameter number - temperature + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc) + +! print*,'ti ',maxval(gfld%fld),minval(gfld%fld) + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, dummy2d_8 ,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) !---------------------------------------------------------------------------------- ! Read snow fields. Zero out at non-land points and undefined points (points @@ -4889,145 +5301,250 @@ subroutine read_input_sfc_grib2_file(localpet) ! in mm. !---------------------------------------------------------------------------------- - if (localpet == 0) then - print*,"- READ SNOW LIQUID EQUIVALENT." - rc = grb2_inq(the_file, inv_file, ':WEASD:',':surface:',':anl:',data2=dummy2d) - if (rc /= 1) then - rc = grb2_inq(the_file, inv_file, ':WEASD:',':surface:','hour fcst:',data2=dummy2d) - if (rc /= 1) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc) + if (localpet == 0) then + + print*,"- READ SNOW LIQUID EQUIVALENT." + + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec4 + jpdt(1) = 1 ! Sec4/oct 10 - parameter category - moisture + jpdt(2) = 13 ! Sec4/oct 11 - parameter number - liquid equiv snow depth + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc) + +! print*,'weasd ', maxval(gfld%fld),minval(gfld%fld) + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + do j = 1, j_input + do i = 1, i_input + if(slmsk_save(i,j) == 0) dummy2d_8(i,j) = 0.0 + enddo + enddo + endif - do j = 1, j_input + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, dummy2d_8 ,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + + print*,"- READ SNOW DEPTH." + + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec4 + jpdt(1) = 1 ! Sec4/oct 10 - parameter category - moisture + jpdt(2) = 11 ! Sec4/oct 11 - parameter number - snow depth + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0) then + call error_handler("READING SNOW DEPTH.", rc) + else + gfld%fld = gfld%fld * 1000.0 +! print*,'snod ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + endif + + do j = 1, j_input do i = 1, i_input - if(slmsk_save(i,j) == 0) dummy2d(i,j) = 0.0_esmf_kind_r4 - if(dummy2d(i,j) == grb2_UNDEFINED) dummy2d(i,j) = 0.0_esmf_kind_r4 + if(slmsk_save(i,j) == 0) dummy2d_8(i,j) = 0.0 + enddo enddo - enddo - print*,'weasd ',maxval(dummy2d),minval(dummy2d) - endif - - print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." - call ESMF_FieldScatter(snow_liq_equiv_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - if (localpet == 0) then - print*,"- READ SNOW DEPTH." - rc = grb2_inq(the_file, inv_file, ':SNOD:',':surface:', data2=dummy2d) - if (rc /= 1) call error_handler("READING SNOW DEPTH.", rc) - where(dummy2d == grb2_UNDEFINED) dummy2d = 0.0_esmf_kind_r4 - dummy2d = dummy2d*1000.0 ! Grib2 files have snow depth in (m), fv3 expects it in mm - where(slmsk_save == 0) dummy2d = 0.0_esmf_kind_r4 - print*,'snod ',maxval(dummy2d),minval(dummy2d) - endif + endif - print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." - call ESMF_FieldScatter(snow_depth_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid,dummy2d_8,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - if (localpet == 0) then - print*,"- READ T2M." - rc = grb2_inq(the_file, inv_file, ':TMP:',':2 m above ground:',data2=dummy2d) - if (rc <= 0) call error_handler("READING T2M.", rc) + if (localpet == 0) then - print*,'t2m ',maxval(dummy2d),minval(dummy2d) - endif + print*,"- READ T2M." - print*,"- CALL FieldScatter FOR INPUT GRID T2M." - call ESMF_FieldScatter(t2m_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0,rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec4 + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - temperature + jpdt(2) = 0 ! Sec4/oct 11 - parameter number - temperature + jpdt(10) = 103 ! Sec4/oct 23 - type of level - height above ground surface + jpdt(12) = 2 ! Sec4/octs 25-28 - 2 meters above ground. + unpack=.true. - if (localpet == 0) then - print*,"- READ Q2M." - rc = grb2_inq(the_file, inv_file, ':SPFH:',':2 m above ground:',data2=dummy2d) - if (rc <=0) call error_handler("READING Q2M.", rc) - print*,'q2m ',maxval(dummy2d),minval(dummy2d) - endif + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) - print*,"- CALL FieldScatter FOR INPUT GRID Q2M." - call ESMF_FieldScatter(q2m_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0,rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + if (rc /= 0) call error_handler("READING T2M.", rc) +! print*,'t2m ', maxval(gfld%fld),minval(gfld%fld) + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, dummy2d_8, rootpet=0,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + + print*,"- READ Q2M." + + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec4 + jpdt(1) = 1 ! Sec4/oct 10 - parameter category - moisture + jpdt(2) = 0 ! Sec4/oct 11 - parameter number - specific humidity + jpdt(10) = 103 ! Sec4/oct 23 - type of level - height above ground surface + jpdt(12) = 2 ! Sec4/octs 25-28 - 2 meters above ground. + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /=0) call error_handler("READING Q2M.", rc) + +! print*,'q2m ',maxval(gfld%fld),minval(gfld%fld) + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid,dummy2d_8, rootpet=0,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - if (localpet == 0) then - print*,"- READ SKIN TEMPERATURE." - rc = grb2_inq(the_file, inv_file, ':TMP:',':surface:', data2=dummy2d) - if (rc <= 0 ) call error_handler("READING SKIN TEMPERATURE.", rc) - tsk_save(:,:) = real(dummy2d,esmf_kind_r8) - dummy2d_8 = real(dummy2d,esmf_kind_r8) - do j = 1, j_input - do i = 1, i_input - if(slmsk_save(i,j) == 0 .and. dummy2d(i,j) < 271.2) then -! print*,'too cool SST ',i,j,dummy2d(i,j) - dummy2d(i,j) = 271.2 - endif - if(slmsk_save(i,j) == 0 .and. dummy2d(i,j) > 310.) then -! print*,'too hot SST ',i,j,dummy2d(i,j) - dummy2d(i,j) = 310.0 - endif + if (localpet == 0) then + + print*,"- READ SKIN TEMPERATURE." + + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec4 + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - temperature + jpdt(2) = 0 ! Sec4/oct 11 - parameter number - temperature + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0 ) call error_handler("READING SKIN TEMPERATURE.", rc) +! print*,'skint ', maxval(gfld%fld),minval(gfld%fld) + + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + tsk_save(:,:) = dummy2d_8 + + do j = 1, j_input + do i = 1, i_input + if(slmsk_save(i,j) == 0 .and. dummy2d_8(i,j) < 271.2) then +! print*,'too cool SST ',i,j,dummy2d_8(i,j) + dummy2d_8(i,j) = 271.2 + endif + if(slmsk_save(i,j) == 0 .and. dummy2d_8(i,j) > 310.) then +! print*,'too hot SST ',i,j,dummy2d_8(i,j) + dummy2d_8(i,j) = 310.0 + endif + enddo enddo - enddo - endif - print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" - call ESMF_FieldScatter(skin_temp_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid,dummy2d_8,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - if (localpet == 0) dummy2d = 0.0 +! srflag not in files. Set to zero. + + if (localpet == 0) dummy2d_8 = 0.0 - print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" - call ESMF_FieldScatter(srflag_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0,rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid,dummy2d_8, rootpet=0,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - if (localpet == 0) then - print*,"- READ SOIL TYPE." - slev=":surface:" - vname=":SOTYP:" - rc = grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - !failed => rc = 0 - if (rc <= 0 .and. (trim(to_upper(external_model))=="HRRR" .or. rap_latlon) .and. geo_file .ne. "NULL") then + if (localpet == 0) then + + print*,"- READ SOIL TYPE." + + jdisc = 2 ! Search for discipline - land products + j = 0 ! Search at beginning of file + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template - Sec4 + jpdt(1) = 3 ! Sec4/oct 10 - parameter category - soil products + jpdt(2) = 0 ! Sec4/oct 11 - parameter number - soil type + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc == 0 ) then +! print*,'soil type ', maxval(gfld%fld),minval(gfld%fld) + dummy2d = reshape(gfld%fld , (/i_input,j_input/)) + + endif + + if (rc /= 0 .and. (trim(to_upper(external_model))=="HRRR" .or. rap_latlon) .and. geo_file .ne. "NULL") then ! Some HRRR and RAP files don't have dominant soil type in the output, but the geogrid files ! do, so this gives users the option to provide the geogrid file and use input soil ! type - print*, "OPEN GEOGRID FILE ", trim(geo_file) - rc = nf90_open(geo_file,NF90_NOWRITE,ncid2d) - call netcdf_err(rc,"READING GEOGRID FILE") + print*, "OPEN GEOGRID FILE ", trim(geo_file) + rc = nf90_open(geo_file,NF90_NOWRITE,ncid2d) + call netcdf_err(rc,"READING GEOGRID FILE") - print*, "INQURE ABOUT DIM IDS" - rc = nf90_inq_dimid(ncid2d,"west_east",varid) - call netcdf_err(rc,"READING west_east DIMENSION FROM GEOGRID FILE") + print*, "INQURE ABOUT DIM IDS" + rc = nf90_inq_dimid(ncid2d,"west_east",varid) + call netcdf_err(rc,"READING west_east DIMENSION FROM GEOGRID FILE") - rc = nf90_inquire_dimension(ncid2d,varid,len=varsize) - call netcdf_err(rc,"READING west_east DIMENSION SIZE") - if (varsize .ne. i_input) call error_handler ("GEOGRID FILE GRID SIZE DIFFERS FROM INPUT DATA.", -1) + rc = nf90_inquire_dimension(ncid2d,varid,len=varsize) + call netcdf_err(rc,"READING west_east DIMENSION SIZE") + if (varsize .ne. i_input) call error_handler ("GEOGRID FILE GRID SIZE DIFFERS FROM INPUT DATA.", -1) - print*, "INQUIRE ABOUT SOIL TYPE FROM GEOGRID FILE" - rc = nf90_inq_varid(ncid2d,"SCT_DOM",varid) - call netcdf_err(rc,"FINDING SCT_DOM IN GEOGRID FILE") + print*, "INQUIRE ABOUT SOIL TYPE FROM GEOGRID FILE" + rc = nf90_inq_varid(ncid2d,"SCT_DOM",varid) + call netcdf_err(rc,"FINDING SCT_DOM IN GEOGRID FILE") - print*, "READ SOIL TYPE FROM GEOGRID FILE " - rc = nf90_get_var(ncid2d,varid,dummy2d) - call netcdf_err(rc,"READING SCT_DOM FROM FILE") + print*, "READ SOIL TYPE FROM GEOGRID FILE " + rc = nf90_get_var(ncid2d,varid,dummy2d) + call netcdf_err(rc,"READING SCT_DOM FROM FILE") - print*, "INQUIRE ABOUT SOIL TYPE FRACTIONS FROM GEOGRID FILE" - rc = nf90_inq_varid(ncid2d,"SOILCTOP",varid) - call netcdf_err(rc,"FINDING SOILCTOP IN GEOGRID FILE") + print*, "INQUIRE ABOUT SOIL TYPE FRACTIONS FROM GEOGRID FILE" + rc = nf90_inq_varid(ncid2d,"SOILCTOP",varid) + call netcdf_err(rc,"FINDING SOILCTOP IN GEOGRID FILE") - print*, "READ SOIL TYPE FRACTIONS FROM GEOGRID FILE " - rc = nf90_get_var(ncid2d,varid,dummy3d_stype) - call netcdf_err(rc,"READING SCT_DOM FROM FILE") + allocate(dummy3d_stype(i_input,j_input,16)) + print*, "READ SOIL TYPE FRACTIONS FROM GEOGRID FILE " + rc = nf90_get_var(ncid2d,varid,dummy3d_stype) + call netcdf_err(rc,"READING SCT_DOM FROM FILE") - print*, "CLOSE GEOGRID FILE " - iret = nf90_close(ncid2d) - + print*, "CLOSE GEOGRID FILE " + iret = nf90_close(ncid2d) ! There's an issue with the geogrid file containing soil type water at land points. ! This correction replaces the soil type at these points with the soil type with ! the next highest fractional coverage. - do j = 1, j_input + allocate(dummy1d(16)) + do j = 1, j_input do i = 1, i_input if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) then dummy1d(:) = dummy3d_stype(i,j,:) @@ -5035,396 +5552,501 @@ subroutine read_input_sfc_grib2_file(localpet) dummy2d(i,j) = real(MAXLOC(dummy1d, 1),esmf_kind_r4) endif enddo - enddo - deallocate(dummy1d) - endif ! localpet == 0 + enddo + deallocate(dummy1d) + deallocate(dummy3d_stype) + endif ! failed - if ((rc <= 0 .and. trim(to_upper(external_model)) /= "HRRR" .and. .not. rap_latlon) & - .or. (rc < 0 .and. (trim(to_upper(external_model)) == "HRRR" .or. rap_latlon))) then - if (.not. sotyp_from_climo) then - call error_handler("COULD NOT FIND SOIL TYPE IN FILE. PLEASE SET SOTYP_FROM_CLIMO=.TRUE. . EXITING", rc) - else - vname = "sotyp" - call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & - loc=varnum) - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc == 1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. WILL NOT "//& - "SCALE SOIL MOISTURE FOR DIFFERENCES IN SOIL TYPE. " - dummy2d(:,:) = -99999.0_esmf_kind_r4 + if ((rc /= 0 .and. trim(to_upper(external_model)) /= "HRRR" .and. .not. rap_latlon) & + .or. (rc /= 0 .and. (trim(to_upper(external_model)) == "HRRR" .or. rap_latlon))) then + if (.not. sotyp_from_climo) then + call error_handler("COULD NOT FIND SOIL TYPE IN FILE. PLEASE SET SOTYP_FROM_CLIMO=.TRUE. . EXITING", rc) + else + vname = "sotyp" + slev = "surface" + call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & + loc=varnum) + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc == 1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. WILL NOT "//& + "SCALE SOIL MOISTURE FOR DIFFERENCES IN SOIL TYPE. " + dummy2d(:,:) = -99999.0_esmf_kind_r4 + endif endif endif - endif ! In the event that the soil type on the input grid still contains mismatches between ! soil type and landmask, this correction is a last-ditch effort to replace these points ! with soil type from a nearby land point. - if (.not. sotyp_from_climo) then - do j = 1, j_input - do i = 1, i_input - if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) dummy2d(i,j) = -99999.9 - enddo - enddo - - dummy2d_8 = real(dummy2d,esmf_kind_r8) - dummy2d_i(:,:) = 0 - where(slmsk_save == 1) dummy2d_i = 1 + + if (.not. sotyp_from_climo) then + do j = 1, j_input + do i = 1, i_input + if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) dummy2d(i,j) = -99999.9 + enddo + enddo + + allocate(dummy2d_i(i_input,j_input)) + dummy2d_8 = real(dummy2d,esmf_kind_r8) + dummy2d_i(:,:) = 0 + where(slmsk_save == 1) dummy2d_i = 1 - call search(dummy2d_8,dummy2d_i,i_input,j_input,1,230) - else - dummy2d_8=real(dummy2d,esmf_kind_r8) - endif + call search(dummy2d_8,dummy2d_i,i_input,j_input,1,230) + deallocate(dummy2d_i) + else + dummy2d_8=real(dummy2d,esmf_kind_r8) + endif - print*,'sotype ',maxval(dummy2d_8),minval(dummy2d_8) - deallocate(dummy2d_i) - deallocate(dummy3d_stype) - endif ! localpet == 0 + print*,'sotype ',maxval(dummy2d_8),minval(dummy2d_8) + + endif ! read of soil type + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." - call ESMF_FieldScatter(soil_type_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + deallocate(dummy2d) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Begin variables whose presence in grib2 files varies, but no climatological ! data is available, so we have to account for values in the varmap table !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - if (.not. vgfrc_from_climo) then - if (localpet == 0) then - print*,"- READ VEG FRACTION." - vname="vfrac" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & - loc=varnum) - !! Changing these for GSD internal runs using new HRRR files - vname=":VEG:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - - if (rc > 1) then - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1105:', data2=dummy2d) - if (rc <= 0) then - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1101:', data2=dummy2d) - if (rc <= 0) then - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1151:', data2=dummy2d) - if (rc <= 0) call error_handler("COULD NOT DETERMINE VEGETATION FRACTION IN FILE. & - RECORD NUMBERS MAY HAVE CHANGED. PLEASE SET VGFRC_FROM_CLIMO=.TRUE. EXITING", rc) - endif - endif - elseif (rc <= 0) then - call error_handler("COULD NOT FIND VEGETATION FRACTION IN FILE. & + if (.not. vgfrc_from_climo) then + + if (localpet == 0) then + + print*,"- READ VEG FRACTION." + + jdisc = 2 ! Search for discipline - land products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 4 ! Sec4/oct 11 - parameter number - vegetation + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0 )then + call error_handler("COULD NOT FIND VEGETATION FRACTION IN FILE. & PLEASE SET VGFRC_FROM_CLIMO=.TRUE. EXITING", rc) - endif - if(maxval(dummy2d) > 2.0) dummy2d = dummy2d / 100.0_esmf_kind_r4 - print*,'vfrac ',maxval(dummy2d),minval(dummy2d) + else + if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0 +! print*,'vfrac ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + endif + + endif ! localpet 0 + + print*,"- CALL FieldScatter FOR INPUT GRID VEG GREENNESS." + call ESMF_FieldScatter(veg_greenness_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + endif + if (.not. minmax_vgfrc_from_climo) then + + if (localpet == 0) then + + print*,"- READ MIN VEG FRACTION." + + jdisc = 2 ! Search for discipline - land products + j = 1105 ! grib2 file does not distinguish between the various veg + ! fractions. Need to search using record number. + jpdtn = 0 ! Search for product definition template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 4 ! Sec4/oct 11 - parameter number - vegetation + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0) then + j = 1101 ! Have to search by record number. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) then + j = 1151 ! Have to search by record number. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc/=0) call error_handler("COULD NOT FIND MIN VEGETATION FRACTION IN FILE. & + PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc) + endif + endif + + if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0 + print*,'vfrac min ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + endif ! localpet == 0 + + print*,"- CALL FieldScatter FOR INPUT GRID MIN VEG GREENNESS." + call ESMF_FieldScatter(min_veg_greenness_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + + print*,"- READ MAX VEG FRACTION." + + jdisc = 2 ! Search for discipline - land products + j = 1106 ! Have to search by record number. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 4 ! Sec4/oct 11 - parameter number - vegetation + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) then + j = 1102 ! Have to search by record number. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) then + j = 1152 ! Have to search by record number. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc <= 0) call error_handler("COULD NOT FIND MAX VEGETATION FRACTION IN FILE. & + PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc) + endif + endif + + if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0 +! print*,'vfrac max ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + endif !localpet==0 + + print*,"- CALL FieldScatter FOR INPUT GRID MAX VEG GREENNESS." + call ESMF_FieldScatter(max_veg_greenness_input_grid,dummy2d_8,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + endif !minmax_vgfrc_from_climo - print*,"- CALL FieldScatter FOR INPUT GRID VEG GREENNESS." - call ESMF_FieldScatter(veg_greenness_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - endif + if (.not. lai_from_climo) then + + if (localpet == 0) then + + print*,"- READ LAI." + + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 7 ! Sec4/oct 10 - parameter category - thermo stability indices + jpdt(2) = 198 ! Sec4/oct 11 - parameter number - leaf area index + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0) call error_handler("COULD NOT FIND LAI IN FILE. & + PLEASE SET LAI_FROM_CLIMO=.TRUE. . EXITING",rc) + +! print*,'lai ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + + endif !localpet==0 + + print*,"- CALL FieldScatter FOR INPUT GRID LAI." + call ESMF_FieldScatter(lai_input_grid,dummy2d_8,rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + endif ! lai - if (.not. minmax_vgfrc_from_climo) then if (localpet == 0) then - print*,"- READ MIN VEG FRACTION." - vname="vfrac_min" - slev=":surface:" + + print*,"- READ SEAICE DEPTH." + vname="hice" + slev=":surface:" call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & - loc=varnum) - vname=":VEG:" - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1106:',data2=dummy2d) - - if (rc <= 0) then - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1102:',data2=dummy2d) - if (rc <= 0) then - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1152:',data2=dummy2d) - if (rc<=0) call error_handler("COULD NOT FIND MIN VEGETATION FRACTION IN FILE. & - PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc) + loc=varnum) + + jdisc = 10 ! Search for discipline - ocean products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 2 ! Sec4/oct 10 - parameter category - ice + jpdt(2) = 1 ! Sec4/oct 11 - parameter number - thickness + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0 ) then + call handle_grib_error(vname, slev ,method,value,varnum,rc,var8=dummy2d_8) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//& + " REPLACED WITH CLIMO. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d_8(:,:) = 0.0 endif + else +! print*,'hice ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) endif - if(maxval(dummy2d) > 2.0) dummy2d = dummy2d / 100.0_esmf_kind_r4 - print*,'vfrac min',maxval(dummy2d),minval(dummy2d) - endif + endif - print*,"- CALL FieldScatter FOR INPUT GRID MIN VEG GREENNESS." - call ESMF_FieldScatter(min_veg_greenness_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0, rc=rc) + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid,dummy2d_8, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldScatter", rc) - + if (localpet == 0) then - print*,"- READ MAX VEG FRACTION." - vname="vfrac_max" - slev=":surface:" + + print*,"- READ TPRCP." + vname="tprcp" + slev=":surface:" call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & - loc=varnum) - - vname=":VEG:" - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1107:',data2=dummy2d) - if (rc <=0) then - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1103:',data2=dummy2d) - if (rc <=0) then - rc= grb2_inq(the_file, inv_file, vname,slev,'n=1153:',data2=dummy2d) - if (rc <= 0) call error_handler("COULD NOT FIND MAX VEGETATION FRACTION IN FILE. & - PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc) - endif + loc=varnum) + +! No test data contained this field. So could not test with g2 library. + rc = 1 + if (rc /= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& + " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d_8 = 0.0 + endif endif - if(maxval(dummy2d) > 2.0) dummy2d = dummy2d / 100.0_esmf_kind_r4 - print*,'vfrac max',maxval(dummy2d),minval(dummy2d) + print*,'tprcp ',maxval(dummy2d_8),minval(dummy2d_8) - endif !localpet==0 + endif ! tprcp - print*,"- CALL FieldScatter FOR INPUT GRID MAX VEG GREENNESS." - call ESMF_FieldScatter(max_veg_greenness_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid,dummy2d_8, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldScatter", rc) - endif !minmax_vgfrc_from_climo - if (.not. lai_from_climo) then if (localpet == 0) then - print*,"- READ LAI." - vname="lai" - slev=":surface:" + + print*,"- READ FFMM." + vname="ffmm" + slev=":surface:" call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & - loc=varnum) - vname=":var0_7_198:" - rc= grb2_inq(the_file, inv_file, vname,slev,':n=1108:',data2=dummy2d) - if (rc <=0) then - rc= grb2_inq(the_file, inv_file, vname,slev,':n=1104:',data2=dummy2d) - if (rc <=0) then - rc= grb2_inq(the_file, inv_file, vname,slev,':n=1154:',data2=dummy2d) - if (rc <= 0) call error_handler("COULD NOT FIND LAI IN FILE. & - PLEASE SET LAI_FROM_CLIMO=.TRUE. . EXITING",rc) + loc=varnum) + +! No sample data contained this field, so could not test g2lib. + rc = 1 + if (rc /= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& + " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d_8(:,:) = 0.0 endif endif - print*,'lai',maxval(dummy2d),minval(dummy2d) - endif !localpet==0 + print*,'ffmm ',maxval(dummy2d_8),minval(dummy2d_8) - print*,"- CALL FieldScatter FOR INPUT GRID LAI." - call ESMF_FieldScatter(lai_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + endif ! ffmm + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid,dummy2d_8, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldScatter", rc) - - endif - if (localpet == 0) then - print*,"- READ SEAICE DEPTH." - vname="hice" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & - loc=varnum) - vname=":ICETK:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - if (rc <= 0) then - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc==1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//& - " REPLACED WITH CLIMO. SET A FILL "// & - "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." - dummy2d(:,:) = 0.0_esmf_kind_r4 - endif - endif - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'hice ',maxval(dummy2d),minval(dummy2d) - - endif - - print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." - call ESMF_FieldScatter(seaice_depth_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - if (localpet == 0) then - print*,"- READ TPRCP." - vname="tprcp" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & - loc=varnum) - vname=":TPRCP:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - if (rc <= 0) then - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc==1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& - " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & - "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." - dummy2d(:,:) = 0.0_esmf_kind_r4 - endif - endif - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'tprcp ',maxval(dummy2d),minval(dummy2d) - endif + if (localpet == 0) then - print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." - call ESMF_FieldScatter(tprcp_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - - if (localpet == 0) then - print*,"- READ FFMM." - vname="ffmm" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + print*,"- READ USTAR." + vname="fricv" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & loc=varnum) - vname=":FFMM:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - if (rc <= 0) then - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc==1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& - " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & - "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." - dummy2d(:,:) = 0.0_esmf_kind_r4 - endif - endif - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'ffmm ',maxval(dummy2d),minval(dummy2d) - endif - print*,"- CALL FieldScatter FOR INPUT GRID FFMM" - call ESMF_FieldScatter(ffmm_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - - if (localpet == 0) then - print*,"- READ USTAR." - vname="fricv" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & - loc=varnum) - vname=":FRICV:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - if (rc <= 0) then - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc==1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL "//& + jdisc = 0 ! Search for discipline - meteorological products + j = 0 ! Search at beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 2 ! Sec4/oct 10 - parameter category - momentum + jpdt(2) = 30 ! Sec4/oct 11 - parameter number - friction velocity + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) then + jpdt(2) = 197 ! oct 11 - param number - friction vel. + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + endif + + if (rc == 0) then +! print*,'fricv ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + else + call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL "//& "REPLACED WITH CLIMO. SET A FILL "// & "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." - dummy2d(:,:) = 0.0_esmf_kind_r4 - endif - endif - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'fricv ',maxval(dummy2d),minval(dummy2d) - endif + dummy2d_8(:,:) = 0.0 + endif + endif - print*,"- CALL FieldScatter FOR INPUT GRID USTAR" - call ESMF_FieldScatter(ustar_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + endif ! ustar - if (localpet == 0) then - print*,"- READ F10M." - vname="f10m" - slev=":10 m above ground:" - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + + print*,"- READ F10M." + vname="f10m" + slev=":10 m above ground:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & loc=varnum) - vname=":F10M:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - if (rc <= 0) then - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc==1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& + + rc = -1 ! None of the test cases have this record. Can't test with g2lib. + if (rc /= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." - dummy2d(:,:) = 0.0_esmf_kind_r4 - endif - endif - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'f10m ',maxval(dummy2d),minval(dummy2d) - endif + dummy2d_8(:,:) = 0.0 + endif + endif + print*,'f10m ',maxval(dummy2d_8),minval(dummy2d_8) - print*,"- CALL FieldScatter FOR INPUT GRID F10M." - call ESMF_FieldScatter(f10m_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + endif - if (localpet == 0) then - print*,"- READ CANOPY MOISTURE CONTENT." - vname="cnwat" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + print*,"- CALL FieldScatter FOR INPUT GRID F10M." + call ESMF_FieldScatter(f10m_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + + print*,"- READ CANOPY MOISTURE CONTENT." + vname="cnwat" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & loc=varnum) - vname=":CNWAT:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - if (rc <= 0) then - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc==1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL"//& + + jdisc = 2 ! Search for discipline - land products + j = 0 ! Search from beginning of file + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 13 ! Sec4/oct 11 - parameter number - canopy water + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0 ) then + jpdt(2) = 196 ! Sec4/oct 11 - param number - canopy water + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + endif + + if (rc == 0 ) then + print*,'cnwat ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + call check_cnwat(dummy2d_8) + else + call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL"//& " REPLACED WITH CLIMO. SET A FILL "// & "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." - dummy2d(:,:) = 0.0_esmf_kind_r4 - endif - endif - call check_cnwat(dummy2d) - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'cnwat ',maxval(dummy2d),minval(dummy2d) - endif + dummy2d_8 = 0.0 + endif + endif - print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." - call ESMF_FieldScatter(canopy_mc_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + endif - if (localpet == 0) then - print*,"- READ Z0." - vname="sfcr" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + + print*,"- READ Z0." + vname="sfcr" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & loc=varnum) - vname=":SFCR:" - rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) - if (rc <= 0) then - call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) - if (rc==1) then ! missing_var_method == skip or no entry in varmap table - print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//& + + jdisc = 2 ! Search for discipline - land products + j = 0 ! Search from beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 1 ! Sec4/oct 11 - parameter number - surface roughness + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0 ) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var8= dummy2d_8) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//& " REPLACED WITH CLIMO. SET A FILL "// & "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." - dummy2d(:,:) = 0.0_esmf_kind_r4 - endif - else - ! Grib files have z0 (m), but fv3 expects z0(cm) - dummy2d(:,:) = dummy2d(:,:)*10.0 - endif - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'sfcr ',maxval(dummy2d),minval(dummy2d) - - endif + dummy2d_8(:,:) = 0.0 + endif + else + gfld%fld = gfld%fld * 10.0 ! Grib files have z0 (m), but fv3 expects z0(cm) +! print*,'sfcr ', maxval(gfld%fld),minval(gfld%fld) + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) + endif - print*,"- CALL FieldScatter FOR INPUT GRID Z0." - call ESMF_FieldScatter(z0_input_grid,dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - if (localpet == 0) then - print*,"- READ LIQUID SOIL MOISTURE." - vname = "soill" - vname_file = ":SOILL:" - call read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) !!! NEEDTO HANDLE - !!! SOIL LEVELS - print*,'soill ',maxval(dummy3d),minval(dummy3d) - endif + if (localpet == 0) then + print*,"- READ LIQUID SOIL MOISTURE." + vname = "soill" + vname_file = ":SOILL:" + call read_grib_soil(vname,vname_file,lugb, dummy3d) !!! NEED TO HANDLE + !!! SOIL LEVELS + endif - print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." - call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - if (localpet == 0) then - print*,"- READ TOTAL SOIL MOISTURE." - vname = "soilw" - !vname_file = "var2_2_1_7_0_192" !Some files don't recognize this as soilw,so use - vname_file = "var2_2_1_" ! the var number instead - call read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) - print*,'soilm ',maxval(dummy3d),minval(dummy3d) - endif + if (localpet == 0) then + print*,"- READ TOTAL SOIL MOISTURE." + vname = "soilw" + vname_file = "var2_2_1_" ! the var number instead + call read_grib_soil(vname,vname_file,lugb,dummy3d) + endif - print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." - call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) !---------------------------------------------------------------------------------------- ! Vegetation type is not available in some files. However, it is needed to identify @@ -5432,75 +6054,82 @@ subroutine read_input_sfc_grib2_file(localpet) ! '1'. Use this flag as a temporary solution. !---------------------------------------------------------------------------------------- - print*, "- CALL FieldGather for INPUT SOIL TYPE." - call ESMF_FieldGather(soil_type_input_grid, dummy2d_82, rootPet=0, tile=1, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - if (localpet == 0) then - print*,"- READ VEG TYPE." - vname="vtype" - slev=":surface:" - call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & - loc=varnum) - !Note: sometimes the grib files don't have this one named. Searching for this string - ! ensures that the data is found when it exists - - vname="var2_2" - rc= grb2_inq(the_file, inv_file, vname,"_0_198:",slev,' hour fcst:', data2=dummy2d) - if (rc <= 0) then - rc= grb2_inq(the_file, inv_file, vname,"_0_198:",slev,':anl:', data2=dummy2d) - if (rc <= 0) then + print*, "- CALL FieldGather for INPUT SOIL TYPE." + call ESMF_FieldGather(soil_type_input_grid, dummy2d_82, rootPet=0, tile=1, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + + print*,"- READ VEG TYPE." + + jdisc = 2 ! Search for discipline - land products + j = 0 ! Search from beginning of file. + jpdtn = 0 ! Search for product def template number 0 - anl or fcst. + jpdt = -9999 ! Initialize array of values in product definition template Sec4. + jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass + jpdt(2) = 198 ! Sec4/oct 11 - parameter number - vegetation type + jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface + unpack=.true. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + + if (rc /= 0 ) then if (.not. vgtyp_from_climo) then call error_handler("COULD NOT FIND VEGETATION TYPE IN FILE. PLEASE SET VGTYP_FROM_CLIMO=.TRUE. . EXITING", rc) - else - do j = 1, j_input - do i = 1, i_input - dummy2d(i,j) = 0.0_esmf_kind_r4 - if(slmsk_save(i,j) == 1 .and. dummy3d(i,j,1) > 0.99) & - dummy2d(i,j) = real(veg_type_landice_input,esmf_kind_r4) - enddo - enddo - endif ! replace_vgtyp - endif !not find :anl: - endif !not find hour fcst: - - if (trim(external_model) .ne. "GFS") then - do j = 1, j_input - do i = 1,i_input - if (dummy2d(i,j) == 15.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) then - if (dummy3d(i,j,1) < 0.6) then - dummy2d(i,j) = real(veg_type_landice_input,esmf_kind_r4) - elseif (dummy3d(i,j,1) > 0.99) then - slmsk_save(i,j) = 0 - dummy2d(i,j) = 0.0_esmf_kind_r4 - dummy2d_82(i,j) = 0.0_esmf_kind_r8 + else ! Set input veg type at land ice from soil moisture flag (1.0). + do j = 1, j_input + do i = 1, i_input + dummy2d_8(i,j) = 0.0 + if(slmsk_save(i,j) == 1 .and. dummy3d(i,j,1) > 0.99) & ! land ice indicated by + ! soil moisture flag of '1'. + dummy2d_8(i,j) = real(veg_type_landice_input,esmf_kind_r8) + enddo + enddo endif - elseif (dummy2d(i,j) == 17.0_esmf_kind_r4 .and. slmsk_save(i,j)==0) then - dummy2d(i,j) = 0.0_esmf_kind_r4 + else ! found vtype in file. + dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/)) endif - enddo - enddo - endif - dummy2d_8= real(dummy2d,esmf_kind_r8) - print*,'vgtyp ',maxval(dummy2d),minval(dummy2d) - endif !localpet - deallocate(dummy2d) - print*,"- CALL FieldScatter FOR INPUT VEG TYPE." - call ESMF_FieldScatter(veg_type_input_grid, dummy2d_8, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - print*,"- CALL FieldScatter FOR INPUT SOIL TYPE." - call ESMF_FieldScatter(soil_type_input_grid, dummy2d_82, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + if (trim(external_model) .ne. "GFS") then + do j = 1, j_input + do i = 1,i_input + if (dummy2d_8(i,j) == 15.0_esmf_kind_r8 .and. slmsk_save(i,j) == 1) then + if (dummy3d(i,j,1) < 0.6) then + dummy2d_8(i,j) = real(veg_type_landice_input,esmf_kind_r8) + elseif (dummy3d(i,j,1) > 0.99) then + slmsk_save(i,j) = 0 + dummy2d_8(i,j) = 0.0_esmf_kind_r8 + dummy2d_82(i,j) = 0.0_esmf_kind_r8 + endif + elseif (dummy2d_8(i,j) == 17.0_esmf_kind_r8 .and. slmsk_save(i,j)==0) then + dummy2d_8(i,j) = 0.0_esmf_kind_r8 + endif + enddo + enddo + endif - deallocate(dummy2d_82) +! print*,'vgtyp ',maxval(dummy2d_8),minval(dummy2d_8) - print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." - call ESMF_FieldScatter(landsea_mask_input_grid,real(slmsk_save,esmf_kind_r8),rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + endif ! read veg type + + print*,"- CALL FieldScatter FOR INPUT VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR INPUT SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, dummy2d_82, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d_82) + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid,real(slmsk_save,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) !--------------------------------------------------------------------------------- ! At open water (slmsk==0), the soil temperature array is not used and set @@ -5509,27 +6138,27 @@ subroutine read_input_sfc_grib2_file(localpet) ! in the grib data, so set to a default value. !--------------------------------------------------------------------------------- - if (localpet == 0) then - print*,"- READ SOIL TEMPERATURE." - vname = "soilt" - vname_file = ":TSOIL:" - call read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) - call check_soilt(dummy3d,slmsk_save,tsk_save) - print*,'soilt ',maxval(dummy3d),minval(dummy3d) - - deallocate(tsk_save) - endif + if (localpet == 0) then + print*,"- READ SOIL TEMPERATURE." + vname = "soilt" + vname_file = ":TSOIL:" + call read_grib_soil(vname,vname_file,lugb,dummy3d) + call check_soilt(dummy3d,slmsk_save,tsk_save) + deallocate(tsk_save) + endif - deallocate(slmsk_save) + deallocate(slmsk_save) - print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." - call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) - deallocate(dummy3d) - deallocate(dummy2d_8) + deallocate(dummy3d) + deallocate(dummy2d_8) + if (localpet == 0) call baclose(lugb, rc) + end subroutine read_input_sfc_grib2_file !> Read nst data from these netcdf formatted fv3 files: tiled history, @@ -6137,39 +6766,47 @@ END SUBROUTINE READ_FV3_GRID_DATA_NETCDF !> Read winds from a grib2 file. Rotate winds !! to be earth relative if necessary. !! -!! @param [in] file grib2 file to be read -!! @param [in] inv grib2 inventory file !! @param [inout] u u-component wind !! @param [inout] v v-component wind !! @param[in] localpet ESMF local persistent execution thread +!! @param[in] isnative When true, data on hybrid levels. Otherwise +!! data is on isobaric levels. +!! @param[in] rlevs Array of atmospheric level values +!! @param[in] lugb Logical unit number of GRIB2 file. !! @author Larissa Reames - subroutine read_winds(file,inv,u,v,localpet) + subroutine read_winds(u,v,localpet,isnative,rlevs,lugb) + + use grib_mod + use program_setup, only : get_var_cond - use wgrib2api - use netcdf - use program_setup, only : get_var_cond, fix_dir_input_grid - use model_grid, only : input_grid_type implicit none - character(len=250), intent(in) :: file - character(len=10), intent(in) :: inv - integer, intent(in) :: localpet - real(esmf_kind_r8), intent(inout), allocatable :: u(:,:,:),v(:,:,:) + integer, intent(in) :: localpet, lugb + + logical, intent(in) :: isnative + + real(esmf_kind_r8), intent(inout), allocatable :: u(:,:,:),v(:,:,:) + real(esmf_kind_r8), intent(in), dimension(lev_input) :: rlevs real(esmf_kind_r4), dimension(i_input,j_input) :: alpha real(esmf_kind_r8), dimension(i_input,j_input) :: lon, lat real(esmf_kind_r4), allocatable :: u_tmp(:,:),v_tmp(:,:) + real(esmf_kind_r8), allocatable :: dum2d(:,:) real(esmf_kind_r4), dimension(i_input,j_input) :: ws,wd real(esmf_kind_r4) :: value_u, value_v,lov,latin1,latin2 real(esmf_kind_r8) :: d2r - integer :: varnum_u, varnum_v, vlev, & !ncid, id_var, & - error, iret, istr + integer :: varnum_u, varnum_v, vlev, & + error, iret + integer :: j, k, lugi, jgdtn, jpdtn + integer :: jdisc, jids(200), jgdt(200), jpdt(200) character(len=20) :: vname character(len=50) :: method_u, method_v - character(len=250) :: file_coord - character(len=10000) :: temp_msg + + logical :: unpack + + type(gribfield) :: gfld d2r=acos(-1.0_esmf_kind_r8) / 180.0_esmf_kind_r8 if (localpet==0) then @@ -6180,8 +6817,6 @@ subroutine read_winds(file,inv,u,v,localpet) allocate(v(0,0,0)) endif - file_coord = trim(fix_dir_input_grid)//"/latlon_grid3.32769.nc" - vname = "u" call get_var_cond(vname,this_miss_var_method=method_u, this_miss_var_value=value_u, & loc=varnum_u) @@ -6189,90 +6824,107 @@ subroutine read_winds(file,inv,u,v,localpet) call get_var_cond(vname,this_miss_var_method=method_v, this_miss_var_value=value_v, & loc=varnum_v) - if (trim(input_grid_type)=="rotated_latlon") then - print*,"- CALL FieldGather FOR INPUT GRID LONGITUDE" - call ESMF_FieldGather(longitude_input_grid, lon, rootPet=0, tile=1, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", error) - print*,"- CALL FieldGather FOR INPUT GRID LATITUDE" - call ESMF_FieldGather(latitude_input_grid, lat, rootPet=0, tile=1, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + print*,"- CALL FieldGather FOR INPUT GRID LONGITUDE" + call ESMF_FieldGather(longitude_input_grid, lon, rootPet=0, tile=1, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", error) - if (localpet==0) then - print*,"- CALCULATE ROTATION ANGLE FOR ROTATED_LATLON INPUT GRID" - error = grb2_inq(file, inv,grid_desc=temp_msg) - !1:0:grid_template=32769:winds(grid): - ! I am not an Arakawa E-grid. - ! I am rotated but have no rotation angle. - ! I am staggered. What am I? - ! (953 x 834) units 1e-06 input WE:SN output WE:SN res 56 - ! lat0 -10.590603 lat-center 54.000000 dlat 121.813000 - ! lon0 220.914154 lon-center 254.000000 dlon 121.813000 #points=794802 - - istr = index(temp_msg, "lat-center ") + len("lat_center ") - read(temp_msg(istr:istr+9),"(F8.5)") latin1 - istr = index(temp_msg, "lon-center ") + len("lon-center ") - read(temp_msg(istr:istr+10),"(F9.6)") lov - - print*, "- CALL CALCALPHA_ROTLATLON with center lat,lon = ",latin1,lov - call calcalpha_rotlatlon(lat,lon,latin1,lov,alpha) - print*, " alpha min/max = ",MINVAL(alpha),MAXVAL(alpha) - endif - elseif (trim(input_grid_type) == "lambert") then - !# NG this has been edited to correctly calculate gridrot for Lambert grids - ! Previously was incorrectly using polar-stereographic formation - print*,"- CALL FieldGather FOR INPUT GRID LONGITUDE" - call ESMF_FieldGather(longitude_input_grid, lon, rootPet=0, tile=1, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + print*,"- CALL FieldGather FOR INPUT GRID LATITUDE" + call ESMF_FieldGather(latitude_input_grid, lat, rootPet=0, tile=1, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", error) - if (localpet==0) then - error = grb2_inq(file, inv,grid_desc=temp_msg) - !1:0:grid_template=30:winds(grid): - ! Lambert Conformal: (1799 x 1059) input WE:SN output WE:SN res 8 - ! Lat1 21.138123 Lon1 237.280472 LoV 262.500000 - ! LatD 38.500000 Latin1 38.500000 Latin2 38.500000 - ! LatSP 0.000000 LonSP 0.000000 - ! North Pole (1799 x 1059) Dx 3000.000000 m Dy 3000.000000 m mode 8 - - istr = index(temp_msg, "LoV ") + len("LoV ") - read(temp_msg(istr:istr+10),"(F9.6)") lov - istr = index(temp_msg, "Latin1 ") + len("Latin1 ") - read(temp_msg(istr:istr+9),"(F8.5)") latin1 - istr = index(temp_msg, "Latin2 ") + len("Latin2 ") - read(temp_msg(istr:istr+9),"(F8.5)") latin2 + if (localpet==0) then + + lugi = 0 ! index file unit number + jdisc = 0 ! search for discipline - meteorological products + j = 0 ! search at beginning of file. + jpdt = -9999 ! array of values in product definition template, set to wildcard + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template, set to wildcard + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + unpack=.false. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret /= 0) call error_handler("ERROR READING GRIB2 FILE.", iret) + + if (gfld%igdtnum == 32769) then ! grid definition template number - rotated lat/lon grid + + latin1 = float(gfld%igdtmpl(15))/1.0E6 + lov = float(gfld%igdtmpl(16))/1.0E6 + + print*, "- CALL CALCALPHA_ROTLATLON with center lat,lon = ",latin1,lov + call calcalpha_rotlatlon(lat,lon,latin1,lov,alpha) + + elseif (gfld%igdtnum == 30) then ! grid definition template number - lambert conformal grid. + + lov = float(gfld%igdtmpl(14))/1.0E6 + latin1 = float(gfld%igdtmpl(19))/1.0E6 + latin2 = float(gfld%igdtmpl(20))/1.0E6 print*, "- CALL GRIDROT for LC grid with lov,latin1/2 = ",lov,latin1,latin2 call gridrot(lov,latin1,latin2,lon,alpha) - print*, " alpha min/max = ",MINVAL(alpha),MAXVAL(alpha) + endif - endif - if (localpet==0) then + if (isnative) then + jpdt(10) = 105 ! Sec4/oct 23 - type of level - hybrid + else + jpdt(10) = 100 ! Sec4/oct 23 - type of level - isobaric + endif + + unpack=.true. + + allocate(dum2d(i_input,j_input)) + allocate(u_tmp(i_input,j_input)) + allocate(v_tmp(i_input,j_input)) + do vlev = 1, lev_input vname = ":UGRD:" - iret = grb2_inq(file,inv,vname,slevs(vlev),data2=u_tmp) - if (iret <= 0) then + + jpdt(1) = 2 ! Sec4/oct 10 - parameter category - momentum + jpdt(2) = 2 ! Sec4/oct 11 - parameter number - u-wind + jpdt(12) = nint(rlevs(vlev)) ! Sect4/octs 25-28 - scaled value of fixed surface. + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret /= 0) then call handle_grib_error(vname, slevs(vlev),method_u,value_u,varnum_u,iret,var=u_tmp) if (iret==1) then ! missing_var_method == skip call error_handler("READING IN U AT LEVEL "//trim(slevs(vlev))//". SET A FILL "// & "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret) endif + else + dum2d = reshape(gfld%fld, (/i_input,j_input/) ) + u_tmp(:,:) = dum2d endif vname = ":VGRD:" - iret = grb2_inq(file,inv,vname,slevs(vlev),data2=v_tmp) - if (iret <= 0) then + + jpdt(2) = 3 ! Sec4/oct 11 - parameter number - v-wind + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, iret) + + if (iret /= 0) then call handle_grib_error(vname, slevs(vlev),method_v,value_v,varnum_v,iret,var=v_tmp) if (iret==1) then ! missing_var_method == skip call error_handler("READING IN V AT LEVEL "//trim(slevs(vlev))//". SET A FILL "// & - "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret) + "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret) endif - endif + else + dum2d = reshape(gfld%fld, (/i_input,j_input/) ) + v_tmp(:,:) = dum2d + endif - if (trim(input_grid_type) == "latlon") then + deallocate(dum2d) + + if (gfld%igdtnum == 0) then ! grid definition template number - lat/lon grid if (external_model == 'UKMET') then u(:,:,vlev) = u_tmp v(:,:,vlev) = (v_tmp(:,2:jp1_input) + v_tmp(:,1:j_input))/2 @@ -6280,7 +6932,7 @@ subroutine read_winds(file,inv,u,v,localpet) u(:,:,vlev) = u_tmp v(:,:,vlev) = v_tmp endif - else if (trim(input_grid_type) == "rotated_latlon") then + else if (gfld%igdtnum == 32769) then ! grid definition template number - rotated lat/lon grid ws = sqrt(u_tmp**2 + v_tmp**2) wd = atan2(-u_tmp,-v_tmp) / d2r ! calculate grid-relative wind direction wd = wd + alpha + 180.0 ! Rotate from grid- to earth-relative direction @@ -6498,13 +7150,13 @@ subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d) read_from_input(varnum) = .false. iret = 1 elseif (trim(method) == "set_to_fill") then - print*, "WARNING: ,", trim(vname), " NOT AVILABLE AT LEVEL ", trim(lev), & + print*, "WARNING: ,", trim(vname), " NOT AVAILABLE AT LEVEL ", trim(lev), & ". SETTING EQUAL TO FILL VALUE OF ", value if(present(var)) var(:,:) = value if(present(var8)) var8(:,:) = value if(present(var3d)) var3d(:,:,:) = value elseif (trim(method) == "set_to_NaN") then - print*, "WARNING: ,", trim(vname), " NOT AVILABLE AT LEVEL ", trim(lev), & + print*, "WARNING: ,", trim(vname), " NOT AVAILABLE AT LEVEL ", trim(lev), & ". SETTING EQUAL TO NaNs" if(present(var)) var(:,:) = ieee_value(var,IEEE_QUIET_NAN) if(present(var8)) var8(:,:) = ieee_value(var8,IEEE_QUIET_NAN) @@ -6527,67 +7179,104 @@ end subroutine handle_grib_error !> Read soil temperature and soil moisture fields from a GRIB2 file. !! -!! @param [in] the_file grib2 file name -!! @param [in] inv_file grib2 inventory file name !! @param [in] vname variable name in varmap table !! @param [in] vname_file variable name in grib2 file +!! @param [in] lugb logical unit number for surface grib2 file !! @param [inout] dummy3d array of soil data -!! @param [out] rc read error status code !! @author George Gayno NCEP/EMC -subroutine read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) - - use wgrib2api - implicit none + subroutine read_grib_soil(vname, vname_file, lugb, dummy3d) - character(len=*), intent(in) :: the_file, inv_file - character(len=20), intent(in) :: vname,vname_file + use grib_mod + + implicit none - integer, intent(out) :: rc + character(len=20), intent(in) :: vname,vname_file - real(esmf_kind_r8), intent(inout) :: dummy3d(:,:,:) + integer, intent(in) :: lugb + + real(esmf_kind_r8), intent(inout) :: dummy3d(:,:,:) - real(esmf_kind_r4), allocatable :: dummy2d(:,:) - real(esmf_kind_r4) :: value - integer :: varnum,i - character(len=50) :: slevs(lsoil_input) - character(len=50) :: method + character(len=50) :: slevs(lsoil_input) + character(len=50) :: method + + integer :: varnum, i, j, k, rc, rc2 + integer :: jdisc, jgdtn, jpdtn, lugi + integer :: jids(200), jgdt(200), jpdt(200) + integer :: iscale1, iscale2 + + logical :: unpack + + real(esmf_kind_r4), allocatable :: dummy2d(:,:) + real(esmf_kind_r4) :: value + + type(gribfield) :: gfld - allocate(dummy2d(i_input,j_input)) + allocate(dummy2d(i_input,j_input)) - if(lsoil_input == 4) then + if(lsoil_input == 4) then slevs = (/character(24)::':0-0.1 m below ground:', ':0.1-0.4 m below ground:', & ':0.4-1 m below ground:', ':1-2 m below ground:'/) - elseif(lsoil_input == 9) then + elseif(lsoil_input == 9) then slevs = (/character(26)::':0-0 m below ground',':0.01-0.01 m below ground:',':0.04-0.04 m below ground:', & ':0.1-0.1 m below ground:',':0.3-0.3 m below ground:',':0.6-0.6 m below ground:', & ':1-1 m below ground:',':1.6-1.6 m below ground:',':3-3 m below ground:'/) - else + else rc = -1 call error_handler("reading soil levels. File must have 4 or 9 soil levels.", rc) - endif + endif - call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & loc=varnum) - do i = 1,lsoil_input - if (vname_file=="var2_2_1_") then - rc = grb2_inq(the_file,inv_file,vname_file,"_0_192:",slevs(i),data2=dummy2d) - else - rc = grb2_inq(the_file,inv_file,vname_file,slevs(i),data2=dummy2d) - endif - if (rc <= 0) then - call handle_grib_error(vname_file, slevs(i),method,value,varnum,rc,var=dummy2d) - if (rc==1 .and. trim(vname) /= "soill") then - ! missing_var_method == skip or no entry in varmap table - call error_handler("READING IN "//trim(vname)//". SET A FILL "// & + + lugi = 0 ! unit number for index file + jdisc = 2 ! search for discipline - land products + j = 0 ! search at beginning of file. + jpdt = -9999 ! array of values in product definition template 4.n + jids = -9999 ! array of values in identification section, set to wildcard + jgdt = -9999 ! array of values in grid definition template 3.m + jgdtn = -1 ! search for any grid definition number. + jpdtn = 0 ! search for product def template number 0 - anl or fcst. + jpdt(1) = 0 ! oct 10 - param cat - veg/biomass + if (trim(vname) == 'soilt') jpdt(2) = 2 ! oct 11 - param number - soil temp + if (trim(vname) == 'soilw') jpdt(2) = 192 ! oct 11 - param number - total soilm + if (trim(vname) == 'soill') then + jpdt(1) = 3 ! oct 10 - soil products + jpdt(2) = 192 ! oct 11 - param number - liquid soilm + endif + jpdt(10) = 106 ! oct 23 - depth below ground + jpdt(13) = 106 ! oct 29 - depth below ground + unpack=.true. + + do i = 1,lsoil_input + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc2) + + if (rc2 /= 0) then ! record not found. + call handle_grib_error(vname_file, slevs(i),method,value,varnum,rc,var=dummy2d) + if (rc==1 .and. trim(vname) /= "soill") then + ! missing_var_method == skip or no entry in varmap table + call error_handler("READING IN "//trim(vname)//". SET A FILL "// & "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",rc) - elseif (rc==1) then - dummy3d(:,:,:) = 0.0_esmf_kind_r8 - exit - endif - endif + elseif (rc==1) then + dummy3d(:,:,:) = 0.0_esmf_kind_r8 + return + endif + endif + + if (rc2 == 0) then ! record found. + iscale1 = 10 ** gfld%ipdtmpl(11) + iscale2 = 10 ** gfld%ipdtmpl(14) +! print*,'getgb2 top of soil layer in m ', float(gfld%ipdtmpl(12))/float(iscale1) +! print*,'getgb2 bot of soil layer in m ', float(gfld%ipdtmpl(15))/float(iscale2) + dummy2d = reshape(gfld%fld, (/i_input,j_input/) ) + endif - dummy3d(:,:,i) = real(dummy2d,esmf_kind_r8) - end do + j = k + + dummy3d(:,:,i) = real(dummy2d,esmf_kind_r8) + + enddo deallocate(dummy2d) @@ -6776,15 +7465,15 @@ end subroutine check_soilt subroutine check_cnwat(cnwat) implicit none - real(esmf_kind_r4), intent(inout) :: cnwat(i_input,j_input) + real(esmf_kind_r8), intent(inout) :: cnwat(i_input,j_input) - real(esmf_kind_r4) :: max_cnwat = 0.5 + real(esmf_kind_r8) :: max_cnwat = 0.5 integer :: i, j do i = 1,i_input do j = 1,j_input - if (cnwat(i,j) .gt. max_cnwat) cnwat(i,j) = 0.0_esmf_kind_r4 + if (cnwat(i,j) .gt. max_cnwat) cnwat(i,j) = 0.0_esmf_kind_r8 enddo enddo end subroutine check_cnwat diff --git a/sorc/chgres_cube.fd/model_grid.F90 b/sorc/chgres_cube.fd/model_grid.F90 index 028693f35..0cf0257a2 100644 --- a/sorc/chgres_cube.fd/model_grid.F90 +++ b/sorc/chgres_cube.fd/model_grid.F90 @@ -700,8 +700,12 @@ subroutine define_input_grid_gfs_grib2(localpet, npets) longitude(i,:) = real(lon4(i,:),kind=esmf_kind_r8) enddo +! Flip the poles, to be consistent with how the g2lib degribs +! gfs data. + do i = 1, j_input - latitude(:,i) = real(lat4(:,i),kind=esmf_kind_r8) + latitude(:,i) = real(lat4(:,j_input-i+1),kind=esmf_kind_r8) +! if (localpet == 0) print*,'gfs lat ',i,latitude(1,i) enddo deallocate(lat4, lon4) @@ -783,11 +787,11 @@ subroutine define_input_grid_gfs_grib2(localpet, npets) lon_corner_src_ptr(i,j) = longitude(i,1) - (0.5_esmf_kind_r8*deltalon) if (lon_corner_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_corner_src_ptr(i,j) = lon_corner_src_ptr(i,j) - 360.0_esmf_kind_r8 if (j == 1) then - lat_corner_src_ptr(i,j) = -90.0_esmf_kind_r8 + lat_corner_src_ptr(i,j) = +90.0_esmf_kind_r8 cycle endif if (j == jp1_input) then - lat_corner_src_ptr(i,j) = +90.0_esmf_kind_r8 + lat_corner_src_ptr(i,j) = -90.0_esmf_kind_r8 cycle endif lat_corner_src_ptr(i,j) = 0.5_esmf_kind_r8 * (latitude(i,j-1)+ latitude(i,j)) diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index adcf0621b..73274ca76 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -42,6 +42,18 @@ add_executable(ftst_utils ftst_utils.F90) add_test(NAME chgres_cube-ftst_utils COMMAND ftst_utils) target_link_libraries(ftst_utils chgres_cube_lib) +add_executable(ftst_read_atm_grib2 ftst_read_atm_grib2.F90) +target_link_libraries(ftst_read_atm_grib2 chgres_cube_lib) +add_mpi_test(chgres_cube-ftst_read_atm_grib2 + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_read_atm_grib2 + NUMPROCS 1 TIMEOUT 60) + +add_executable(ftst_read_sfc_grib2 ftst_read_sfc_grib2.F90) +target_link_libraries(ftst_read_sfc_grib2 chgres_cube_lib) +add_mpi_test(chgres_cube-ftst_read_sfc_grib2 + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_read_sfc_grib2 + NUMPROCS 1 TIMEOUT 60) + add_executable(ftst_program_setup ftst_program_setup.F90) target_link_libraries(ftst_program_setup chgres_cube_lib) add_mpi_test(chgres_cube-ftst_program_setup diff --git a/tests/chgres_cube/LSanSuppress.supp b/tests/chgres_cube/LSanSuppress.supp index 7c73079ce..61404b2a9 100644 --- a/tests/chgres_cube/LSanSuppress.supp +++ b/tests/chgres_cube/LSanSuppress.supp @@ -2,4 +2,5 @@ leak:ESMCI leak:ESMC leak:esmc leak:esmf +leak:g2 leak:std::vector diff --git a/tests/chgres_cube/data/files.txt b/tests/chgres_cube/data/files.txt index de82305d7..e214957a4 100644 --- a/tests/chgres_cube/data/files.txt +++ b/tests/chgres_cube/data/files.txt @@ -3,3 +3,4 @@ https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgre https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v16.atm.history.nc https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v14.sfc.history.nemsio https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v15.sfc.history.nemsio +https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.t00z.pgrb2.0p50.f000 diff --git a/tests/chgres_cube/ftst_read_atm_grib2.F90 b/tests/chgres_cube/ftst_read_atm_grib2.F90 new file mode 100644 index 000000000..b9a030974 --- /dev/null +++ b/tests/chgres_cube/ftst_read_atm_grib2.F90 @@ -0,0 +1,256 @@ + program read_atm_grib2 + +! Unit test for the "read_input_atm_grib2_file" +! routine of chgres_cube. +! +! Reads a 0.5-degree GFS GRIB2 file. The data read +! from the file is compared to expected values as +! determined from the 'wgrib2' stand-alone utility. +! +! Author George Gayno + + use esmf + + use input_data, only : read_input_atm_data, & + lev_input, & + levp1_input, & + temp_input_grid, tracers_input_grid, & + dzdt_input_grid, pres_input_grid, & + ps_input_grid, wind_input_grid, & + terrain_input_grid + + use program_setup, only : input_type, data_dir_input_grid, & + grib2_file_input_grid, & + read_varmap, varmap_file, & + num_tracers, num_tracers_input, & + tracers, tracers_input, external_model + + use model_grid, only : input_grid, & + i_input, j_input, & + latitude_input_grid, & + longitude_input_grid + + implicit none + + type(esmf_vm) :: vm + + type(esmf_polekind_flag) :: polekindflag(2) + + integer, parameter :: EXPECTED_LEV_INPUT=31 ! Number of vertical layers. + integer, parameter :: EXPECTED_LEVP1_INPUT=32 ! Number of vertical layer + ! interfaces. + + integer, parameter :: NUM_VALUES=2 ! Number of values compared per record. + + real, parameter :: EPSILON=0.0001 + real, parameter :: EPSILON_SMALL=0.0000001 + + integer :: rc, localpet, n, npets + integer :: i_check(NUM_VALUES), j_check(NUM_VALUES), k_check(NUM_VALUES) + + real(esmf_kind_r8), allocatable :: latitude(:,:) + real(esmf_kind_r8), allocatable :: longitude(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data3d_one_tile(:,:,:) + real(esmf_kind_r8), allocatable :: data4d_one_tile(:,:,:,:) + + real :: expected_values_tmp(NUM_VALUES) + real :: expected_values_sphum(NUM_VALUES) + real :: expected_values_liq_wat(NUM_VALUES) + real :: expected_values_o3mr(NUM_VALUES) + real :: expected_values_icewat(NUM_VALUES) + real :: expected_values_rainwat(NUM_VALUES) + real :: expected_values_snowwat(NUM_VALUES) + real :: expected_values_graupel(NUM_VALUES) + real :: expected_values_dzdt(NUM_VALUES) + real :: expected_values_pres(NUM_VALUES) + real :: expected_values_ps(NUM_VALUES) + real :: expected_values_terrain(NUM_VALUES) + real :: expected_values_xwind(NUM_VALUES) + real :: expected_values_ywind(NUM_VALUES) + real :: expected_values_zwind(NUM_VALUES) + +! The expected values were determined by the checking +! the input GRIB2 file using stand-alone 'wgrib2'. + + data expected_values_tmp / 300.5728, 262.8000 / ! Temperature + data expected_values_sphum / 0.01659, 0.0 / ! Specific humidity + data expected_values_liq_wat / 0.0, 0.0 / ! Cloud liquid water + data expected_values_o3mr / 6.69e-08, 4.94e-06 / ! Ozone + data expected_values_icewat / 0.0, 0.0 / ! Ice water + data expected_values_rainwat / 0.0, 0.0 / ! Rain water + data expected_values_snowwat / 0.0, 0.0 / ! Snow water + data expected_values_graupel / 0.0, 0.0 / ! Graupel + data expected_values_dzdt / 8.48e-03, 0.0 / ! Vertical velocity + data expected_values_pres / 100000.0, 100.0 / ! 3-d pressure + data expected_values_ps / 100662.9, 100662.9 / ! Surface pressure + data expected_values_terrain / 5.973e-2, 5.973e-2 / ! Terrain height + data expected_values_xwind / -6.3605, 7.3208 / ! x-component wind + data expected_values_ywind / -0.1167, -5.1422 / ! y-component wind + data expected_values_zwind / 0.0, 0.0 / ! z-component wind + + print*,"Starting test of read_atm_grib2_file." + + call mpi_init(rc) + + call ESMF_Initialize(rc=rc) + + call ESMF_VMGetGlobal(vm, rc=rc) + + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=rc) + + external_model="GFS" + input_type="grib2" +!data_dir_input_grid = "/scratch1/NCEPDEV/da/George.Gayno/noscrub/reg_tests/chgres_cube/input_data/gfs.grib2" + data_dir_input_grid = "data/" + grib2_file_input_grid = "gfs.t00z.pgrb2.0p50.f000" + + i_input = 720 + j_input = 361 + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + input_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/i_input,j_input/), & + polekindflag=polekindflag, & + periodicDim=1, & + poleDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + regDecomp=(/1,npets/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + + num_tracers=7 + num_tracers_input=num_tracers + + tracers_input(1)="spfh" + tracers_input(2)="clwmr" + tracers_input(3)="o3mr" + tracers_input(4)="icmr" + tracers_input(5)="rwmr" + tracers_input(6)="snmr" + tracers_input(7)="grle" + + tracers(1)="sphum" + tracers(2)="liq_wat" + tracers(3)="o3mr" + tracers(4)="ice_wat" + tracers(5)="rainwat" + tracers(6)="snowwat" + tracers(7)="graupel" + + varmap_file ="./data/GFSphys_varmap.txt" + call read_varmap + + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", & + rc=rc) + + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + +! Using the north pole/greenwich simplifies the comparison +! of u/v winds. + + allocate(latitude(i_input,j_input)) + allocate(longitude(i_input,j_input)) + latitude=90.0 + longitude=0.0 + + call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) + +! Call the chgres_cube read routine. + + call read_input_atm_data(localpet) + +! Compare what was read to expected values. + + if (lev_input /= EXPECTED_LEV_INPUT) stop 2 + if (levp1_input /= EXPECTED_LEVP1_INPUT) stop 3 + + allocate(data3d_one_tile(i_input,j_input,lev_input)) + allocate(data4d_one_tile(i_input,j_input,lev_input,3)) + allocate(data_one_tile(i_input,j_input)) + +! The i/j/k of the points to be checked. + + i_check(1) = i_input/2 + j_check(1) = 182 + k_check(1) = 1 + + i_check(2) = i_input/2 + j_check(2) = 182 + k_check(2) = lev_input + + call ESMF_FieldGather(temp_input_grid, data3d_one_tile, rootPet=0, rc=rc) + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_tmp(1)) > EPSILON) stop 4 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_tmp(2)) > EPSILON) stop 5 + + do n = 1, num_tracers + call ESMF_FieldGather(tracers_input_grid(n), data3d_one_tile, rootPet=0, rc=rc) + if (trim(tracers(n)) == 'sphum') then + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_sphum(1)) > EPSILON) stop 6 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_sphum(2)) > EPSILON_SMALL) stop 7 + endif + if (trim(tracers(n)) == 'liq_wat') then + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_liq_wat(1)) > EPSILON_SMALL) stop 8 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_liq_wat(2)) > EPSILON_SMALL) stop 9 + endif + if (trim(tracers(n)) == 'o3mr') then + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_o3mr(1)) > EPSILON_SMALL) stop 10 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_o3mr(2)) > EPSILON_SMALL) stop 11 + endif + if (trim(tracers(n)) == 'ice_wat') then + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_icewat(1)) > EPSILON_SMALL) stop 12 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_icewat(2)) > EPSILON_SMALL) stop 13 + endif + if (trim(tracers(n)) == 'rainwat') then + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_rainwat(1)) > EPSILON_SMALL) stop 14 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_rainwat(2)) > EPSILON_SMALL) stop 15 + endif + if (trim(tracers(n)) == 'snowwat') then + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_snowwat(1)) > EPSILON_SMALL) stop 16 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_snowwat(2)) > EPSILON_SMALL) stop 17 + endif + if (trim(tracers(n)) == 'graupel') then + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_graupel(1)) > EPSILON_SMALL) stop 18 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_graupel(2)) > EPSILON_SMALL) stop 19 + endif + enddo + + call ESMF_FieldGather(dzdt_input_grid, data3d_one_tile, rootPet=0, rc=rc) + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_dzdt(1)) > EPSILON) stop 20 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_dzdt(2)) > EPSILON) stop 21 + + call ESMF_FieldGather(pres_input_grid, data3d_one_tile, rootPet=0, rc=rc) + if (abs(data3d_one_tile(i_check(1),j_check(1),k_check(1)) - expected_values_pres(1)) > EPSILON) stop 22 + if (abs(data3d_one_tile(i_check(2),j_check(2),k_check(2)) - expected_values_pres(2)) > EPSILON) stop 23 + + call ESMF_FieldGather(wind_input_grid, data4d_one_tile, rootPet=0, rc=rc) + if (abs(data4d_one_tile(i_check(1),j_check(1),k_check(1),1) - expected_values_xwind(1)) > EPSILON) stop 24 + if (abs(data4d_one_tile(i_check(2),j_check(2),k_check(2),1) - expected_values_xwind(2)) > EPSILON) stop 25 + if (abs(data4d_one_tile(i_check(1),j_check(1),k_check(1),2) - expected_values_ywind(1)) > EPSILON) stop 26 + if (abs(data4d_one_tile(i_check(2),j_check(2),k_check(2),2) - expected_values_ywind(2)) > EPSILON) stop 27 + if (abs(data4d_one_tile(i_check(1),j_check(1),k_check(1),3) - expected_values_zwind(1)) > EPSILON) stop 28 + if (abs(data4d_one_tile(i_check(2),j_check(2),k_check(2),3) - expected_values_zwind(2)) > EPSILON) stop 29 + + call ESMF_FieldGather(ps_input_grid, data_one_tile, rootPet=0, rc=rc) + if (abs(data_one_tile(i_check(1),j_check(1)) - expected_values_ps(1)) > EPSILON) stop 32 + + call ESMF_FieldGather(terrain_input_grid, data_one_tile, rootPet=0, rc=rc) + if (abs(data_one_tile(i_check(1),j_check(1)) - expected_values_terrain(1)) > EPSILON) stop 34 + + deallocate(latitude, longitude, data3d_one_tile, data4d_one_tile, data_one_tile) + + call ESMF_finalize(endflag=ESMF_END_KEEPMPI) + + call mpi_finalize(rc) + + print*,"SUCCESS!" + + end program read_atm_grib2 diff --git a/tests/chgres_cube/ftst_read_sfc_grib2.F90 b/tests/chgres_cube/ftst_read_sfc_grib2.F90 new file mode 100644 index 000000000..5f587912a --- /dev/null +++ b/tests/chgres_cube/ftst_read_sfc_grib2.F90 @@ -0,0 +1,352 @@ + program read_sfc_grib2 + +! Unit test for the read_input_sfc_grib2_file routine. +! +! Reads a GFS GRIB2 file and compares the output +! to expected values. +! +! Author George Gayno + + use esmf + + use input_data, only : read_input_sfc_data, & + lsoil_input, & + terrain_input_grid, & + soilm_liq_input_grid, & + soilm_tot_input_grid, & + soil_temp_input_grid, & + landsea_mask_input_grid, & + seaice_fract_input_grid, & + seaice_depth_input_grid, & + seaice_skin_temp_input_grid, & + snow_liq_equiv_input_grid, & + snow_depth_input_grid, & + veg_type_input_grid, & + soil_type_input_grid, & + t2m_input_grid, & + q2m_input_grid, & + tprcp_input_grid, & + f10m_input_grid, & + ffmm_input_grid, & + ustar_input_grid, & + srflag_input_grid, & + skin_temp_input_grid, & + canopy_mc_input_grid, & + z0_input_grid + + use program_setup, only : external_model, data_dir_input_grid, & + grib2_file_input_grid, varmap_file, & + read_varmap, input_type + + use model_grid, only : input_grid, & + i_input, j_input, & + latitude_input_grid, & + longitude_input_grid + + implicit none + + integer, parameter :: NUM_VALUES=2 + + real, parameter :: EPSILON=0.001 + + integer :: localpet, npets, rc + + real(esmf_kind_r8), allocatable :: latitude(:,:) + real(esmf_kind_r8), allocatable :: longitude(:,:) + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + + type(esmf_vm) :: vm + + type(esmf_polekind_flag) :: polekindflag(2) + +! The expected values were determined by checking +! the input GRIB2 file using wgrib2. + + real :: landsea_mask_expected_values(NUM_VALUES) ! land-sea mask + real :: terrain_expected_values(NUM_VALUES) ! terrain height + real :: soilm_liq1_expected_values(NUM_VALUES) ! layer 1 liquid soil moisture + real :: soilm_liq2_expected_values(NUM_VALUES) ! layer 2 liquid soil moisture + real :: soilm_liq3_expected_values(NUM_VALUES) ! layer 3 liquid soil moisture + real :: soilm_liq4_expected_values(NUM_VALUES) ! layer 4 liquid soil moisture + real :: soilm_tot1_expected_values(NUM_VALUES) ! layer 1 total soil moisture + real :: soilm_tot2_expected_values(NUM_VALUES) ! layer 2 total soil moisture + real :: soilm_tot3_expected_values(NUM_VALUES) ! layer 3 total soil moisture + real :: soilm_tot4_expected_values(NUM_VALUES) ! layer 4 total soil moisture + real :: soil_temp1_expected_values(NUM_VALUES) ! layer 1 soil temperature + real :: soil_temp2_expected_values(NUM_VALUES) ! layer 2 soil temperature + real :: soil_temp3_expected_values(NUM_VALUES) ! layer 3 soil temperature + real :: soil_temp4_expected_values(NUM_VALUES) ! layer 4 soil temperature + real :: seaice_fract_expected_values(NUM_VALUES) ! sea ice fraction + real :: seaice_depth_expected_values(NUM_VALUES) ! sea ice depth + real :: seaice_skin_temp_expected_values(NUM_VALUES) ! sea ice skin temperature + real :: snow_liq_equiv_expected_values(NUM_VALUES) ! liquid equivalent snow depth + real :: snow_depth_expected_values(NUM_VALUES) ! physical snow depth + real :: veg_type_expected_values(NUM_VALUES) ! vegetation type + real :: soil_type_expected_values(NUM_VALUES) ! soil type + real :: t2m_expected_values(NUM_VALUES) ! two-meter temperature + real :: q2m_expected_values(NUM_VALUES) ! two-meter specific humidity + real :: tprcp_expected_values(NUM_VALUES) ! precipitation + real :: f10m_expected_values(NUM_VALUES) ! log((z0+10)*l/z0) + real :: ffmm_expected_values(NUM_VALUES) ! log((z0+z1)*l/z0) + real :: ustar_expected_values(NUM_VALUES) ! friction velocity + real :: srflag_expected_values(NUM_VALUES) ! snow/rain flag + real :: skin_temp_expected_values(NUM_VALUES) ! skin temperature + real :: canopy_mc_expected_values(NUM_VALUES) ! canopy moisture content + real :: z0_expected_values(NUM_VALUES) ! roughness length + + data terrain_expected_values / 2775.4197, 5.97e-02 / + data soilm_liq1_expected_values / 0.00, 0.00 / + data soilm_liq2_expected_values / 0.00, 0.00 / + data soilm_liq3_expected_values / 0.00, 0.00 / + data soilm_liq4_expected_values / 0.00, 0.00 / + data soilm_tot1_expected_values / 1.00, 0.00 / + data soilm_tot2_expected_values / 1.00, 0.00 / + data soilm_tot3_expected_values / 1.00, 0.00 / + data soilm_tot4_expected_values / 1.00, 0.00 / + data soil_temp1_expected_values / 236.1336, 265.0 / + data soil_temp2_expected_values / 228.5099, 265.0 / + data soil_temp3_expected_values / 225.7600, 265.0 / + data soil_temp4_expected_values / 228.1500, 265.0 / + data landsea_mask_expected_values / 1.0, 2.0 / + data seaice_fract_expected_values / 0.0, 1.0 / + data seaice_depth_expected_values / 1.5, 1.5/ + data seaice_skin_temp_expected_values / 235.8585, 243.8585/ + data snow_liq_equiv_expected_values / 120.0, 37.0 / + data snow_depth_expected_values / 1200.0, 110.0/ + data veg_type_expected_values / 15.0, 0.0 / + data soil_type_expected_values / -99999.0, -99999.0 / + data t2m_expected_values / 238.1991, 247.2991 / + data q2m_expected_values / 0.00016, 0.00035 / + data tprcp_expected_values / 0.0, 0.0 / + data f10m_expected_values / 0.0, 0.0/ + data ffmm_expected_values / 0.0, 0.0 / + data ustar_expected_values / 0.0, 0.0 / + data srflag_expected_values / 0.0, 0.0/ + data skin_temp_expected_values / 235.8585, 243.8585 / + data canopy_mc_expected_values / 0.0, 0.0 / + data z0_expected_values / 0.01, 0.01 / + + print*,"Starting test of read_atm_grib2_file." + + call mpi_init(rc) + + call ESMF_Initialize(rc=rc) + + call ESMF_VMGetGlobal(vm, rc=rc) + + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=rc) + + external_model="GFS" + input_type="grib2" +!data_dir_input_grid = "/scratch1/NCEPDEV/da/George.Gayno/noscrub/reg_tests/chgres_cube/input_data/gfs.grib2" + data_dir_input_grid = "data" + grib2_file_input_grid = "gfs.t00z.pgrb2.0p50.f000" + + i_input = 720 + j_input = 361 + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + input_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/i_input,j_input/), & + polekindflag=polekindflag, & + periodicDim=1, & + poleDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + regDecomp=(/1,npets/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + + varmap_file ="./data/GFSphys_varmap.txt" + call read_varmap + + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", & + rc=rc) + + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + +! Lat/lon used in surface read. Use flag values. + + allocate(latitude(i_input,j_input)) + allocate(longitude(i_input,j_input)) + latitude=90.0 + longitude=0.0 + + call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) + +! Call the chgres_cube read routine. + + call read_input_sfc_data(localpet) + + allocate(data_one_tile(i_input,j_input)) + allocate(data_one_tile_3d(i_input,j_input,lsoil_input)) + + call ESMF_FieldGather(terrain_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - terrain_expected_values(1)) > EPSILON) stop 6 + if (abs(data_one_tile(i_input,1) - terrain_expected_values(2)) > EPSILON) stop 8 + endif + + call ESMF_FieldGather(soilm_liq_input_grid, data_one_tile_3d, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile_3d(1,j_input,1) - soilm_liq1_expected_values(1)) > EPSILON) stop 10 + if (abs(data_one_tile_3d(i_input,1,1) - soilm_liq1_expected_values(2)) > EPSILON) stop 11 + if (abs(data_one_tile_3d(1,j_input,2) - soilm_liq2_expected_values(1)) > EPSILON) stop 12 + if (abs(data_one_tile_3d(i_input,1,2) - soilm_liq2_expected_values(2)) > EPSILON) stop 13 + if (abs(data_one_tile_3d(1,j_input,3) - soilm_liq3_expected_values(1)) > EPSILON) stop 14 + if (abs(data_one_tile_3d(i_input,1,3) - soilm_liq3_expected_values(2)) > EPSILON) stop 15 + if (abs(data_one_tile_3d(1,j_input,4) - soilm_liq4_expected_values(1)) > EPSILON) stop 16 + if (abs(data_one_tile_3d(i_input,1,4) - soilm_liq4_expected_values(2)) > EPSILON) stop 17 + endif + + call ESMF_FieldGather(soilm_tot_input_grid, data_one_tile_3d, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile_3d(1,j_input,1) - soilm_tot1_expected_values(1)) > EPSILON) stop 20 + if (abs(data_one_tile_3d(i_input,1,1) - soilm_tot1_expected_values(2)) > EPSILON) stop 21 + if (abs(data_one_tile_3d(1,j_input,2) - soilm_tot2_expected_values(1)) > EPSILON) stop 22 + if (abs(data_one_tile_3d(i_input,1,2) - soilm_tot2_expected_values(2)) > EPSILON) stop 23 + if (abs(data_one_tile_3d(1,j_input,3) - soilm_tot3_expected_values(1)) > EPSILON) stop 24 + if (abs(data_one_tile_3d(i_input,1,3) - soilm_tot3_expected_values(2)) > EPSILON) stop 25 + if (abs(data_one_tile_3d(1,j_input,4) - soilm_tot4_expected_values(1)) > EPSILON) stop 26 + if (abs(data_one_tile_3d(i_input,1,4) - soilm_tot4_expected_values(2)) > EPSILON) stop 27 + endif + + call ESMF_FieldGather(soil_temp_input_grid, data_one_tile_3d, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile_3d(1,j_input,1) - soil_temp1_expected_values(1)) > EPSILON) stop 30 + if (abs(data_one_tile_3d(i_input,1,1) - soil_temp1_expected_values(2)) > EPSILON) stop 31 + if (abs(data_one_tile_3d(1,j_input,2) - soil_temp2_expected_values(1)) > EPSILON) stop 32 + if (abs(data_one_tile_3d(i_input,1,2) - soil_temp2_expected_values(2)) > EPSILON) stop 33 + if (abs(data_one_tile_3d(1,j_input,3) - soil_temp3_expected_values(1)) > EPSILON) stop 34 + if (abs(data_one_tile_3d(i_input,1,3) - soil_temp3_expected_values(2)) > EPSILON) stop 35 + if (abs(data_one_tile_3d(1,j_input,4) - soil_temp4_expected_values(1)) > EPSILON) stop 36 + if (abs(data_one_tile_3d(i_input,1,4) - soil_temp4_expected_values(2)) > EPSILON) stop 37 + endif + + call ESMF_FieldGather(landsea_mask_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - landsea_mask_expected_values(1)) > EPSILON) stop 39 + if (abs(data_one_tile(i_input,1) - landsea_mask_expected_values(2)) > EPSILON) stop 40 + endif + + call ESMF_FieldGather(seaice_fract_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - seaice_fract_expected_values(1)) > EPSILON) stop 41 + if (abs(data_one_tile(i_input,1) - seaice_fract_expected_values(2)) > EPSILON) stop 42 + endif + + call ESMF_FieldGather(seaice_depth_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - seaice_depth_expected_values(1)) > EPSILON) stop 43 + if (abs(data_one_tile(i_input,1) - seaice_depth_expected_values(2)) > EPSILON) stop 44 + endif + + call ESMF_FieldGather(seaice_skin_temp_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - seaice_skin_temp_expected_values(1)) > EPSILON) stop 45 + if (abs(data_one_tile(i_input,1) - seaice_skin_temp_expected_values(2)) > EPSILON) stop 46 + endif + + call ESMF_FieldGather(snow_liq_equiv_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - snow_liq_equiv_expected_values(1)) > EPSILON) stop 47 + if (abs(data_one_tile(i_input,1) - snow_liq_equiv_expected_values(2)) > EPSILON) stop 48 + endif + + call ESMF_FieldGather(snow_depth_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - snow_depth_expected_values(1)) > EPSILON) stop 49 + if (abs(data_one_tile(i_input,1) - snow_depth_expected_values(2)) > EPSILON) stop 50 + endif + + call ESMF_FieldGather(veg_type_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - veg_type_expected_values(1)) > EPSILON) stop 51 + if (abs(data_one_tile(i_input,1) - veg_type_expected_values(2)) > EPSILON) stop 52 + endif + + call ESMF_FieldGather(soil_type_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - soil_type_expected_values(1)) > EPSILON) stop 53 + if (abs(data_one_tile(i_input,1) - soil_type_expected_values(2)) > EPSILON) stop 54 + endif + + call ESMF_FieldGather(t2m_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - t2m_expected_values(1)) > EPSILON) stop 55 + if (abs(data_one_tile(i_input,1) - t2m_expected_values(2)) > EPSILON) stop 56 + endif + + call ESMF_FieldGather(q2m_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - q2m_expected_values(1)) > EPSILON) stop 57 + if (abs(data_one_tile(i_input,1) - q2m_expected_values(2)) > EPSILON) stop 58 + endif + + call ESMF_FieldGather(tprcp_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - tprcp_expected_values(1)) > EPSILON) stop 59 + if (abs(data_one_tile(i_input,1) - tprcp_expected_values(2)) > EPSILON) stop 60 + endif + + call ESMF_FieldGather(f10m_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - f10m_expected_values(1)) > EPSILON) stop 61 + if (abs(data_one_tile(i_input,1) - f10m_expected_values(2)) > EPSILON) stop 62 + endif + + call ESMF_FieldGather(ffmm_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - ffmm_expected_values(1)) > EPSILON) stop 63 + if (abs(data_one_tile(i_input,1) - ffmm_expected_values(2)) > EPSILON) stop 64 + endif + + call ESMF_FieldGather(ustar_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - ustar_expected_values(1)) > EPSILON) stop 65 + if (abs(data_one_tile(i_input,1) - ustar_expected_values(2)) > EPSILON) stop 66 + endif + + call ESMF_FieldGather(srflag_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - srflag_expected_values(1)) > EPSILON) stop 67 + if (abs(data_one_tile(i_input,1) - srflag_expected_values(2)) > EPSILON) stop 68 + endif + + call ESMF_FieldGather(skin_temp_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - skin_temp_expected_values(1)) > EPSILON) stop 69 + if (abs(data_one_tile(i_input,1) - skin_temp_expected_values(2)) > EPSILON) stop 70 + endif + + call ESMF_FieldGather(canopy_mc_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - canopy_mc_expected_values(1)) > EPSILON) stop 71 + if (abs(data_one_tile(i_input,1) - canopy_mc_expected_values(2)) > EPSILON) stop 72 + endif + + call ESMF_FieldGather(z0_input_grid, data_one_tile, rootPet=0, rc=rc) + if (localpet == 0) then + if (abs(data_one_tile(1,j_input) - z0_expected_values(1)) > EPSILON) stop 73 + if (abs(data_one_tile(i_input,1) - z0_expected_values(2)) > EPSILON) stop 74 + endif + + deallocate (latitude, longitude) + deallocate (data_one_tile, data_one_tile_3d) + + call ESMF_finalize(endflag=ESMF_END_KEEPMPI) + + call mpi_finalize(rc) + + print*,"SUCCESS!" + + end program read_sfc_grib2 diff --git a/tests/chgres_cube/ftst_sfc_input_data.F90 b/tests/chgres_cube/ftst_sfc_input_data.F90 index e69db1763..75bf1bf19 100644 --- a/tests/chgres_cube/ftst_sfc_input_data.F90 +++ b/tests/chgres_cube/ftst_sfc_input_data.F90 @@ -22,7 +22,7 @@ program test_sfc_input_data soilt_updated(:,:,:), & soilt_correct(:,:,:) real(esmf_kind_r8), allocatable :: skint(:,:) - real(esmf_kind_r4), allocatable :: cnwat_bad(:,:), & + real(esmf_kind_r8), allocatable :: cnwat_bad(:,:), & cnwat_updated(:,:), & cnwat_correct(:,:) diff --git a/ush/chgres_cube.sh b/ush/chgres_cube.sh index c60eba605..550439049 100755 --- a/ush/chgres_cube.sh +++ b/ush/chgres_cube.sh @@ -272,8 +272,8 @@ cat << EOF > ./fort.41 convert_sfc=$CONVERT_SFC convert_nst=$CONVERT_NST input_type="${INPUT_TYPE}" - tracers=$TRACERS_TARGET - tracers_input=$TRACERS_INPUT + tracers=${TRACERS_TARGET} + tracers_input=${TRACERS_INPUT} regional=$REGIONAL halo_bndy=$HALO_BNDY halo_blend=$HALO_BLEND From a8b9a01fd9f9343bdd9756a4999fc08d8f1c5777 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Wed, 23 Mar 2022 16:18:15 -0400 Subject: [PATCH 026/109] Update workflow files to pull netcdf-c library from GitHub Fixes #638. --- .github/workflows/intel.yml | 4 ++-- .github/workflows/linux-mac-nceplibs-mpi.yml | 4 ++-- .github/workflows/netcdf-versions.yml | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index 5c747e3f9..e1743a8a1 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -56,8 +56,8 @@ jobs: export CC=mpiicc export CPPFLAGS=-I${HOME}/netcdf/include export LDFLAGS=-L${HOME}/netcdf/lib - wget https://www.unidata.ucar.edu/downloads/netcdf/ftp/netcdf-c-4.7.4.tar.gz &> /dev/null - tar -xzf netcdf-c-4.7.4.tar.gz + wget https://github.com/Unidata/netcdf-c/archive/refs/tags/v4.7.4.tar.gz &> /dev/null + tar -xzf v4.7.4.tar.gz pushd netcdf-c-4.7.4 ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities --disable-shared make -j2 diff --git a/.github/workflows/linux-mac-nceplibs-mpi.yml b/.github/workflows/linux-mac-nceplibs-mpi.yml index 870024a45..9250598fa 100644 --- a/.github/workflows/linux-mac-nceplibs-mpi.yml +++ b/.github/workflows/linux-mac-nceplibs-mpi.yml @@ -94,8 +94,8 @@ jobs: export CC=mpicc export CPPFLAGS=-I${HOME}/netcdf/include export LDFLAGS=-L${HOME}/netcdf/lib - wget https://www.unidata.ucar.edu/downloads/netcdf/ftp/netcdf-c-${{ matrix.netcdf_version }}.tar.gz &> /dev/null - tar -xzf netcdf-c-${{ matrix.netcdf_version }}.tar.gz + wget https://github.com/Unidata/netcdf-c/archive/refs/tags/v${{ matrix.netcdf_version }}.tar.gz &> /dev/null + tar -xzf v${{ matrix.netcdf_version }}.tar.gz cd netcdf-c-${{ matrix.netcdf_version }} ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities --disable-shared make -j2 diff --git a/.github/workflows/netcdf-versions.yml b/.github/workflows/netcdf-versions.yml index a4ec9a5e4..2040e6b72 100644 --- a/.github/workflows/netcdf-versions.yml +++ b/.github/workflows/netcdf-versions.yml @@ -47,8 +47,8 @@ jobs: export CC=mpicc export CPPFLAGS=-I${HOME}/netcdf/include export LDFLAGS=-L${HOME}/netcdf/lib - wget https://www.unidata.ucar.edu/downloads/netcdf/ftp/netcdf-c-${{ matrix.netcdf_version }}.tar.gz &> /dev/null - tar -xzf netcdf-c-${{ matrix.netcdf_version }}.tar.gz + wget https://github.com/Unidata/netcdf-c/archive/refs/tags/v${{ matrix.netcdf_version }}.tar.gz &> /dev/null + tar -xzf v${{ matrix.netcdf_version }}.tar.gz cd netcdf-c-${{ matrix.netcdf_version }} ./configure --prefix=${HOME}/netcdf --disable-dap --disable-utilities --disable-shared make -j2 From 31271f7ae86c40e0b3974cb6f845343d1a2ebb91 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 25 Mar 2022 18:08:47 -0400 Subject: [PATCH 027/109] Eliminate circular dependency in chgres_cube New module to hold the atmospheric target data and its clean up routine. New module to hold the surface target data and its clean up routine. Convert write_data.F90 to a Fortran module. Fixes #459. --- sorc/chgres_cube.fd/CMakeLists.txt | 2 + sorc/chgres_cube.fd/atmosphere.F90 | 72 +++---- .../chgres_cube.fd/atmosphere_target_data.F90 | 83 +++++++++ sorc/chgres_cube.fd/surface.F90 | 175 ++++-------------- sorc/chgres_cube.fd/surface_target_data.F90 | 173 +++++++++++++++++ sorc/chgres_cube.fd/write_data.F90 | 60 +++--- tests/chgres_cube/ftst_read_vcoord.F90 | 11 +- .../chgres_cube/ftst_surface_nst_landfill.F90 | 14 +- .../chgres_cube/ftst_surface_regrid_many.F90 | 6 +- 9 files changed, 358 insertions(+), 238 deletions(-) create mode 100644 sorc/chgres_cube.fd/atmosphere_target_data.F90 create mode 100644 sorc/chgres_cube.fd/surface_target_data.F90 diff --git a/sorc/chgres_cube.fd/CMakeLists.txt b/sorc/chgres_cube.fd/CMakeLists.txt index c148cfb8c..7ed7d156d 100644 --- a/sorc/chgres_cube.fd/CMakeLists.txt +++ b/sorc/chgres_cube.fd/CMakeLists.txt @@ -5,12 +5,14 @@ set(lib_src atmosphere.F90 + atmosphere_target_data.F90 grib2_util.F90 input_data.F90 model_grid.F90 program_setup.F90 search_util.F90 static_data.F90 + surface_target_data.F90 surface.F90 thompson_mp_climo_data.F90 wam_climo_data.f90 diff --git a/sorc/chgres_cube.fd/atmosphere.F90 b/sorc/chgres_cube.fd/atmosphere.F90 index e00568a8a..12d117fd4 100644 --- a/sorc/chgres_cube.fd/atmosphere.F90 +++ b/sorc/chgres_cube.fd/atmosphere.F90 @@ -20,6 +20,15 @@ module atmosphere use esmf + use atmosphere_target_data, only : lev_target, levp1_target, nvcoord_target, & + vcoord_target, delp_target_grid, & + dzdt_target_grid, ps_target_grid, & + temp_target_grid, tracers_target_grid, & + u_s_target_grid, v_s_target_grid, & + u_w_target_grid, v_w_target_grid, & + zh_target_grid, qnwfa_climo_target_grid, & + qnifa_climo_target_grid + use input_data, only : lev_input, & levp1_input, & tracers_input_grid, & @@ -56,50 +65,32 @@ module atmosphere thomp_pres_climo_input_grid, & lev_thomp_mp_climo + use write_data, only : write_fv3_atm_header_netcdf, & + write_fv3_atm_bndy_data_netcdf, & + write_fv3_atm_data_netcdf + implicit none private - integer, public :: lev_target !< num vertical levels - integer, public :: levp1_target !< num levels plus 1 - integer, public :: nvcoord_target !< num vertical coordinate variables - - real(esmf_kind_r8), allocatable, public :: vcoord_target(:,:) !< vertical coordinate - - type(esmf_field), public :: delp_target_grid !< pressure thickness - type(esmf_field), public :: dzdt_target_grid !< vertical velocity type(esmf_field) :: dzdt_b4adj_target_grid !< vertical vel before vert adj - type(esmf_field), allocatable, public :: tracers_target_grid(:) !< tracers type(esmf_field), allocatable :: tracers_b4adj_target_grid(:) !< tracers before vert adj - type(esmf_field), public :: ps_target_grid !< surface pressure type(esmf_field) :: ps_b4adj_target_grid !< sfc pres before terrain adj type(esmf_field) :: pres_target_grid !< 3-d pressure type(esmf_field) :: pres_b4adj_target_grid !< 3-d pres before terrain adj - type(esmf_field), public :: temp_target_grid !< temperautre type(esmf_field) :: temp_b4adj_target_grid !< temp before vert adj type(esmf_field) :: terrain_interp_to_target_grid !< Input grid terrain interpolated to target grid. - type(esmf_field), public :: u_s_target_grid !< u-wind, 'south' edge - type(esmf_field), public :: v_s_target_grid !< v-wind, 'south' edge type(esmf_field) :: wind_target_grid !< 3-d wind, grid box center type(esmf_field) :: wind_b4adj_target_grid !< 3-d wind before vert adj type(esmf_field) :: wind_s_target_grid !< 3-d wind, 'south' edge - type(esmf_field), public :: u_w_target_grid !< u-wind, 'west' edge - type(esmf_field), public :: v_w_target_grid !< v-wind, 'west' edge type(esmf_field) :: wind_w_target_grid !< 3-d wind, 'west' edge - type(esmf_field), public :: zh_target_grid !< 3-d height ! Fields associated with thompson microphysics climatological tracers. type(esmf_field) :: qnifa_climo_b4adj_target_grid !< number concentration of ice !! friendly aerosols before vert adj - type(esmf_field), public :: qnifa_climo_target_grid !< number concentration of ice - !! friendly aerosols on target - !! horiz/vert grid. type(esmf_field) :: qnwfa_climo_b4adj_target_grid !< number concentration of water !! friendly aerosols before vert adj - type(esmf_field), public :: qnwfa_climo_target_grid !< number concentration of water - !! friendly aerosols on target - !! horiz/vert grid. type(esmf_field) :: thomp_pres_climo_b4adj_target_grid !< pressure of each level on !! target grid @@ -429,7 +420,7 @@ subroutine atmosphere_driver(localpet) ! Free up memory. !----------------------------------------------------------------------------------- - call cleanup_target_atm_data + call cleanup_all_target_atm_data end subroutine atmosphere_driver @@ -2189,42 +2180,23 @@ end subroutine cleanup_target_atm_b4adj_data !> Cleanup target grid atmospheric field objects. !! @author George Gayno - subroutine cleanup_target_atm_data + subroutine cleanup_all_target_atm_data + + use atmosphere_target_data, only : cleanup_atmosphere_target_data implicit none - integer :: i, rc + integer :: rc - print*,"- DESTROY TARGET GRID ATMOSPHERIC FIELDS." + print*,"- DESTROY LOCAL TARGET GRID ATMOSPHERIC FIELDS." - call ESMF_FieldDestroy(delp_target_grid, rc=rc) - call ESMF_FieldDestroy(dzdt_target_grid, rc=rc) - call ESMF_FieldDestroy(ps_target_grid, rc=rc) - call ESMF_FieldDestroy(pres_target_grid, rc=rc) - call ESMF_FieldDestroy(temp_target_grid, rc=rc) - call ESMF_FieldDestroy(u_s_target_grid, rc=rc) - call ESMF_FieldDestroy(v_s_target_grid, rc=rc) call ESMF_FieldDestroy(wind_target_grid, rc=rc) call ESMF_FieldDestroy(wind_s_target_grid, rc=rc) call ESMF_FieldDestroy(wind_w_target_grid, rc=rc) - call ESMF_FieldDestroy(u_w_target_grid, rc=rc) - call ESMF_FieldDestroy(v_w_target_grid, rc=rc) - call ESMF_FieldDestroy(zh_target_grid, rc=rc) - - do i = 1, num_tracers - call ESMF_FieldDestroy(tracers_target_grid(i), rc=rc) - enddo - - deallocate(tracers_target_grid) - - if (ESMF_FieldIsCreated(qnifa_climo_target_grid)) then - call ESMF_FieldDestroy(qnifa_climo_target_grid, rc=rc) - endif + call ESMF_FieldDestroy(pres_target_grid, rc=rc) - if (ESMF_FieldIsCreated(qnwfa_climo_target_grid)) then - call ESMF_FieldDestroy(qnwfa_climo_target_grid, rc=rc) - endif + call cleanup_atmosphere_target_data - end subroutine cleanup_target_atm_data + end subroutine cleanup_all_target_atm_data end module atmosphere diff --git a/sorc/chgres_cube.fd/atmosphere_target_data.F90 b/sorc/chgres_cube.fd/atmosphere_target_data.F90 new file mode 100644 index 000000000..0e4d9cd64 --- /dev/null +++ b/sorc/chgres_cube.fd/atmosphere_target_data.F90 @@ -0,0 +1,83 @@ +!> @file +!! @brief Define atmospheric target data variables. +!! @author George Gayno NCEP/EMC + +!> Module to hold variables and ESMF fields associated +!! with the target grid atmospheric data. +!! +!! @author George Gayno NCEP/EMC + module atmosphere_target_data + + use esmf + + implicit none + + private + + integer, public :: lev_target !< Number of vertical levels. + integer, public :: levp1_target !< Number of vertical levels plus 1. + integer, public :: nvcoord_target !< Number of vertical coordinate variables. + + real(esmf_kind_r8), allocatable, public :: vcoord_target(:,:) !< Vertical coordinate. + + type(esmf_field), public :: delp_target_grid !< Pressure thickness. + type(esmf_field), public :: dzdt_target_grid !< Vertical velocity. + type(esmf_field), public :: ps_target_grid !< Surface pressure. + type(esmf_field), public :: temp_target_grid !< Temperautre. + type(esmf_field), allocatable, public :: tracers_target_grid(:) !< Tracers. + type(esmf_field), public :: u_s_target_grid !< U-wind, 'south' edge of grid cell. + type(esmf_field), public :: v_s_target_grid !< V-wind, 'south' edge of grid cell. + type(esmf_field), public :: u_w_target_grid !< U-wind, 'west' edge of grid cell. + type(esmf_field), public :: v_w_target_grid !< V-wind, 'west' edge of grid cell. + type(esmf_field), public :: zh_target_grid !< 3-d height. + type(esmf_field), public :: qnifa_climo_target_grid !< Number concentration of ice + !! friendly aerosols. + type(esmf_field), public :: qnwfa_climo_target_grid !< Number concentration of water + !! friendly aerosols. + + public :: cleanup_atmosphere_target_data + + contains + +!> Free up memory for fields and variables in this module. +!! +!! @author George.Gayno NOAA/EMC + subroutine cleanup_atmosphere_target_data + + use program_setup, only : num_tracers + + implicit none + + integer :: i, rc + + print*,"- DESTROY TARGET GRID ATMOSPHERIC FIELDS." + + if (ESMF_FieldIsCreated(delp_target_grid)) call ESMF_FieldDestroy(delp_target_grid, rc=rc) + if (ESMF_FieldIsCreated(dzdt_target_grid)) call ESMF_FieldDestroy(dzdt_target_grid, rc=rc) + if (ESMF_FieldIsCreated(ps_target_grid)) call ESMF_FieldDestroy(ps_target_grid, rc=rc) + if (ESMF_FieldIsCreated(temp_target_grid)) call ESMF_FieldDestroy(temp_target_grid, rc=rc) + if (ESMF_FieldIsCreated(u_s_target_grid)) call ESMF_FieldDestroy(u_s_target_grid, rc=rc) + if (ESMF_FieldIsCreated(v_s_target_grid)) call ESMF_FieldDestroy(v_s_target_grid, rc=rc) + if (ESMF_FieldIsCreated(u_w_target_grid)) call ESMF_FieldDestroy(u_w_target_grid, rc=rc) + if (ESMF_FieldIsCreated(v_w_target_grid)) call ESMF_FieldDestroy(v_w_target_grid, rc=rc) + if (ESMF_FieldIsCreated(zh_target_grid)) call ESMF_FieldDestroy(zh_target_grid, rc=rc) + + do i = 1, num_tracers + if (ESMF_FieldIsCreated(tracers_target_grid(i))) call ESMF_FieldDestroy(tracers_target_grid(i), rc=rc) + enddo + + if (allocated (tracers_target_grid)) deallocate(tracers_target_grid) + + if (ESMF_FieldIsCreated(qnifa_climo_target_grid)) then + call ESMF_FieldDestroy(qnifa_climo_target_grid, rc=rc) + endif + + if (ESMF_FieldIsCreated(qnwfa_climo_target_grid)) then + call ESMF_FieldDestroy(qnwfa_climo_target_grid, rc=rc) + endif + + if (allocated (vcoord_target)) deallocate(vcoord_target) + + end subroutine cleanup_atmosphere_target_data + + end module atmosphere_target_data diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index c8cc2961a..7df645cfa 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -22,6 +22,28 @@ module surface use esmf + use surface_target_data, only : canopy_mc_target_grid, t2m_target_grid, & + q2m_target_grid, tprcp_target_grid, & + f10m_target_grid, seaice_fract_target_grid, & + ffmm_target_grid, ustar_target_grid, & + srflag_target_grid, soil_temp_target_grid, & + seaice_depth_target_grid, snow_liq_equiv_target_grid, & + seaice_skin_temp_target_grid, skin_temp_target_grid, & + snow_depth_target_grid, z0_target_grid, & + c_d_target_grid, c_0_target_grid, & + d_conv_target_grid, dt_cool_target_grid, & + ifd_target_grid, qrain_target_grid, & + tref_target_grid, w_d_target_grid, & + w_0_target_grid, xs_target_grid, & + xt_target_grid, xu_target_grid, & + xv_target_grid, xz_target_grid, & + xtts_target_grid, xzts_target_grid, & + z_c_target_grid, zm_target_grid, & + soilm_tot_target_grid, lai_target_grid, & + soilm_liq_target_grid + + use write_data, only : write_fv3_sfc_data_netcdf + implicit none private @@ -32,91 +54,6 @@ module surface !< The Noah LSM land ice physics !< are applied at these points. -! surface fields (not including nst) - type(esmf_field), public :: canopy_mc_target_grid - !< canopy moisture content - type(esmf_field), public :: f10m_target_grid - !< log((z0+10)*1/z0) - !< See sfc_diff.f for details - type(esmf_field), public :: ffmm_target_grid - !< log((z0+z1)*1/z0) - !< See sfc_diff.f for details - type(esmf_field), public :: q2m_target_grid - !< 2-m specific humidity - type(esmf_field), public :: seaice_depth_target_grid - !< sea ice depth - type(esmf_field), public :: seaice_fract_target_grid - !< sea ice fraction - type(esmf_field), public :: seaice_skin_temp_target_grid - !< sea ice skin temperature - type(esmf_field), public :: skin_temp_target_grid - !< skin temperature/sst - type(esmf_field), public :: srflag_target_grid - !< snow/rain flag - type(esmf_field), public :: snow_liq_equiv_target_grid - !< liquid equiv snow depth - type(esmf_field), public :: snow_depth_target_grid - !< physical snow depth - type(esmf_field), public :: soil_temp_target_grid - !< 3-d soil temperature - type(esmf_field), public :: soilm_liq_target_grid - !< 3-d liquid soil moisture - type(esmf_field), public :: soilm_tot_target_grid - !< 3-d total soil moisture - type(esmf_field), public :: t2m_target_grid - !< 2-m temperatrure - type(esmf_field), public :: tprcp_target_grid - !< precip - type(esmf_field), public :: ustar_target_grid - !< friction velocity - type(esmf_field), public :: z0_target_grid - !< roughness length - type(esmf_field), public :: lai_target_grid - !< leaf area index - -! nst fields - type(esmf_field), public :: c_d_target_grid - !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public :: c_0_target_grid - !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public :: d_conv_target_grid - !< Thickness of free convection layer - type(esmf_field), public :: dt_cool_target_grid - !< Sub-layer cooling amount - type(esmf_field), public :: ifd_target_grid - !< Model mode index. 0-diurnal model not - !< started; 1-diurnal model started. - type(esmf_field), public :: qrain_target_grid - !< Sensible heat flux due to rainfall - type(esmf_field), public :: tref_target_grid - !< reference temperature - type(esmf_field), public :: w_d_target_grid - !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public :: w_0_target_grid - !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public :: xs_target_grid - !< Salinity content in diurnal - !< thermocline layer - type(esmf_field), public :: xt_target_grid - !< Heat content in diurnal thermocline - !< layer - type(esmf_field), public :: xu_target_grid - !< u-current content in diurnal - !< thermocline layer - type(esmf_field), public :: xv_target_grid - !< v-current content in diurnal - !< thermocline layer - type(esmf_field), public :: xz_target_grid - !< Diurnal thermocline layer thickness - type(esmf_field), public :: xtts_target_grid - !< d(xt)/d(ts) - type(esmf_field), public :: xzts_target_grid - !< d(xz)/d(ts) - type(esmf_field), public :: z_c_target_grid - !< Sub-layer cooling thickness - type(esmf_field), public :: zm_target_grid - !< Oceanic mixed layer depth - type(esmf_field) :: soil_type_from_input_grid !< soil type interpolated from !< input grid @@ -154,9 +91,7 @@ module surface public :: create_nst_esmf_fields public :: interp public :: create_surface_esmf_fields - public :: cleanup_target_sfc_data public :: nst_land_fill - public :: cleanup_target_nst_data public :: regrid_many public :: search_many @@ -180,6 +115,8 @@ subroutine surface_driver(localpet) use static_data, only : get_static_fields, & cleanup_static_fields + use surface_target_data, only : cleanup_target_nst_data + implicit none integer, intent(in) :: localpet @@ -289,7 +226,7 @@ subroutine surface_driver(localpet) if (convert_nst) call cleanup_target_nst_data - call cleanup_target_sfc_data + call cleanup_all_target_sfc_data call cleanup_static_fields @@ -3464,70 +3401,22 @@ end subroutine search_many !! no longer needed. !! !! @author George Gayno NOAA/EMC - subroutine cleanup_target_sfc_data + subroutine cleanup_all_target_sfc_data + + use surface_target_data, only : cleanup_target_sfc_data implicit none integer :: rc - print*,"- DESTROY TARGET GRID SURFACE FIELDS." - - call ESMF_FieldDestroy(t2m_target_grid, rc=rc) - call ESMF_FieldDestroy(q2m_target_grid, rc=rc) - call ESMF_FieldDestroy(tprcp_target_grid, rc=rc) - call ESMF_FieldDestroy(f10m_target_grid, rc=rc) - call ESMF_FieldDestroy(ffmm_target_grid, rc=rc) - call ESMF_FieldDestroy(ustar_target_grid, rc=rc) - call ESMF_FieldDestroy(snow_liq_equiv_target_grid, rc=rc) - call ESMF_FieldDestroy(snow_depth_target_grid, rc=rc) - call ESMF_FieldDestroy(seaice_fract_target_grid, rc=rc) - call ESMF_FieldDestroy(seaice_depth_target_grid, rc=rc) - call ESMF_FieldDestroy(seaice_skin_temp_target_grid, rc=rc) - call ESMF_FieldDestroy(srflag_target_grid, rc=rc) - call ESMF_FieldDestroy(skin_temp_target_grid, rc=rc) - call ESMF_FieldDestroy(canopy_mc_target_grid, rc=rc) - call ESMF_FieldDestroy(lai_target_grid,rc=rc) - call ESMF_FieldDestroy(z0_target_grid, rc=rc) + print*,"- DESTROY LOCAL TARGET GRID SURFACE FIELDS." + call ESMF_FieldDestroy(terrain_from_input_grid, rc=rc) call ESMF_FieldDestroy(terrain_from_input_grid_land, rc=rc) call ESMF_FieldDestroy(soil_type_from_input_grid, rc=rc) - call ESMF_FieldDestroy(soil_temp_target_grid, rc=rc) - call ESMF_FieldDestroy(soilm_tot_target_grid, rc=rc) - call ESMF_FieldDestroy(soilm_liq_target_grid, rc=rc) - - end subroutine cleanup_target_sfc_data -!> Free up memory once the target grid nst fields are -!! no longer needed. -!! -!! @author George Gayno NOAA/EMC - subroutine cleanup_target_nst_data - - implicit none + call cleanup_target_sfc_data - integer :: rc - - print*,"- DESTROY TARGET GRID NST DATA." - - call ESMF_FieldDestroy(c_d_target_grid, rc=rc) - call ESMF_FieldDestroy(c_0_target_grid, rc=rc) - call ESMF_FieldDestroy(d_conv_target_grid, rc=rc) - call ESMF_FieldDestroy(dt_cool_target_grid, rc=rc) - call ESMF_FieldDestroy(ifd_target_grid, rc=rc) - call ESMF_FieldDestroy(qrain_target_grid, rc=rc) - call ESMF_FieldDestroy(tref_target_grid, rc=rc) - call ESMF_FieldDestroy(w_d_target_grid, rc=rc) - call ESMF_FieldDestroy(w_0_target_grid, rc=rc) - call ESMF_FieldDestroy(xs_target_grid, rc=rc) - call ESMF_FieldDestroy(xt_target_grid, rc=rc) - call ESMF_FieldDestroy(xu_target_grid, rc=rc) - call ESMF_FieldDestroy(xv_target_grid, rc=rc) - call ESMF_FieldDestroy(xz_target_grid, rc=rc) - call ESMF_FieldDestroy(xtts_target_grid, rc=rc) - call ESMF_FieldDestroy(xzts_target_grid, rc=rc) - call ESMF_FieldDestroy(z_c_target_grid, rc=rc) - call ESMF_FieldDestroy(zm_target_grid, rc=rc) - - end subroutine cleanup_target_nst_data + end subroutine cleanup_all_target_sfc_data end module surface diff --git a/sorc/chgres_cube.fd/surface_target_data.F90 b/sorc/chgres_cube.fd/surface_target_data.F90 new file mode 100644 index 000000000..c9011f8b1 --- /dev/null +++ b/sorc/chgres_cube.fd/surface_target_data.F90 @@ -0,0 +1,173 @@ +!> @file +!! @brief Define target grid surface data variables. +!! @author George Gayno NCEP/EMC + +!> Module to hold ESMF fields associated +!! with the target grid surface data. +!! +!! @author George Gayno NCEP/EMC + module surface_target_data + + use esmf + + implicit none + + private + +! surface fields (not including nst) + type(esmf_field), public :: canopy_mc_target_grid + !< Canopy moisture content. + type(esmf_field), public :: f10m_target_grid + !< log((z0+10)*1/z0) + !< See sfc_diff.f for details. + type(esmf_field), public :: ffmm_target_grid + !< log((z0+z1)*1/z0) + !< See sfc_diff.f for details. + type(esmf_field), public :: q2m_target_grid + !< 2-m specific humidity. + type(esmf_field), public :: seaice_depth_target_grid + !< Sea ice depth. + type(esmf_field), public :: seaice_fract_target_grid + !< Sea ice fraction. + type(esmf_field), public :: seaice_skin_temp_target_grid + !< Sea ice skin temperature. + type(esmf_field), public :: skin_temp_target_grid + !< Skin temperature/sst. + type(esmf_field), public :: srflag_target_grid + !< Snow/rain flag. + type(esmf_field), public :: snow_liq_equiv_target_grid + !< Liquid equivalent snow depth. + type(esmf_field), public :: snow_depth_target_grid + !< Physical snow depth. + type(esmf_field), public :: soil_temp_target_grid + !< 3-d soil temperature. + type(esmf_field), public :: soilm_liq_target_grid + !< 3-d liquid soil moisture. + type(esmf_field), public :: soilm_tot_target_grid + !< 3-d total soil moisture. + type(esmf_field), public :: t2m_target_grid + !< 2-m temperatrure. + type(esmf_field), public :: tprcp_target_grid + !< Precipitation. + type(esmf_field), public :: ustar_target_grid + !< Friction velocity. + type(esmf_field), public :: z0_target_grid + !< Roughness length. + type(esmf_field), public :: lai_target_grid + !< Leaf area index. + +! nst fields + type(esmf_field), public :: c_d_target_grid + !< Coefficient 2 to calculate d(tz)/d(ts). + type(esmf_field), public :: c_0_target_grid + !< Coefficient 1 to calculate d(tz)/d(ts). + type(esmf_field), public :: d_conv_target_grid + !< Thickness of free convection layer. + type(esmf_field), public :: dt_cool_target_grid + !< Sub-layer cooling amount. + type(esmf_field), public :: ifd_target_grid + !< Model mode index. 0-diurnal model not + !< started; 1-diurnal model started. + type(esmf_field), public :: qrain_target_grid + !< Sensible heat flux due to rainfall. + type(esmf_field), public :: tref_target_grid + !< Reference temperature. + type(esmf_field), public :: w_d_target_grid + !< Coefficient 4 to calculate d(tz)/d(ts). + type(esmf_field), public :: w_0_target_grid + !< Coefficient 3 to calculate d(tz)/d(ts). + type(esmf_field), public :: xs_target_grid + !< Salinity content in diurnal + !< thermocline layer. + type(esmf_field), public :: xt_target_grid + !< Heat content in diurnal thermocline + !< layer. + type(esmf_field), public :: xu_target_grid + !< u-current content in diurnal + !< thermocline layer. + type(esmf_field), public :: xv_target_grid + !< v-current content in diurnal + !< thermocline layer. + type(esmf_field), public :: xz_target_grid + !< Diurnal thermocline layer thickness. + type(esmf_field), public :: xtts_target_grid + !< d(xt)/d(ts). + type(esmf_field), public :: xzts_target_grid + !< d(xz)/d(ts). + type(esmf_field), public :: z_c_target_grid + !< Sub-layer cooling thickness. + type(esmf_field), public :: zm_target_grid + !< Oceanic mixed layer depth. + + public :: cleanup_target_nst_data + public :: cleanup_target_sfc_data + + contains + +!> Free up memory once the target grid surface fields are +!! no longer needed. +!! +!! @author George Gayno NOAA/EMC + subroutine cleanup_target_sfc_data + + implicit none + + integer :: rc + + print*,"- DESTROY TARGET GRID SURFACE FIELDS." + call ESMF_FieldDestroy(t2m_target_grid, rc=rc) + call ESMF_FieldDestroy(q2m_target_grid, rc=rc) + call ESMF_FieldDestroy(tprcp_target_grid, rc=rc) + call ESMF_FieldDestroy(f10m_target_grid, rc=rc) + call ESMF_FieldDestroy(ffmm_target_grid, rc=rc) + call ESMF_FieldDestroy(ustar_target_grid, rc=rc) + call ESMF_FieldDestroy(snow_liq_equiv_target_grid, rc=rc) + call ESMF_FieldDestroy(snow_depth_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_fract_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_depth_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_skin_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(srflag_target_grid, rc=rc) + call ESMF_FieldDestroy(skin_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(canopy_mc_target_grid, rc=rc) + call ESMF_FieldDestroy(lai_target_grid,rc=rc) + call ESMF_FieldDestroy(z0_target_grid, rc=rc) + call ESMF_FieldDestroy(soil_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(soilm_tot_target_grid, rc=rc) + call ESMF_FieldDestroy(soilm_liq_target_grid, rc=rc) + + end subroutine cleanup_target_sfc_data + +!> Free up memory once the target grid nst fields are +!! no longer needed. +!! +!! @author George Gayno NOAA/EMC + subroutine cleanup_target_nst_data + + implicit none + + integer :: rc + + print*,"- DESTROY TARGET GRID NST DATA." + + call ESMF_FieldDestroy(c_d_target_grid, rc=rc) + call ESMF_FieldDestroy(c_0_target_grid, rc=rc) + call ESMF_FieldDestroy(d_conv_target_grid, rc=rc) + call ESMF_FieldDestroy(dt_cool_target_grid, rc=rc) + call ESMF_FieldDestroy(ifd_target_grid, rc=rc) + call ESMF_FieldDestroy(qrain_target_grid, rc=rc) + call ESMF_FieldDestroy(tref_target_grid, rc=rc) + call ESMF_FieldDestroy(w_d_target_grid, rc=rc) + call ESMF_FieldDestroy(w_0_target_grid, rc=rc) + call ESMF_FieldDestroy(xs_target_grid, rc=rc) + call ESMF_FieldDestroy(xt_target_grid, rc=rc) + call ESMF_FieldDestroy(xu_target_grid, rc=rc) + call ESMF_FieldDestroy(xv_target_grid, rc=rc) + call ESMF_FieldDestroy(xz_target_grid, rc=rc) + call ESMF_FieldDestroy(xtts_target_grid, rc=rc) + call ESMF_FieldDestroy(xzts_target_grid, rc=rc) + call ESMF_FieldDestroy(z_c_target_grid, rc=rc) + call ESMF_FieldDestroy(zm_target_grid, rc=rc) + + end subroutine cleanup_target_nst_data + + end module surface_target_data diff --git a/sorc/chgres_cube.fd/write_data.F90 b/sorc/chgres_cube.fd/write_data.F90 index 2788654a1..498f6c798 100644 --- a/sorc/chgres_cube.fd/write_data.F90 +++ b/sorc/chgres_cube.fd/write_data.F90 @@ -1,3 +1,14 @@ + module write_data + + private + + public :: write_fv3_atm_header_netcdf + public :: write_fv3_atm_bndy_data_netcdf + public :: write_fv3_atm_data_netcdf + public :: write_fv3_sfc_data_netcdf + + contains + !> @file !! @brief Writes the tiled and header files expected by the forecast !! model. @@ -18,9 +29,9 @@ subroutine write_fv3_atm_header_netcdf(localpet) use netcdf - use atmosphere, only : nvcoord_target, & - vcoord_target, & - levp1_target + use atmosphere_target_data, only : nvcoord_target, & + vcoord_target, & + levp1_target use program_setup, only : num_tracers, use_thomp_mp_climo @@ -105,18 +116,12 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) use esmf use netcdf - use atmosphere, only : lev_target, levp1_target, & - dzdt_target_grid, & - ps_target_grid, & - tracers_target_grid, & - u_s_target_grid, & - v_s_target_grid, & - u_w_target_grid, & - v_w_target_grid, & - temp_target_grid, & - zh_target_grid, & - qnifa_climo_target_grid, & - qnwfa_climo_target_grid + use atmosphere_target_data, only : lev_target, levp1_target, & + ps_target_grid, zh_target_grid, & + tracers_target_grid, dzdt_target_grid, & + temp_target_grid, qnifa_climo_target_grid, & + qnwfa_climo_target_grid, u_s_target_grid, & + v_s_target_grid, u_w_target_grid, v_w_target_grid use model_grid, only : i_target, ip1_target, j_target, jp1_target @@ -1201,20 +1206,13 @@ subroutine write_fv3_atm_data_netcdf(localpet) use_thomp_mp_climo, & regional - use atmosphere, only : lev_target, & - levp1_target, & - ps_target_grid, & - zh_target_grid, & - dzdt_target_grid, & - qnifa_climo_target_grid, & - qnwfa_climo_target_grid, & - tracers_target_grid, & - temp_target_grid, & - delp_target_grid, & - u_s_target_grid, & - v_s_target_grid, & - u_w_target_grid, & - v_w_target_grid + use atmosphere_target_data, only : lev_target, levp1_target, & + ps_target_grid, zh_target_grid, & + dzdt_target_grid, delp_target_grid, & + temp_target_grid, tracers_target_grid, & + qnifa_climo_target_grid, qnwfa_climo_target_grid, & + u_s_target_grid, v_s_target_grid, & + u_w_target_grid, v_w_target_grid use model_grid, only : num_tiles_target_grid, & i_target, j_target, & @@ -1819,7 +1817,7 @@ subroutine write_fv3_sfc_data_netcdf(localpet) use program_setup, only : convert_nst, halo=>halo_bndy, & regional, lai_from_climo - use surface, only : canopy_mc_target_grid, & + use surface_target_data, only : canopy_mc_target_grid, & f10m_target_grid, & ffmm_target_grid, & q2m_target_grid, & @@ -3157,3 +3155,5 @@ subroutine write_fv3_sfc_data_netcdf(localpet) return end subroutine write_fv3_sfc_data_netcdf + + end module write_data diff --git a/tests/chgres_cube/ftst_read_vcoord.F90 b/tests/chgres_cube/ftst_read_vcoord.F90 index cfff79454..9dc535f80 100644 --- a/tests/chgres_cube/ftst_read_vcoord.F90 +++ b/tests/chgres_cube/ftst_read_vcoord.F90 @@ -18,11 +18,12 @@ program vcoord ! ! @author George Gayno - use atmosphere, only : read_vcoord_info, & - vcoord_target, & - nvcoord_target, & - lev_target, & - levp1_target + use atmosphere_target_data, only : vcoord_target, & + nvcoord_target, & + lev_target, & + levp1_target + + use atmosphere, only : read_vcoord_info use program_setup, only : vcoord_file_target_grid diff --git a/tests/chgres_cube/ftst_surface_nst_landfill.F90 b/tests/chgres_cube/ftst_surface_nst_landfill.F90 index 4bf7e3ef9..00d801478 100644 --- a/tests/chgres_cube/ftst_surface_nst_landfill.F90 +++ b/tests/chgres_cube/ftst_surface_nst_landfill.F90 @@ -11,10 +11,10 @@ program surface_nst_landfill target_grid, num_tiles_target_grid, & landmask_target_grid - use surface, only : skin_temp_target_grid, & - nst_land_fill, & - create_nst_esmf_fields, & - cleanup_target_nst_data, & + use surface, only : nst_land_fill, & + create_nst_esmf_fields + + use surface_target_data, only : skin_temp_target_grid, & c_d_target_grid, & c_0_target_grid, & d_conv_target_grid, & @@ -32,9 +32,9 @@ program surface_nst_landfill xtts_target_grid, & xzts_target_grid, & z_c_target_grid, & - zm_target_grid - - + zm_target_grid, & + cleanup_target_nst_data + implicit none integer, parameter :: IPTS_TARGET=4 diff --git a/tests/chgres_cube/ftst_surface_regrid_many.F90 b/tests/chgres_cube/ftst_surface_regrid_many.F90 index 9fac01bef..34619d7b6 100644 --- a/tests/chgres_cube/ftst_surface_regrid_many.F90 +++ b/tests/chgres_cube/ftst_surface_regrid_many.F90 @@ -20,10 +20,10 @@ program surface_interp use input_data, only: t2m_input_grid, & q2m_input_grid - use surface, only : regrid_many, & - t2m_target_grid, & - q2m_target_grid + use surface, only : regrid_many + use surface_target_data, only : t2m_target_grid, & + q2m_target_grid implicit none From adc71973389654b4c34aa3666f89d0d6446fdae5 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Wed, 20 Apr 2022 17:34:24 -0400 Subject: [PATCH 028/109] chgres_cube - Complete removal of wgrib2 library (#641) * Begin update of model_grid.F90 to use g2 library. Fixes #591 * Start new routine to set the esmf grid object for grib2 data. Fixes #591. * Begin updates to add non-latlon grids. Fixes #591 * Call gdswzd twice. Once for the grid point centers and once for the corner points. Fixes #591. * Output lat/lons to a netcdf file. * Adjust longitude convention of rotated lat/lon grids in output netcdf file. * Remove unused routines from model_grid.F90 Part of #591. * Some cleanup to model_grid.F90 * Remove unused variable used to store the path and name of the RAP grid coordinate file. Part of #591. * Remove all dependencies on wgrib2 from the build. Fixes #591. * Remove wgrib2 from workflow 'yml' files. Fixes #591. * Fix pole flip bug in gdt_to_gds for GFS GRIB2 data. Fixes #591. * Add diagnostic print of lat/lon corner/center differences. Fixes #591. * Remove some unused variables and the write of the diagnostic file containing grid point lat/lons. Fixes #591. --- .../workflows/debug-docs-test_coverage.yml | 3 - .github/workflows/intel.yml | 3 - .github/workflows/linux-mac-nceplibs-mpi.yml | 3 - .github/workflows/netcdf-versions.yml | 3 - CMakeLists.txt | 1 - README.md | 1 - cmake/Findwgrib2.cmake | 41 - modulefiles/build.cheyenne.intel | 1 - modulefiles/build.hera.gnu.lua | 3 - modulefiles/build.hera.intel.lua | 3 - modulefiles/build.jet.intel.lua | 3 - modulefiles/build.odin.intel | 3 - modulefiles/build.orion.intel.lua | 3 - modulefiles/build.s4.intel | 1 - modulefiles/build.stampede.intel | 1 - modulefiles/build.wcoss_cray.intel | 1 - modulefiles/build.wcoss_dell_p3.intel.lua | 3 - sorc/chgres_cube.fd/CMakeLists.txt | 2 +- sorc/chgres_cube.fd/input_data.F90 | 3 +- sorc/chgres_cube.fd/model_grid.F90 | 727 +++++++----------- sorc/chgres_cube.fd/program_setup.F90 | 5 - sorc/chgres_cube.fd/static_data.F90 | 3 +- sorc/chgres_cube.fd/surface.F90 | 2 +- ush/chgres_cube.sh | 4 +- 24 files changed, 285 insertions(+), 538 deletions(-) delete mode 100644 cmake/Findwgrib2.cmake diff --git a/.github/workflows/debug-docs-test_coverage.yml b/.github/workflows/debug-docs-test_coverage.yml index 96face7b7..6d953cd95 100644 --- a/.github/workflows/debug-docs-test_coverage.yml +++ b/.github/workflows/debug-docs-test_coverage.yml @@ -97,10 +97,7 @@ jobs: export CC=mpicc export CXX=mpicxx export FC=mpifort - # Findwgrib2 in module form does not search -version - # as NCEPLIBS installs it export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" - export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_PREFIX_PATH='~/jasper;~/nceplibs' -DCMAKE_BUILD_TYPE=Debug -DENABLE_DOCS=On -DCMAKE_Fortran_FLAGS="-g -fprofile-arcs -ftest-coverage -O0" make -j2 diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index e1743a8a1..240003849 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -160,10 +160,7 @@ jobs: export ESMFMKFILE=~/esmf/lib/esmf.mk cd ufs_utils mkdir build && cd build - # Findwgrib2 in module form does not search -version - # as NCEPLIBS installs it export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" - export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_BUILD_TYPE=Debug -DCMAKE_PREFIX_PATH='~;~/jasper;~/nceplibs;~/netcdf' make -j2 diff --git a/.github/workflows/linux-mac-nceplibs-mpi.yml b/.github/workflows/linux-mac-nceplibs-mpi.yml index 9250598fa..68d9da6ae 100644 --- a/.github/workflows/linux-mac-nceplibs-mpi.yml +++ b/.github/workflows/linux-mac-nceplibs-mpi.yml @@ -214,11 +214,8 @@ jobs: export CC=mpicc export CXX=mpicxx export FC=mpifort - # Findwgrib2 in module form does not search -version - # as NCEPLIBS installs it export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" export DYLD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" - export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_PREFIX_PATH='~/jasper;~/nceplibs;~/netcdf' make -j2 diff --git a/.github/workflows/netcdf-versions.yml b/.github/workflows/netcdf-versions.yml index 2040e6b72..98ecd746a 100644 --- a/.github/workflows/netcdf-versions.yml +++ b/.github/workflows/netcdf-versions.yml @@ -148,10 +148,7 @@ jobs: export CC=mpicc export CXX=mpicxx export FC=mpifort - # Findwgrib2 in module form does not search -version - # as NCEPLIBS installs it export LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:~/jasper/lib;~/jasper/lib64" - export wgrib2_ROOT=`find ~/nceplibs -type d -maxdepth 1 -iname "wgrib2*"` cmake .. -DCMAKE_PREFIX_PATH='~/jasper;~/nceplibs;~/netcdf' -DCMAKE_BUILD_TYPE=Debug make -j2 diff --git a/CMakeLists.txt b/CMakeLists.txt index 38bcfb5ed..68869d5c2 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -70,7 +70,6 @@ find_package(sigio 2.3.0 REQUIRED) find_package(sp 2.3.3 REQUIRED) find_package(ip 3.3.3 REQUIRED) find_package(g2 3.4.3 REQUIRED) -find_package(wgrib2 2.0.8 REQUIRED) find_package(sigio 2.3.0 REQUIRED) # EMC requires executables in ./exec diff --git a/README.md b/README.md index 3a192662c..1241c9b6d 100644 --- a/README.md +++ b/README.md @@ -40,7 +40,6 @@ This package uses the [hpc-stack](https://github.com/NOAA-EMC/hpc-stack) for the - [NCEPLIBS-sp](https://github.com/NOAA-EMC/NCEPLIBS-sp) - [NCEPLIBS-ip](https://github.com/NOAA-EMC/NCEPLIBS-ip) - [NCEPLIBS-g2](https://github.com/NOAA-EMC/NCEPLIBS-g2) - - [NCEPLIBS-wgrib2](https://github.com/NOAA-EMC/NCEPLIBS-wgrib2) And for the following third party libraries: diff --git a/cmake/Findwgrib2.cmake b/cmake/Findwgrib2.cmake deleted file mode 100644 index 68b8833c4..000000000 --- a/cmake/Findwgrib2.cmake +++ /dev/null @@ -1,41 +0,0 @@ -# This module produces the target wgrib2::wgrib2 - -find_path(WGRIB2_INCLUDES wgrib2api.mod) -find_library(WGRIB2_LIB libwgrib2.a) -find_library(WGRIB2_API_LIB libwgrib2_api.a) - -add_library(wgrib2::wgrib2 UNKNOWN IMPORTED) - -# Library builds are different between CMake build and the make build. -# libwgrib2_api.a is only necessary in the CMake build and must come first when linking -if(WGRIB2_API_LIB) - # CMake build. Need both. - set(first_lib ${WGRIB2_API_LIB}) - set(second_lib ${WGRIB2_LIB}) -else() - # Makefile build. Only need libwgrib2.a - set(first_lib ${WGRIB2_LIB}) - set(second_lib "") -endif() - -set_target_properties(wgrib2::wgrib2 PROPERTIES - IMPORTED_LOCATION "${first_lib}" - INTERFACE_INCLUDE_DIRECTORIES "${WGRIB2_INCLUDES}" - INTERFACE_LINK_LIBRARIES "${second_lib}") - -set(WGRIB2_LIBRARIES "${first_lib}" "${second_lib}") - -find_program(WGRIB2_EXE wgrib2) -execute_process(COMMAND ${WGRIB2_EXE} --version OUTPUT_VARIABLE version_str) - -# Wgrib2 changed how it output --version from "v0.x.y.z" to "vx.y.z" starting in wgrib2 3.0 -if(version_str MATCHES "^v0.*") - string(SUBSTRING "${version_str}" 3 5 version) -else() - string(SUBSTRING "${version_str}" 1 5 version) -endif() - -find_package_handle_standard_args(wgrib2 - REQUIRED_VARS WGRIB2_LIBRARIES WGRIB2_INCLUDES WGRIB2_EXE - VERSION_VAR version - ) diff --git a/modulefiles/build.cheyenne.intel b/modulefiles/build.cheyenne.intel index 570a424f4..c1971328f 100644 --- a/modulefiles/build.cheyenne.intel +++ b/modulefiles/build.cheyenne.intel @@ -20,7 +20,6 @@ module load w3nco/2.4.1 module load sigio/2.3.2 module load sfcio/1.4.1 -module load wgrib2/2.0.8 module load netcdf/4.7.4 setenv ESMFMKFILE /glade/p/ral/jntp/GMTB/tools/NCEPLIBS-ufs-v2.0.0/intel-19.1.1/mpt-2.19/lib64/esmf.mk diff --git a/modulefiles/build.hera.gnu.lua b/modulefiles/build.hera.gnu.lua index 90bca87ae..6b57b13c3 100644 --- a/modulefiles/build.hera.gnu.lua +++ b/modulefiles/build.hera.gnu.lua @@ -49,9 +49,6 @@ load(pathJoin("sfcio", sfcio_ver)) sigio_ver=os.getenv("sigio_ver") or "2.3.2" load(pathJoin("sigio", sigio_ver)) -wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" -load(pathJoin("wgrib2", wgrib2_ver)) - nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" load(pathJoin("nccmp", nccmp_ver)) diff --git a/modulefiles/build.hera.intel.lua b/modulefiles/build.hera.intel.lua index 48335e748..036b47fc6 100644 --- a/modulefiles/build.hera.intel.lua +++ b/modulefiles/build.hera.intel.lua @@ -43,9 +43,6 @@ load(pathJoin("sfcio", sfcio_ver)) sigio_ver=os.getenv("sigio_ver") or "2.3.2" load(pathJoin("sigio", sigio_ver)) -wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" -load(pathJoin("wgrib2", wgrib2_ver)) - zlib_ver=os.getenv("zlib_ver") or "1.2.11" load(pathJoin("zlib", zlib_ver)) diff --git a/modulefiles/build.jet.intel.lua b/modulefiles/build.jet.intel.lua index 50f23bb96..2a18d626d 100644 --- a/modulefiles/build.jet.intel.lua +++ b/modulefiles/build.jet.intel.lua @@ -55,9 +55,6 @@ load(pathJoin("nemsio", nemsio_ver)) g2_ver=os.getenv("g2_ver") or "3.4.3" load(pathJoin("g2", g2_ver)) -wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" -load(pathJoin("wgrib2", wgrib2_ver)) - prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("prod_util", prod_util_ver)) diff --git a/modulefiles/build.odin.intel b/modulefiles/build.odin.intel index 362aa3a84..7904f665c 100644 --- a/modulefiles/build.odin.intel +++ b/modulefiles/build.odin.intel @@ -25,7 +25,6 @@ module load sigio module load sfcio module load nemsio module load g2 -module load wgrib2 #module load esmf/8.0.0 #setenv ESMFMKFILE /oldscratch/ywang/external/NCEPLIBS_SRW/lib64/esmf.mk @@ -33,5 +32,3 @@ setenv ESMFMKFILE /oldscratch/ywang/external/NCEPLIBS_SRWv2.0/lib64/esmf.mk setenv CMAKE_Fortran_COMPILER ftn setenv CMAKE_C_COMPILER cc - -#setenv WGRIB2_ROOT /oldscratch/ywang/external/NCEPLIBS_SRWv2.0/wgrib2-2.0.8 diff --git a/modulefiles/build.orion.intel.lua b/modulefiles/build.orion.intel.lua index d641cdaf5..fb1ec0569 100644 --- a/modulefiles/build.orion.intel.lua +++ b/modulefiles/build.orion.intel.lua @@ -40,9 +40,6 @@ load(pathJoin("sfcio", sfcio_ver)) sigio_ver=os.getenv("sigio_ver") or "2.3.2" load(pathJoin("sigio", sigio_ver)) -wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" -load(pathJoin("wgrib2", wgrib2_ver)) - zlib_ver=os.getenv("zlib_ver") or "1.2.11" load(pathJoin("zlib", zlib_ver)) diff --git a/modulefiles/build.s4.intel b/modulefiles/build.s4.intel index 8a9a0b0eb..37cdf2a0c 100644 --- a/modulefiles/build.s4.intel +++ b/modulefiles/build.s4.intel @@ -16,7 +16,6 @@ module load sp/2.3.3 module load w3nco/2.4.1 module load sfcio/1.4.1 module load sigio/2.3.2 -module load wgrib2/2.0.8 module load jasper/2.0.22 module load zlib/1.2.11 diff --git a/modulefiles/build.stampede.intel b/modulefiles/build.stampede.intel index 5d5829507..e91e253ca 100644 --- a/modulefiles/build.stampede.intel +++ b/modulefiles/build.stampede.intel @@ -32,7 +32,6 @@ module load sigio module load sfcio module load nemsio module load g2 -module load wgrib2 #setenv ESMFMKFILE /work/00315/tg455890/stampede2/regional_fv3/NCEPLIBS_SRWv2.0/lib64/esmf.mk diff --git a/modulefiles/build.wcoss_cray.intel b/modulefiles/build.wcoss_cray.intel index 7ae0c107f..d2c7c438e 100644 --- a/modulefiles/build.wcoss_cray.intel +++ b/modulefiles/build.wcoss_cray.intel @@ -24,7 +24,6 @@ module load sp/2.3.3 module load w3nco/2.4.1 module load sfcio/1.4.1 module load sigio/2.3.2 -module load wgrib2/2.0.8 setenv ZLIB_ROOT /usrx/local/prod/zlib/1.2.7/intel/haswell setenv PNG_ROOT /usrx/local/prod/png/1.2.49/intel/haswell diff --git a/modulefiles/build.wcoss_dell_p3.intel.lua b/modulefiles/build.wcoss_dell_p3.intel.lua index 0c0f3955e..9d7408bc8 100644 --- a/modulefiles/build.wcoss_dell_p3.intel.lua +++ b/modulefiles/build.wcoss_dell_p3.intel.lua @@ -64,9 +64,6 @@ load(pathJoin("sfcio", sfcio_ver)) sigio_ver=os.getenv("sigio_ver") or "2.3.2" load(pathJoin("sigio", sigio_ver)) -wgrib2_ver=os.getenv("wgrib2_ver") or "2.0.8" -load(pathJoin("wgrib2", wgrib2_ver)) - prepend_path("MODULEPATH", "/usrx/local/dev/modulefiles") prod_util_ver=os.getenv("prod_util_ver") or "1.1.3" diff --git a/sorc/chgres_cube.fd/CMakeLists.txt b/sorc/chgres_cube.fd/CMakeLists.txt index 7ed7d156d..0fc64ff32 100644 --- a/sorc/chgres_cube.fd/CMakeLists.txt +++ b/sorc/chgres_cube.fd/CMakeLists.txt @@ -49,10 +49,10 @@ target_link_libraries( sfcio::sfcio sigio::sigio bacio::bacio_4 + ip::ip_d sp::sp_d w3nco::w3nco_d esmf - wgrib2::wgrib2 MPI::MPI_Fortran NetCDF::NetCDF_Fortran) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 420b92955..ed7f60cd0 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -41,8 +41,7 @@ module input_data ip1_input, jp1_input, & num_tiles_input_grid, & latitude_input_grid, & - longitude_input_grid, & - inv_file + longitude_input_grid implicit none diff --git a/sorc/chgres_cube.fd/model_grid.F90 b/sorc/chgres_cube.fd/model_grid.F90 index 0cf0257a2..cdd91336b 100644 --- a/sorc/chgres_cube.fd/model_grid.F90 +++ b/sorc/chgres_cube.fd/model_grid.F90 @@ -17,8 +17,6 @@ module model_grid character(len=5), allocatable, public :: tiles_target_grid(:) !< Tile names of target grid. - character(len=10), public :: inv_file = "chgres.inv" - !< wgrib2 inventory file character(len=50), public :: input_grid_type = "latlon" !< map projection of input grid @@ -116,7 +114,7 @@ module model_grid !! @author George Gayno NCEP/EMC subroutine define_input_grid(localpet, npets) - use program_setup, only : input_type, external_model + use program_setup, only : input_type implicit none @@ -127,8 +125,6 @@ subroutine define_input_grid(localpet, npets) trim(input_type) == "gfs_sigio" .or. & trim(input_type) == "gaussian_netcdf") then call define_input_grid_gaussian(localpet, npets) - elseif (trim(external_model) == "GFS" .and. trim(input_type) == "grib2") then - call define_input_grid_gfs_grib2(localpet,npets) elseif (trim(input_type) == "grib2") then call define_input_grid_grib2(localpet,npets) else @@ -609,64 +605,144 @@ subroutine define_input_grid_mosaic(localpet, npets) end subroutine define_input_grid_mosaic -!> Define input grid object for GFS grib2 data. Only works for data on -!! global lat/lon or gaussian grids. +!> Define input grid object for grib2 input data. !! !! @param [in] localpet ESMF local persistent execution thread !! @param [in] npets Number of persistent execution threads -!! @author George Gayno NCEP/EMC - subroutine define_input_grid_gfs_grib2(localpet, npets) +!! @author Larissa Reames +!! @author Jeff Beck +!! @author George Gayno + subroutine define_input_grid_grib2(localpet,npets) - use wgrib2api - use mpi - use program_setup, only : data_dir_input_grid, & - grib2_file_input_grid + use grib_mod + use gdswzd_mod + use program_setup, only : grib2_file_input_grid, data_dir_input_grid implicit none integer, intent(in) :: localpet, npets - character(len=250) :: the_file + character(len=500) :: the_file + + integer :: i, j, k, jdisc, jgdtn, jpdtn, lugb, lugi + integer :: jids(200), jgdt(200), jpdt(200), rc + integer :: kgds(200), nret, clb(2), cub(2) - integer :: i, j, rc, clb(2), cub(2) - integer :: ierr + logical :: unpack + real :: res + real, allocatable :: rlon(:,:),rlat(:,:),xpts(:,:),ypts(:,:) + real, allocatable :: rlon_corner(:,:),rlat_corner(:,:) + real, allocatable :: rlon_diff(:,:),rlat_diff(:,:) + real, allocatable :: xpts_corner(:,:),ypts_corner(:,:) real(esmf_kind_r8), allocatable :: latitude(:,:) real(esmf_kind_r8), allocatable :: longitude(:,:) - real(esmf_kind_r4), allocatable :: lat4(:,:), lon4(:,:) + real(esmf_kind_r8), allocatable :: latitude_corner(:,:) + real(esmf_kind_r8), allocatable :: longitude_corner(:,:) real(esmf_kind_r8), pointer :: lat_src_ptr(:,:) - real(esmf_kind_r8), pointer :: lon_src_ptr(:,:) real(esmf_kind_r8), pointer :: lat_corner_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lon_src_ptr(:,:) real(esmf_kind_r8), pointer :: lon_corner_src_ptr(:,:) - real(esmf_kind_r8) :: deltalon type(esmf_polekind_flag) :: polekindflag(2) - print*,"- DEFINE INPUT GRID OBJECT FOR INPUT GRIB2 DATA." - - num_tiles_input_grid = 1 + type(gribfield) :: gfld the_file = trim(data_dir_input_grid) // "/" // grib2_file_input_grid - if (localpet == 0) then - print*,'- OPEN AND INVENTORY GRIB2 FILE: ',trim(the_file) - rc=grb2_mk_inv(the_file,inv_file) - if (rc /=0) call error_handler("OPENING GRIB2 FILE",rc) - endif -! Wait for localpet 0 to create inventory - call mpi_barrier(mpi_comm_world, ierr) + lugb=12 - rc = grb2_inq(the_file,inv_file,':PRES:',':surface:',nx=i_input, ny=j_input, & - lat=lat4, lon=lon4) - if (rc /= 1) call error_handler("READING GRIB2 FILE", rc) + print*,"- OPEN AND READ INPUT DATA GRIB2 FILE: ", trim(the_file) + call baopenr(lugb,the_file,rc) + if (rc /= 0) call error_handler("OPENING FILE", rc) + +! Read the first record and get the grid definition template. + + j = 0 ! Search at beginning of file + lugi = 0 ! No grib index file + jdisc = -1 ! Search for any discipline + jpdtn = -1 ! Search for any product definition template number + jgdtn = -1 ! Search for any grid definition template number + jids = -9999 ! Array of values in identification section, set to wildcard. + jgdt = -9999 ! Array of values in grid definition template, set to wildcard. + jpdt = -9999 ! Array of values in product definition template, set to wildcard. + unpack = .false. ! unpack data + + call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, rc) + if (rc /= 0) call error_handler("DEGRIBBING INPUT FILE.", rc) + + call baclose(lugb,rc) + + if (gfld%igdtnum == 0) then + print*,"- INPUT DATA ON LAT/LON GRID." + input_grid_type = 'latlon' + elseif (gfld%igdtnum == 30) then + print*,"- INPUT DATA ON LAMBERT CONFORMAL GRID." + input_grid_type = 'lambert' + elseif (gfld%igdtnum == 32769) then + print*,"- INPUT DATA ON ROTATED LAT/LON GRID." + input_grid_type = 'rotated_latlon' + else + call error_handler("INPUT GRID TEMPLATE NOT SUPPORTED.", 2) + endif + + kgds = 0 + call gdt_to_gds(gfld%igdtnum, gfld%igdtmpl, gfld%igdtlen, kgds, i_input, j_input, res) ip1_input = i_input + 1 jp1_input = j_input + 1 - polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + allocate(rlat(i_input,j_input)) + allocate(rlon(i_input,j_input)) + allocate(rlat_diff(i_input,j_input)) + allocate(rlon_diff(i_input,j_input)) + allocate(xpts(i_input,j_input)) + allocate(ypts(i_input,j_input)) + allocate(rlat_corner(ip1_input,jp1_input)) + allocate(rlon_corner(ip1_input,jp1_input)) + allocate(xpts_corner(ip1_input,jp1_input)) + allocate(ypts_corner(ip1_input,jp1_input)) + + do j = 1, j_input + do i = 1, i_input + xpts(i,j) = float(i) + ypts(i,j) = float(j) + enddo + enddo - print*,"- CALL GridCreate1PeriDim FOR INPUT GRID." - input_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + print*,"- COMPUTE GRID CELL CENTER COORDINATES." + call gdswzd(kgds,1,(i_input*j_input),-9999.,xpts,ypts,rlon,rlat,nret) + + if (nret /= (i_input*j_input)) then + call error_handler("GDSWZD RETURNED WRONG NUMBER OF POINTS.", 2) + endif + + deallocate(xpts, ypts) + + do j = 1, jp1_input + do i = 1, ip1_input + xpts_corner(i,j) = float(i) - 0.5 + ypts_corner(i,j) = float(j) - 0.5 + enddo + enddo + + print*,"- COMPUTE GRID CELL CORNER COORDINATES." + call gdswzd(kgds,1,(ip1_input*jp1_input),-9999.,xpts_corner,ypts_corner,rlon_corner,rlat_corner,nret) + + if (nret /= (ip1_input*jp1_input)) then + call error_handler("GDSWZD RETURNED WRONG NUMBER OF POINTS.", 2) + endif + + deallocate(xpts_corner, ypts_corner) + + if (gfld%igdtnum == 0) then ! gfs lat/lon data + + print*,"- CALL GridCreate1PeriDim FOR INPUT GRID." + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + + input_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & maxIndex=(/i_input,j_input/), & polekindflag=polekindflag, & periodicDim=1, & @@ -674,6 +750,17 @@ subroutine define_input_grid_gfs_grib2(localpet, npets) coordSys=ESMF_COORDSYS_SPH_DEG, & regDecomp=(/1,npets/), & indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + else + + print*,"- CALL GridCreateNoPeriDim FOR INPUT GRID." + + input_grid = ESMF_GridCreateNoPeriDim(maxIndex=(/i_input,j_input/), & + indexflag=ESMF_INDEX_GLOBAL, & + rc=rc) + + endif + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN GridCreate1PeriDim", rc) @@ -692,26 +779,15 @@ subroutine define_input_grid_gfs_grib2(localpet, npets) name="input_grid_longitude", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) - - allocate(longitude(i_input,j_input)) - allocate(latitude(i_input,j_input)) - - do i = 1, i_input - longitude(i,:) = real(lon4(i,:),kind=esmf_kind_r8) - enddo -! Flip the poles, to be consistent with how the g2lib degribs -! gfs data. + allocate(latitude(i_input,j_input)) + allocate(longitude(i_input,j_input)) - do i = 1, j_input - latitude(:,i) = real(lat4(:,j_input-i+1),kind=esmf_kind_r8) -! if (localpet == 0) print*,'gfs lat ',i,latitude(1,i) - enddo + latitude = rlat + longitude = rlon - deallocate(lat4, lon4) + deallocate (rlat, rlon) - deltalon = abs(longitude(2,1)-longitude(1,1)) - print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE." call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -756,6 +832,16 @@ subroutine define_input_grid_gfs_grib2(localpet, npets) enddo enddo + deallocate(latitude, longitude) + + allocate(latitude_corner(ip1_input,jp1_input)) + allocate(longitude_corner(ip1_input,jp1_input)) + + latitude_corner = rlat_corner + longitude_corner = rlon_corner + + deallocate (rlat_corner, rlon_corner) + print*,"- CALL GridAddCoord FOR INPUT GRID." call ESMF_GridAddCoord(input_grid, & staggerloc=ESMF_STAGGERLOC_CORNER, rc=rc) @@ -784,323 +870,16 @@ subroutine define_input_grid_gfs_grib2(localpet, npets) do j = clb(2), cub(2) do i = clb(1), cub(1) - lon_corner_src_ptr(i,j) = longitude(i,1) - (0.5_esmf_kind_r8*deltalon) + lon_corner_src_ptr(i,j) = longitude_corner(i,j) if (lon_corner_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_corner_src_ptr(i,j) = lon_corner_src_ptr(i,j) - 360.0_esmf_kind_r8 - if (j == 1) then - lat_corner_src_ptr(i,j) = +90.0_esmf_kind_r8 - cycle - endif - if (j == jp1_input) then - lat_corner_src_ptr(i,j) = -90.0_esmf_kind_r8 - cycle - endif - lat_corner_src_ptr(i,j) = 0.5_esmf_kind_r8 * (latitude(i,j-1)+ latitude(i,j)) + lat_corner_src_ptr(i,j) = latitude_corner(i,j) enddo enddo - deallocate(latitude,longitude) - - end subroutine define_input_grid_gfs_grib2 - -!> Define input grid object for non-GFS grib2 data. -!! -!! @param [in] localpet ESMF local persistent execution thread -!! @param [in] npets Number of persistent execution threads -!! @author Larissa Reames -!! @author Jeff Beck - subroutine define_input_grid_grib2(localpet, npets) - - use mpi - use netcdf - use wgrib2api - use program_setup, only : grib2_file_input_grid, data_dir_input_grid, & - fix_dir_input_grid - implicit none - - character(len=500) :: the_file, temp_file - - integer, intent(in) :: localpet, npets - - integer :: error, extra, i, j, clb(2), cub(2) - - real(esmf_kind_r4), allocatable :: latitude_one_tile(:,:), lat_corners(:,:) - real(esmf_kind_r4), allocatable :: longitude_one_tile(:,:), lon_corners(:,:) - real(esmf_kind_r8) :: lat_target(i_target,j_target), & - lon_target(i_target,j_target) - real(esmf_kind_r8) :: deltalon, dx - integer :: ncid,id_var, id_dim - real(esmf_kind_r8), pointer :: lat_src_ptr(:,:), lon_src_ptr(:,:) - character(len=10000) :: temp_msg - character(len=10) :: temp_num = 'NA' - - num_tiles_input_grid = 1 - - !inv_file = "chgres.inv" - the_file = trim(data_dir_input_grid) // "/" // grib2_file_input_grid - temp_file = trim(fix_dir_input_grid)//"/latlon_grid3.32769.nc" - - call ESMF_FieldGather(latitude_target_grid, lat_target, rootPet=0, tile=1, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", error) - call ESMF_FieldGather(longitude_target_grid, lon_target, rootPet=0, tile=1, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", error) - - if (localpet==0) then - print*,'- OPEN AND INVENTORY GRIB2 FILE: ',trim(the_file) - error=grb2_mk_inv(the_file,inv_file) - if (error /=0) call error_handler("OPENING GRIB2 FILE",error) - error = grb2_inq(the_file, inv_file,grid_desc=temp_msg) - i = index(temp_msg, "grid_template=") + len("grid_template=") - j = index(temp_msg,":winds(") - temp_num=temp_msg(i:j-1) - endif - call MPI_BARRIER(MPI_COMM_WORLD, error) - call MPI_BCAST(temp_num,10,MPI_CHAR,0,MPI_COMM_WORLD,error) - - ! Wgrib2 can't properly read the lat/lon arrays of data on NCEP rotated lat/lon - ! grids, so read in lat/lon from fixed coordinate file - if (trim(temp_num)=="3.32769" .or. trim(temp_num)=="32769") then - - input_grid_type = "rotated_latlon" - - error=nf90_open(trim(temp_file),nf90_nowrite,ncid) - call netcdf_err(error, 'opening: '//trim(temp_file)) - - error=nf90_inq_dimid(ncid, 'nx', id_dim) - call netcdf_err(error, 'reading nx id' ) - error=nf90_inquire_dimension(ncid,id_dim,len=i_input) - call netcdf_err(error, 'reading nx value' ) - - error=nf90_inq_dimid(ncid, 'ny', id_dim) - call netcdf_err(error, 'reading ny id' ) - error=nf90_inquire_dimension(ncid,id_dim,len=j_input) - call netcdf_err(error, 'reading ny value' ) - - allocate(longitude_one_tile(i_input,j_input)) - allocate(latitude_one_tile(i_input,j_input)) - - error=nf90_inq_varid(ncid, 'gridlat', id_var) - call netcdf_err(error, 'reading field id' ) - error=nf90_get_var(ncid, id_var, latitude_one_tile) - call netcdf_err(error, 'reading field' ) - - error=nf90_inq_varid(ncid, 'gridlon', id_var) - call netcdf_err(error, 'reading field id' ) - error=nf90_get_var(ncid, id_var, longitude_one_tile) - call netcdf_err(error, 'reading field' ) - - elseif (temp_num == "3.0" .or. temp_num == "3.30" .or. temp_num=="30" .or. temp_num == "0") then - - if (temp_num =="3.0" .or. temp_num == "0") input_grid_type = "latlon" - if (temp_num =="3.30" .or. temp_num=='30') input_grid_type = "lambert" - - error = grb2_inq(the_file,inv_file,':PRES:',':surface:',nx=i_input, ny=j_input, & - lat=latitude_one_tile, lon=longitude_one_tile) - if (error /= 1) call error_handler("READING FILE", error) - - - if (localpet==0) print*, "from file lon(1:10,1) = ", longitude_one_tile(1:10,1) - if (localpet==0) print*, "from file lat(1,1:10) = ", latitude_one_tile(1,1:10) - elseif (temp_num=="NA") then - error = 0 - call error_handler("Grid template number cannot be read from the input file. Please " //& - "check that the wgrib2 executable is in your path.", error) - else - error = 0 - call error_handler("Unknown input file grid template number. Must be one of: " //& - "3, 3.30, 3.32769", error) - endif - - print*,"- I/J DIMENSIONS OF THE INPUT GRID TILES ", i_input, j_input - - ip1_input = i_input + 1 - jp1_input = j_input + 1 - -!----------------------------------------------------------------------- -! Create ESMF grid object for the model grid. -!----------------------------------------------------------------------- - - extra = npets / num_tiles_input_grid - - print*,"- CALL GridCreateNoPeriDim FOR INPUT MODEL GRID" - input_grid = ESMF_GridCreateNoPeriDim(maxIndex=(/i_input,j_input/), & - indexflag=ESMF_INDEX_GLOBAL, & - rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN GridCreateNoPeriDim", error) - - -!----------------------------------------------------------------------- -! Read the mask and lat/lons. -!----------------------------------------------------------------------- - - print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE." - latitude_input_grid = ESMF_FieldCreate(input_grid, & - typekind=ESMF_TYPEKIND_R8, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - name="input_grid_latitude", & - rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldCreate", error) - - print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE." - longitude_input_grid = ESMF_FieldCreate(input_grid, & - typekind=ESMF_TYPEKIND_R8, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - name="input_grid_longitude", & - rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldCreate", error) - - print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE. " - call ESMF_FieldScatter(latitude_input_grid, real(latitude_one_tile,esmf_kind_r8), rootpet=0, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", error) - -print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE." - call ESMF_FieldScatter(longitude_input_grid, real(longitude_one_tile,esmf_kind_r8), rootpet=0, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", error) - - - print*,"- CALL GridAddCoord FOR INPUT GRID." - call ESMF_GridAddCoord(input_grid, & - staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN GridAddCoord", error) - - - print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." - nullify(lon_src_ptr) - call ESMF_GridGetCoord(input_grid, & - staggerLoc=ESMF_STAGGERLOC_CENTER, & - coordDim=1, & - farrayPtr=lon_src_ptr, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN GridGetCoord", error) - - print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." - nullify(lat_src_ptr) - call ESMF_GridGetCoord(input_grid, & - staggerLoc=ESMF_STAGGERLOC_CENTER, & - coordDim=2, & - computationalLBound=clb, & - computationalUBound=cub, & - farrayPtr=lat_src_ptr, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN GridGetCoord", error) - - do j = clb(2),cub(2) - do i = clb(1), cub(1) - lon_src_ptr(i,j)=real(longitude_one_tile(i,j),esmf_kind_r8) - lat_src_ptr(i,j)=real(latitude_one_tile(i,j),esmf_kind_r8) - enddo - enddo - - print*,"- CALL GridAddCoord FOR INPUT GRID." - call ESMF_GridAddCoord(input_grid, & - staggerloc=ESMF_STAGGERLOC_CORNER, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN GridAddCoord", error) - - print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." - nullify(lon_src_ptr) - call ESMF_GridGetCoord(input_grid, & - staggerLoc=ESMF_STAGGERLOC_CORNER, & - coordDim=1, & - farrayPtr=lon_src_ptr, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN GridGetCoord", error) - - print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." - nullify(lat_src_ptr) - call ESMF_GridGetCoord(input_grid, & - staggerLoc=ESMF_STAGGERLOC_CORNER, & - coordDim=2, & - computationalLBound=clb, & - computationalUBound=cub, & - farrayPtr=lat_src_ptr, rc=error) - if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN GridGetCoord", error) - - - ! If we have data on a lat/lon or lambert grid, create staggered coordinates - if(trim(input_grid_type)=="latlon" .or. trim(input_grid_type) == "lambert") then - if (trim(input_grid_type) == "latlon") then - - deltalon = abs(longitude_one_tile(2,1)-longitude_one_tile(1,1)) - do j = clb(2), cub(2) - do i = clb(1), cub(1) - - if (i == ip1_input) then - lon_src_ptr(i,j) = longitude_one_tile(i_input,1) + (0.5_esmf_kind_r8*deltalon) - else - lon_src_ptr(i,j) = longitude_one_tile(i,1) - (0.5_esmf_kind_r8*deltalon) - endif - - if (j == jp1_input) then - lat_src_ptr(i,j) = latitude_one_tile(1,j_input) + (0.5_esmf_kind_r8*deltalon) - else - lat_src_ptr(i,j) = latitude_one_tile(1,j) - (0.5_esmf_kind_r8*deltalon) - endif - - enddo - enddo - else - if (localpet==0) then - !cmdline_msg = "wgrib2 "//trim(the_file)//" -d 1 -grid &> temp2.out" - !call system(cmdline_msg) - !open(4,file="temp2.out") - !do i = 1,6 - ! read(4,"(A)") temp_msg2 - !enddo - !close(4) - print*, trim(temp_msg) - i = index(temp_msg, "Dx ") + len("Dx ") - j = index(temp_msg," m Dy") - read(temp_msg(i:j-1),"(F9.6)") dx - endif - call MPI_BARRIER(MPI_COMM_WORLD,error) - call MPI_BCAST(dx,1,MPI_REAL8,0,MPI_COMM_WORLD,error) - - call get_cell_corners(real(latitude_one_tile,esmf_kind_r8), & - real(longitude_one_tile, esmf_kind_r8), & - lat_src_ptr, lon_src_ptr, dx, clb, cub) - endif - elseif (trim(input_grid_type) == "rotated_latlon") then !Read the corner coords from file - - allocate(lon_corners(ip1_input,jp1_input)) - allocate(lat_corners(ip1_input,jp1_input)) - - error=nf90_inq_varid(ncid, 'gridlon_corners', id_var) - call netcdf_err(error, 'reading field id' ) - error=nf90_get_var(ncid, id_var, lon_corners) - call netcdf_err(error, 'reading field' ) - - error=nf90_inq_varid(ncid, 'gridlat_corners', id_var) - call netcdf_err(error, 'reading field id' ) - error=nf90_get_var(ncid, id_var, lat_corners) - call netcdf_err(error, 'reading field' ) - - do j = clb(2),cub(2) - do i = clb(1), cub(1) - lon_src_ptr(i,j)=real(lon_corners(i,j),esmf_kind_r8) - lat_src_ptr(i,j)=real(lat_corners(i,j),esmf_kind_r8) - enddo - enddo - - error= nf90_close(ncid) - endif - - nullify(lon_src_ptr) - nullify(lat_src_ptr) - - deallocate(longitude_one_tile) - deallocate(latitude_one_tile) + deallocate(latitude_corner, longitude_corner) end subroutine define_input_grid_grib2 - + !> Setup the esmf grid object for the target grid. !! !! @param [in] localpet ESMF local persistent execution thread @@ -1536,91 +1315,6 @@ subroutine get_model_latlons(mosaic_file, orog_dir, num_tiles, tile, & end subroutine get_model_latlons -!> For grids with equal cell sizes (e.g., lambert conformal), get -!! latitude and longitude of the grid cell corners. -!! -!! @param [in] latitude grid box center latitude -!! @param [in] longitude grid box center longitude -!! @param [inout] latitude_sw latitude of the 'southwest' corner of grid box -!! @param [inout] longitude_sw longitude of the 'southwest' corner of grid box -!! @param [in] dx grid cell side size in meters -!! @param [in] clb lower bounds of indices processed by this mpi task -!! @param [in] cub upper bounds of indices processed by this mpi task -!! @author Larissa Reames -!! @author Jeff Beck - subroutine get_cell_corners( latitude, longitude, latitude_sw, longitude_sw, dx,clb,cub) - implicit none - - real(esmf_kind_r8), intent(in) :: latitude(i_input,j_input) - real(esmf_kind_r8), intent(inout), pointer :: latitude_sw(:,:) - real(esmf_kind_r8), intent(in) :: longitude(i_input, j_input) - real(esmf_kind_r8), intent(inout), pointer :: longitude_sw(:,:) - real(esmf_kind_r8), intent(in) :: dx - - integer, intent(in) :: clb(2), cub(2) - - real(esmf_kind_r8) :: lat1, lon1, lat2, lon2, d, brng - - - real(esmf_kind_r8), parameter :: pi = 3.14159265359 - real(esmf_kind_r8), parameter :: R = 6371200.0 - real(esmf_kind_r8), parameter :: bearingInDegrees = 135.0 - - integer :: i, j - - d = sqrt((dx**2.0_esmf_kind_r8)/2.0_esmf_kind_r8) - - do j = clb(2),cub(2) - do i = clb(1), cub(1) - - if (j == jp1_input .and. i == ip1_input) then - lat1 = latitude(i_input,j_input) * ( pi / 180.0_esmf_kind_r8 ) - lon1 = longitude(i_input,j_input) * ( pi / 180.0_esmf_kind_r8 ) - brng = 315.0_esmf_kind_r8 * pi / 180.0_esmf_kind_r8 - lat2 = asin( sin( lat1 ) * cos( d / R ) + cos( lat1 ) * sin( d / R ) * cos( brng ) ); - lon2= lon1 + atan2( sin( brng ) * sin( d / R ) * cos( lat1 ), cos( d / R ) - sin( lat1 ) * sin( lat2 ) ); - latitude_sw(ip1_input,jp1_input) = lat2 * 180.0_esmf_kind_r8 / pi - longitude_sw(ip1_input,jp1_input) = lon2 * 180.0_esmf_kind_r8 / pi - cycle - endif - - if (i == ip1_input) then - brng = 225.0_esmf_kind_r8 * pi / 180.0_esmf_kind_r8 - lat1 = latitude(i_input,j) * ( pi / 180.0_esmf_kind_r8 ) - lon1 = longitude(i_input,j) * ( pi / 180.0_esmf_kind_r8 ) - lat2 = asin( sin( lat1 ) * cos( d / R ) + cos( lat1 ) * sin( d / R ) * cos( brng ) ); - lon2= lon1 + atan2( sin( brng ) * sin( d / R ) * cos( lat1 ), cos( d / R ) - sin( lat1 ) * sin( lat2 ) ); - latitude_sw(ip1_input,j) = lat2 * 180.0_esmf_kind_r8 / pi - longitude_sw(ip1_input,j) = lon2 * 180.0_esmf_kind_r8 / pi - cycle - endif - - if (j == jp1_input) then - brng = 45.0_esmf_kind_r8 * pi / 180.0_esmf_kind_r8 - lat1 = latitude(i,j_input) * ( pi / 180.0_esmf_kind_r8 ) - lon1 = longitude(i,j_input) * ( pi / 180.0_esmf_kind_r8 ) - lat2 = asin( sin( lat1 ) * cos( d / R ) + cos( lat1 ) * sin( d / R ) * cos( brng ) ); - lon2= lon1 + atan2( sin( brng ) * sin( d / R ) * cos( lat1 ), cos( d / R ) - sin( lat1 ) * sin( lat2 ) ); - latitude_sw(i,jp1_input) = lat2 * 180.0_esmf_kind_r8 / pi - longitude_sw(i,jp1_input) = lon2 * 180.0_esmf_kind_r8 / pi - cycle - endif - - lat1 = latitude(i,j) * ( pi / 180.0_esmf_kind_r8 ) - lon1 = longitude(i,j) * ( pi / 180.0_esmf_kind_r8 ) - - brng = bearingInDegrees * ( pi / 180.0_esmf_kind_r8 ); - lat2 = asin( sin( lat1 ) * cos( d / R ) + cos( lat1 ) * sin( d / R ) * cos( brng ) ); - lon2= lon1 + atan2( sin( brng ) * sin( d / R ) * cos( lat1 ), cos( d / R ) - sin( lat1 ) * sin( lat2 ) ); - - latitude_sw(i,j) = lat2 * 180.0_esmf_kind_r8 / pi - longitude_sw(i,j) = lon2 * 180.0_esmf_kind_r8 / pi - - enddo - enddo - - end subroutine get_cell_corners - !> Read the model land mask and terrain for a single tile !! from the orography file. !! @@ -1741,4 +1435,143 @@ subroutine cleanup_input_target_grid_data end subroutine cleanup_input_target_grid_data +!> Convert the GRIB2 grid description template to +!! to the GRIB1 grid description section. +!! +!! @param [in] igdtnum GRIB2 grid description template number. +!! @param [in] igdstmpl Length of grib2 grid description template. +!! @param [in] igdtlen Array of GRIB2 grid description template octets. +!! @param [out] kgds Array of GRIB1 grid description octets. +!! @param [out] ni I-dimension of grid. +!! @param [out] nj J-dimension of grid. +!! @param [out] res Resolution of grid in km. +!! @author George Gayno NCEP/EMC + subroutine gdt_to_gds(igdtnum, igdstmpl, igdtlen, kgds, ni, nj, res) + + implicit none + + integer, intent(in ) :: igdtnum, igdtlen, igdstmpl(igdtlen) + integer, intent( out) :: kgds(200), ni, nj + integer :: iscale + + real, intent( out) :: res + + kgds=0 + + if (igdtnum.eq.32769) then ! rot lat/lon b grid + + iscale=igdstmpl(10)*igdstmpl(11) + if (iscale == 0) iscale = 1e6 + kgds(1)=205 ! oct 6, rotated lat/lon for Non-E + ! Stagger grid + kgds(2)=igdstmpl(8) ! octs 7-8, Ni + ni = kgds(2) + kgds(3)=igdstmpl(9) ! octs 9-10, Nj + nj = kgds(3) + kgds(4)=nint(float(igdstmpl(12))/float(iscale)*1000.) ! octs 11-13, Lat of + ! 1st grid point + kgds(5)=nint(float(igdstmpl(13))/float(iscale)*1000.) ! octs 14-16, Lon of + ! 1st grid point + + kgds(6)=0 ! oct 17, resolution and component flags + if (igdstmpl(1)==2 ) kgds(6)=64 + if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) kgds(6)=kgds(6)+128 + if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 + + kgds(7)=nint(float(igdstmpl(15))/float(iscale)*1000.) ! octs 18-20, + ! Lat of cent of rotation + kgds(8)=nint(float(igdstmpl(16))/float(iscale)*1000.) ! octs 21-23, + ! Lon of cent of rotation + kgds(9)=nint(float(igdstmpl(17))/float(iscale)*1000.) ! octs 24-25, + ! Di + kgds(10)=nint(float(igdstmpl(18))/float(iscale)*1000.) ! octs 26-27, + ! Dj + + kgds(11) = 0 ! oct 28, scan mode + if (btest(igdstmpl(19),7)) kgds(11) = 128 + if (btest(igdstmpl(19),6)) kgds(11) = kgds(11) + 64 + if (btest(igdstmpl(19),5)) kgds(11) = kgds(11) + 32 + + kgds(12)=nint(float(igdstmpl(20))/float(iscale)*1000.) ! octs 29-31, Lat of + ! last grid point + kgds(13)=nint(float(igdstmpl(21))/float(iscale)*1000.) ! octs 32-34, Lon of + ! last grid point + + kgds(19)=0 ! oct 4, # vert coordinate parameters + kgds(20)=255 ! oct 5, used for thinned grids, set to 255 + + res = ((float(kgds(9)) / 1000.0) + (float(kgds(10)) / 1000.0)) & + * 0.5 * 111.0 + + elseif(igdtnum==30) then + + kgds(1)=3 ! oct 6, lambert conformal + kgds(2)=igdstmpl(8) ! octs 7-8, Ni + ni = kgds(2) + kgds(3)=igdstmpl(9) ! octs 9-10, Nj + nj = kgds(3) + + iscale = 1e6 + kgds(4) = nint(float(igdstmpl(10))/1000.0) + kgds(5) = nint(float(igdstmpl(11))/1000.0) + + kgds(6)=0 ! oct 17, resolution and component flags + if (igdstmpl(1)==2 ) kgds(6)=64 + if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) kgds(6)=kgds(6)+128 + if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8 + + kgds(7) = nint(float(igdstmpl(14))/1000.0) + kgds(8) = nint(float(igdstmpl(15))/1000.0) + kgds(9) = nint(float(igdstmpl(16))/1000.0) + kgds(10) = 0 + + kgds(11) = 0 ! oct 28, scan mode + if (btest(igdstmpl(18),7)) kgds(11) = 128 + if (btest(igdstmpl(18),6)) kgds(11) = kgds(11) + 64 + if (btest(igdstmpl(18),5)) kgds(11) = kgds(11) + 32 + + kgds(12) = nint(float(igdstmpl(19))/1000.0) + kgds(13) = nint(float(igdstmpl(20))/1000.0) + kgds(14) = -90 + kgds(15) = 0 + + elseif(igdtnum==0) then ! lat/lon grid + + iscale=igdstmpl(10)*igdstmpl(11) + if (iscale == 0) iscale = 1e6 + kgds(1)=0 ! oct 6, data representation type. + kgds(2)=igdstmpl(8) ! octs 7-8, Ni + ni = kgds(2) + kgds(3)=igdstmpl(9) ! octs 9-10, Nj + nj = kgds(3) + kgds(4)=nint(float(igdstmpl(12))/float(iscale)*1000.) ! octs 11-13, Lat of 1st grid point + kgds(5)=nint(float(igdstmpl(13))/float(iscale)*1000.) ! octs 14-16, Lon of 1st grid point + + kgds(6)=0 ! oct 17, resolution and component flags + if (igdstmpl(1)==2 ) kgds(6)=64 + if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) kgds(6)=kgds(6)+128 + if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 + + kgds(7)=nint(float(igdstmpl(15))/float(iscale)*1000.) ! octs 18-20, Lat of last grid point + kgds(8)=nint(float(igdstmpl(16))/float(iscale)*1000.) ! octs 21-23, Lon of last grid point + kgds(9)=nint(float(igdstmpl(17))/float(iscale)*1000.) ! octs 24-25, "i" resolution. + kgds(10)=nint(float(igdstmpl(18))/float(iscale)*1000.) ! octs 26-27, "j" resolution. + + kgds(11) = 0 ! oct 28, scan mode + if (btest(igdstmpl(19),7)) kgds(11) = 128 + if (btest(igdstmpl(19),6)) kgds(11) = kgds(11) + 64 + if (btest(igdstmpl(19),5)) kgds(11) = kgds(11) + 32 + + kgds(12)=0 ! octs 29-32, reserved + kgds(19)=0 ! oct 4, # vert coordinate parameters + kgds(20)=255 ! oct 5, used for thinned grids, set to 255 + + else + + call error_handler("UNRECOGNIZED INPUT GRID TYPE ", 1) + + endif + + end subroutine gdt_to_gds + end module model_grid diff --git a/sorc/chgres_cube.fd/program_setup.F90 b/sorc/chgres_cube.fd/program_setup.F90 index 5e854a2c3..722e701a7 100644 --- a/sorc/chgres_cube.fd/program_setup.F90 +++ b/sorc/chgres_cube.fd/program_setup.F90 @@ -53,10 +53,6 @@ module program_setup !! gfs sigio/sfcio files. character(len=20), public :: external_model="GFS" !< The model that the input data is derived from. Current supported options are: "GFS", "HRRR", "NAM", "RAP". Default: "GFS" - character(len=500), public :: fix_dir_input_grid = "NULL" !< Directory containing files of latitude and - !! and longitude for certain GRIB2 input data. - - integer, parameter, public :: max_tracers=100 !< Maximum number of atmospheric tracers processed. integer, public :: num_tracers !< Number of atmospheric tracers to be processed. integer, public :: num_tracers_input !< Number of atmospheric tracers in input file. @@ -193,7 +189,6 @@ subroutine read_setup_namelist(filename) tracers_input, & halo_bndy, & halo_blend, & - fix_dir_input_grid, & nsoill_out, & thomp_mp_climo_file diff --git a/sorc/chgres_cube.fd/static_data.F90 b/sorc/chgres_cube.fd/static_data.F90 index ad9634da0..081d6beac 100644 --- a/sorc/chgres_cube.fd/static_data.F90 +++ b/sorc/chgres_cube.fd/static_data.F90 @@ -46,8 +46,7 @@ module static_data !! @author George Gayno NCEP/EMC subroutine get_static_fields(localpet) - use model_grid, only : target_grid, & - num_tiles_target_grid, & + use model_grid, only : num_tiles_target_grid, & i_target, j_target implicit none diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 7df645cfa..8213d17ba 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -323,7 +323,7 @@ subroutine interp(localpet) integer :: clb_target(2), cub_target(2) integer :: isrctermprocessing integer :: num_fields - integer :: sotyp_ind, vgfrc_ind, mmvg_ind, lai_ind + integer :: vgfrc_ind, mmvg_ind, lai_ind integer, allocatable :: search_nums(:) integer(esmf_kind_i4), pointer :: unmapped_ptr(:) integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:) diff --git a/ush/chgres_cube.sh b/ush/chgres_cube.sh index 550439049..ec13ff75a 100755 --- a/ush/chgres_cube.sh +++ b/ush/chgres_cube.sh @@ -24,8 +24,7 @@ CRES=${CRES:-96} # FIXufs - Location of ufs_utils root fixed data directory. # FIXfv3 - Location of target grid orography and 'grid' files. # FIXsfc - Location of target grid surface climatological files. -# FIXam - Location of vertical coordinate definition file for target grid -# and RAP grib2 input grid lat/lon definition file. +# FIXam - Location of vertical coordinate definition file for target grid. #---------------------------------------------------------------------------- ufs_ver=${ufs_ver:-v1.0.0} @@ -249,7 +248,6 @@ cat << EOF > ./fort.41 mosaic_file_target_grid="${MOSAIC_FILE_TARGET_GRID}" fix_dir_target_grid="${FIXsfc}" orog_dir_target_grid="${FIXfv3}" - fix_dir_input_grid="${FIXam}" orog_files_target_grid="${OROG_FILES_TARGET_GRID}" vcoord_file_target_grid="${VCOORD_FILE}" mosaic_file_input_grid="${MOSAIC_FILE_INPUT_GRID}" From 127d7e47c9e8344dc0692eed870c95cf0b200911 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Thu, 28 Apr 2022 11:43:44 -0400 Subject: [PATCH 029/109] Download unit test data as part of the CMake build (#630) Update the build system to download all files required for the unit tests. Fixes #619. --- .../workflows/debug-docs-test_coverage.yml | 5 +---- .github/workflows/intel.yml | 5 +---- .github/workflows/linux-mac-nceplibs-mpi.yml | 5 +---- .github/workflows/netcdf-versions.yml | 5 +---- CMakeLists.txt | 4 +--- build_all.sh | 17 +++++++++++++-- cmake/mpiexec.jet | 15 ------------- tests/CMakeLists.txt | 21 +++++++++++++++++++ tests/chgres_cube/CMakeLists.txt | 16 +++++++++++--- tests/chgres_cube/data/files.txt | 6 ------ tests/fvcom_tools/CMakeLists.txt | 16 ++++++++------ tests/fvcom_tools/ftst_readfvcomnetcdf.F90 | 4 ++-- tests/sfc_climo_gen/CMakeLists.txt | 16 ++++++++++++-- tests/sfc_climo_gen/data/files.txt | 4 ---- 14 files changed, 80 insertions(+), 59 deletions(-) delete mode 100755 cmake/mpiexec.jet delete mode 100644 tests/chgres_cube/data/files.txt delete mode 100644 tests/sfc_climo_gen/data/files.txt diff --git a/.github/workflows/debug-docs-test_coverage.yml b/.github/workflows/debug-docs-test_coverage.yml index 6d953cd95..011645c34 100644 --- a/.github/workflows/debug-docs-test_coverage.yml +++ b/.github/workflows/debug-docs-test_coverage.yml @@ -103,10 +103,7 @@ jobs: - name: test run: | - cd ufs_utils/build/tests - wget -i ./chgres_cube/data/files.txt -P ./chgres_cube/data - wget -i ./sfc_climo_gen/data/files.txt -P ./sfc_climo_gen/data - cd ../ + cd ufs_utils/build export LSAN_OPTIONS=suppressions=LSanSuppress.supp ctest --rerun-failed --output-on-failure export PATH="/home/runner/.local/bin:$PATH" diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index 240003849..cbc79472f 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -166,8 +166,5 @@ jobs: - name: test run: | - cd ufs_utils/build/tests - wget -i ./chgres_cube/data/files.txt -P ./chgres_cube/data - wget -i ./sfc_climo_gen/data/files.txt -P ./sfc_climo_gen/data - cd ../ + cd ufs_utils/build ctest --rerun-failed --output-on-failure diff --git a/.github/workflows/linux-mac-nceplibs-mpi.yml b/.github/workflows/linux-mac-nceplibs-mpi.yml index 68d9da6ae..205e41a34 100644 --- a/.github/workflows/linux-mac-nceplibs-mpi.yml +++ b/.github/workflows/linux-mac-nceplibs-mpi.yml @@ -221,10 +221,7 @@ jobs: - name: test run: | - cd ufs_utils/build/tests - wget -i ./chgres_cube/data/files.txt -P ./chgres_cube/data - wget -i ./sfc_climo_gen/data/files.txt -P ./sfc_climo_gen/data - cd ../ + cd ufs_utils/build # Oversubscribe for OpenMPI to run more processes than CPUs export OMPI_MCA_rmaps_base_oversubscribe=1 ctest --rerun-failed --output-on-failure diff --git a/.github/workflows/netcdf-versions.yml b/.github/workflows/netcdf-versions.yml index 98ecd746a..42eb28417 100644 --- a/.github/workflows/netcdf-versions.yml +++ b/.github/workflows/netcdf-versions.yml @@ -154,9 +154,6 @@ jobs: - name: test run: | - cd ufs_utils/build/tests - wget -i ./chgres_cube/data/files.txt -P ./chgres_cube/data - wget -i ./sfc_climo_gen/data/files.txt -P ./sfc_climo_gen/data - cd ../ + cd ufs_utils/build export LSAN_OPTIONS=suppressions=LSanSuppress.supp ctest --rerun-failed --output-on-failure diff --git a/CMakeLists.txt b/CMakeLists.txt index 68869d5c2..f57f1c9eb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -23,8 +23,6 @@ if(NOT CMAKE_BUILD_TYPE MATCHES "^(Debug|Release|RelWithDebInfo|MinSizeRel)$") CACHE STRING "Choose the type of build." FORCE) set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "MinSizeRel" "RelWithDebInfo") - message(STATUS "Set BUILD_TESTING to YES and build unit testing package under tests") - set(BUILD_TESTING "YES") endif() # Set compiler flags. @@ -92,6 +90,6 @@ add_subdirectory(sorc) # Run unit tests. include(CTest) if(BUILD_TESTING) + message(STATUS "Set BUILD_TESTING to YES and build unit testing package under tests") add_subdirectory(tests) endif() - diff --git a/build_all.sh b/build_all.sh index fe457c9ca..0a8de2d7c 100755 --- a/build_all.sh +++ b/build_all.sh @@ -26,8 +26,18 @@ else set -x fi -CMAKE_FLAGS="-DCMAKE_INSTALL_PREFIX=../ -DEMC_EXEC_DIR=ON" -#CMAKE_FLAGS="-DCMAKE_INSTALL_PREFIX=../ -DEMC_EXEC_DIR=ON -DENABLE_DOCS=ON" +# The unit test data download is part of the build system. Not all machines can +# access the EMC ftp site, so turn off the build (-DBUILD_TESTING=OFF) of the units tests accordingly. +# Those with access to the EMC ftp site are: Orion, Hera, WCOSS-Cray, WCOSS-Dell. + +if [[ "$target" == "hera" || "$target" == "orion" || "$target" == "wcoss_cray" || "$target" == "wcoss_dell_p3" ]]; then + CMAKE_FLAGS="-DCMAKE_INSTALL_PREFIX=../ -DEMC_EXEC_DIR=ON -DBUILD_TESTING=OFF" + #CMAKE_FLAGS="-DCMAKE_INSTALL_PREFIX=../ -DEMC_EXEC_DIR=ON -DBUILD_TESTING=ON" + #CMAKE_FLAGS="-DCMAKE_INSTALL_PREFIX=../ -DEMC_EXEC_DIR=ON -DENABLE_DOCS=ON -DBUILD_TESTING=ON" +else + CMAKE_FLAGS="-DCMAKE_INSTALL_PREFIX=../ -DEMC_EXEC_DIR=ON -DBUILD_TESTING=OFF" + #CMAKE_FLAGS="-DCMAKE_INSTALL_PREFIX=../ -DEMC_EXEC_DIR=ON -DENABLE_DOCS=ON -DBUILD_TESTING=OFF" +fi rm -fr ./build mkdir ./build && cd ./build @@ -37,4 +47,7 @@ cmake .. ${CMAKE_FLAGS} make -j 8 VERBOSE=1 make install +#make test +#ctest -I 4,5 + exit diff --git a/cmake/mpiexec.jet b/cmake/mpiexec.jet deleted file mode 100755 index 332b33e29..000000000 --- a/cmake/mpiexec.jet +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/bash -# -# Arguments: -# -# $1 - Number of MPI Tasks -# $2+ - Executable and its arguments -# - -ACCOUNT= -QOS=debug - -NP=$1 -shift - -srun -A $ACCOUNT -q $QOS -n $NP $@ diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 894b01b5f..67f3e3e0b 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -3,7 +3,28 @@ # # Ed Hartnett 2/11/21 +# This function is used to download unit test data. +# It takes two arguments, the URL and the file to +# be downloaded. + +function(PULL_DATA THE_URL THE_FILE) + if(NOT EXISTS "${CMAKE_CURRENT_BINARY_DIR}/data/${THE_FILE}") + file(DOWNLOAD + ${THE_URL}/${THE_FILE} + ${CMAKE_CURRENT_BINARY_DIR}/data/${THE_FILE} + SHOW_PROGRESS + STATUS status + INACTIVITY_TIMEOUT 30 + ) + list(GET status 0 status_num) + if(NOT status_num EQUAL 0 OR NOT EXISTS "${CMAKE_CURRENT_BINARY_DIR}/data/${THE_FILE}") + message(FATAL_ERROR "Could not download ${THE_FILE}") + endif() + endif() +endfunction() + # Add the test subdirecotries. +# fvcom test only works for Intel. Comment out for now. #add_subdirectory(fvcom_tools) add_subdirectory(filter_topo) add_subdirectory(chgres_cube) diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index 73274ca76..d6d46f95a 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -3,7 +3,19 @@ # # George Gayno, Lin Gan, Ed Hartnett, Larissa Reames -# Include cmake to allow parallel I/O tests. +set(CHGRES_URL "https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube") + +set(V16SFC_FILE "gfs.v16.sfc.history.nc") +set(V16SFC_FILE2 "gfs.v16.sfc2.history.nc") +set(V16ATM_FILE "gfs.v16.atm.history.nc") +set(V14SFC_FILE "gfs.v14.sfc.history.nemsio") +set(V15SFC_FILE "gfs.v15.sfc.history.nemsio") +set(GFS_GRIB_FILE "gfs.t00z.pgrb2.0p50.f000") + +foreach(THE_FILE IN LISTS V16SFC_FILE V16SFC_FILE2 V16ATM_FILE V14SFC_FILE V15SFC_FILE GFS_GRIB_FILE) + PULL_DATA(${CHGRES_URL} ${THE_FILE}) +endforeach() + include (LibMPI) if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") @@ -16,8 +28,6 @@ include_directories(${PROJECT_SOURCE_DIR}) # Copy necessary test files from the source data directory to the # build data directory. -execute_process( COMMAND ${CMAKE_COMMAND} -E copy - ${CMAKE_CURRENT_SOURCE_DIR}/data/files.txt ${CMAKE_CURRENT_BINARY_DIR}/data/files.txt) execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/data/config_fv3_tiled.nml ${CMAKE_CURRENT_BINARY_DIR}/data/config_fv3_tiled.nml) execute_process( COMMAND ${CMAKE_COMMAND} -E copy diff --git a/tests/chgres_cube/data/files.txt b/tests/chgres_cube/data/files.txt deleted file mode 100644 index e214957a4..000000000 --- a/tests/chgres_cube/data/files.txt +++ /dev/null @@ -1,6 +0,0 @@ -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v16.sfc.history.nc -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v16.sfc2.history.nc -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v16.atm.history.nc -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v14.sfc.history.nemsio -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.v15.sfc.history.nemsio -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/chgres_cube/gfs.t00z.pgrb2.0p50.f000 diff --git a/tests/fvcom_tools/CMakeLists.txt b/tests/fvcom_tools/CMakeLists.txt index 50ac42441..125d2c956 100644 --- a/tests/fvcom_tools/CMakeLists.txt +++ b/tests/fvcom_tools/CMakeLists.txt @@ -1,8 +1,17 @@ -# This is the cmake build file for the tests directory of the +# This is the cmake build file for the fvcom_tools test directory of the # UFS_UTILS project. # # David Wright +set(FVCOM_URL "https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/fvcom_tools") + +set(FVCOM_FILE "fvcom_unittest.nc") +set(SFCDATA_FILE "sfcdata_unittest.nc") + +foreach(THE_FILE IN LISTS FVCOM_FILE SFCDATA_FILE) + PULL_DATA(${FVCOM_URL} ${THE_FILE}) +endforeach() + if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -assume byterecl") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") @@ -13,14 +22,9 @@ include_directories(${PROJECT_SOURCE_DIR}) # Copy necessary test files from the source data directory to the # build data directory. -execute_process( COMMAND ${CMAKE_COMMAND} -E copy - ${CMAKE_CURRENT_SOURCE_DIR}/data/sfcdata_unittest.nc ${CMAKE_CURRENT_BINARY_DIR}/sfcdata_unittest.nc) -execute_process( COMMAND ${CMAKE_COMMAND} -E copy - ${CMAKE_CURRENT_SOURCE_DIR}/data/fvcom_unittest.nc ${CMAKE_CURRENT_BINARY_DIR}/fvcom_unittest.nc) execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/LSanSuppress.supp ${CMAKE_CURRENT_BINARY_DIR}/LSanSuppress.supp) add_executable(ftst_readfvcomnetcdf ftst_readfvcomnetcdf.F90) add_test(NAME fvcom_tools-ftst_readfvcomnetcdf COMMAND ftst_readfvcomnetcdf) target_link_libraries(ftst_readfvcomnetcdf fvcom_tools_lib) - diff --git a/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 index d43fb1f7f..a472f660f 100644 --- a/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 +++ b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 @@ -74,8 +74,8 @@ program readfvcomnetcdf print*,"Starting test of fvcom_tools." !Set default file names, cold start, and time str - fv3file = 'sfcdata_unittest.nc' - fvcomfile = 'fvcom_unittest.nc' + fv3file = './data/sfcdata_unittest.nc' + fvcomfile = './data/fvcom_unittest.nc' wcstart = 'cold' inputFVCOMselStr = '3333-44-55T66:77:88.000000' t1 = 1 diff --git a/tests/sfc_climo_gen/CMakeLists.txt b/tests/sfc_climo_gen/CMakeLists.txt index 734dd1f4d..82e90207f 100644 --- a/tests/sfc_climo_gen/CMakeLists.txt +++ b/tests/sfc_climo_gen/CMakeLists.txt @@ -3,6 +3,20 @@ # # George Gayno, Lin Gan, Ed Hartnett, Larissa Reames +set(SFCGEN_URL "https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/sfc_climo_gen") +set(MOSAIC_FILE "C450_mosaic.nc") +set(GRID_FILE "C450_grid.tile7.nc") +set(ORO_FILE "C450_oro_data.tile7.nc") + +foreach(THE_FILE IN LISTS MOSAIC_FILE GRID_FILE ORO_FILE) + PULL_DATA(${SFCGEN_URL} ${THE_FILE}) +endforeach() + +set(SFCGEN2_URL "https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/GFS/fix/fix_sfc_climo") +set(VEG_FILE "vegetation_type.viirs.igbp.0.1.nc") + +PULL_DATA(${SFCGEN2_URL} ${VEG_FILE}) + # Include cmake to allow parallel I/O tests. include (LibMPI) @@ -16,8 +30,6 @@ include_directories(${PROJECT_SOURCE_DIR}) # Copy necessary test files from the source data directory to the # build data directory. -execute_process( COMMAND ${CMAKE_COMMAND} -E copy - ${CMAKE_CURRENT_SOURCE_DIR}/data/files.txt ${CMAKE_CURRENT_BINARY_DIR}/data/files.txt) execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/LSanSuppress.supp ${CMAKE_CURRENT_BINARY_DIR}/LSanSuppress.supp) diff --git a/tests/sfc_climo_gen/data/files.txt b/tests/sfc_climo_gen/data/files.txt deleted file mode 100644 index c5b8bd439..000000000 --- a/tests/sfc_climo_gen/data/files.txt +++ /dev/null @@ -1,4 +0,0 @@ -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/sfc_climo_gen/C450_mosaic.nc -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/sfc_climo_gen/C450_grid.tile7.nc -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/ufs_utils/unit_tests/sfc_climo_gen/C450_oro_data.tile7.nc -https://ftp.emc.ncep.noaa.gov/static_files/public/UFS/GFS/fix/fix_sfc_climo/vegetation_type.viirs.igbp.0.1.nc From b23a25a218deb20113b6cf18002525df2e06841d Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Tue, 3 May 2022 14:56:15 -0400 Subject: [PATCH 030/109] Host doxygen documentation for multiple releases (#644) Update the user_guide.md file to list a table of contents for each release. Fixes #610. --- docs/user_guide.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/user_guide.md b/docs/user_guide.md index dc70b4466..624c2f66d 100644 --- a/docs/user_guide.md +++ b/docs/user_guide.md @@ -8,6 +8,13 @@ Utilities for the NCEP models. This is part of the The UFS_UTILS code can be found here: https://github.com/ufs-community/UFS_UTILS. +## Documentation for Previous Versions of UFS_UTILS + +* [UFS_UTILS Version 1.6.0](ver-1.6.0/index.html) +* [UFS_UTILS Version 1.5.0](ver-1.5.0/index.html) +* [UFS_UTILS Version 1.4.0](ver-1.4.0/index.html) +* [UFS_UTILS Version 1.3.0](ver-1.3.0/index.html) + ## The Utilities - chgres_cube - Creates cold From 59cb9311b923e7f22893642173cb640b19b2b99f Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Fri, 13 May 2022 09:45:19 -0400 Subject: [PATCH 031/109] Move to Intel 2022 on Jet, Hera and Orion (#650) Update the Hera, Jet and Orion build modules to use the Intel 2022 compiler, and to use v1.2.0 of the hpc-stack. Replace some deprecated compiler flags used by the filter_topo program. Fixes #634. --- modulefiles/build.hera.intel.lua | 16 ++++++++-------- modulefiles/build.jet.intel.lua | 14 +++++++------- modulefiles/build.orion.intel.lua | 16 ++++++++-------- sorc/grid_tools.fd/filter_topo.fd/CMakeLists.txt | 2 +- 4 files changed, 24 insertions(+), 24 deletions(-) diff --git a/modulefiles/build.hera.intel.lua b/modulefiles/build.hera.intel.lua index 036b47fc6..e75162486 100644 --- a/modulefiles/build.hera.intel.lua +++ b/modulefiles/build.hera.intel.lua @@ -10,25 +10,25 @@ load(pathJoin("hpss", hpss_ver)) prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") -hpc_ver=os.getenv("hpc_ver") or "1.1.0" +hpc_ver=os.getenv("hpc_ver") or "1.2.0" load(pathJoin("hpc", hpc_ver)) -hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" +hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" load(pathJoin("hpc-intel", hpc_intel_ver)) -impi_ver=os.getenv("impi_ver") or "2018.0.4" +impi_ver=os.getenv("impi_ver") or "2022.1.2" load(pathJoin("hpc-impi", impi_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" load(pathJoin("bacio", bacio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.3" +g2_ver=os.getenv("g2_ver") or "3.4.5" load(pathJoin("g2", g2_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" +nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" load(pathJoin("nemsio", nemsio_ver)) sp_ver=os.getenv("sp_ver") or "2.3.3" @@ -47,7 +47,7 @@ zlib_ver=os.getenv("zlib_ver") or "1.2.11" load(pathJoin("zlib", zlib_ver)) png_ver=os.getenv("png_ver") or "1.6.35" -load(pathJoin("png", png_ver)) +load(pathJoin("libpng", png_ver)) hdf5_ver=os.getenv("hdf5_ver") or "1.10.6" load(pathJoin("hdf5", hdf5_ver)) @@ -55,10 +55,10 @@ load(pathJoin("hdf5", hdf5_ver)) netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" load(pathJoin("netcdf", netcdf_ver)) -nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +nccmp_ver=os.getenv("nccmp_ver") or "1.8.9.0" load(pathJoin("nccmp", nccmp_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_2_0" +esmf_ver=os.getenv("esmf_ver") or "8.2.1b04" load(pathJoin("esmf", esmf_ver)) whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.jet.intel.lua b/modulefiles/build.jet.intel.lua index 2a18d626d..c6652460e 100644 --- a/modulefiles/build.jet.intel.lua +++ b/modulefiles/build.jet.intel.lua @@ -10,13 +10,13 @@ load(pathJoin("hpss", hpss_ver)) prepend_path("MODULEPATH", "/lfs4/HFIP/hfv3gfs/nwprod/hpc-stack/libs/modulefiles/stack") -hpc_ver=os.getenv("hpc_ver") or "1.1.0" +hpc_ver=os.getenv("hpc_ver") or "1.2.0" load(pathJoin("hpc", hpc_ver)) -hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" +hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" load(pathJoin("hpc-intel", hpc_intel_ver)) -impi_ver=os.getenv("impi_ver") or "2018.4.274" +impi_ver=os.getenv("impi_ver") or "2022.1.2" load(pathJoin("hpc-impi", impi_ver)) hdf5_ver=os.getenv("hdf5_ver") or "1.10.6" @@ -25,10 +25,10 @@ load(pathJoin("hdf5", hdf5_ver)) netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" load(pathJoin("netcdf", netcdf_ver)) -nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +nccmp_ver=os.getenv("nccmp_ver") or "1.8.9.0" load(pathJoin("nccmp", nccmp_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_2_0" +esmf_ver=os.getenv("esmf_ver") or "8.2.0" load(pathJoin("esmf", esmf_ver)) w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" @@ -49,10 +49,10 @@ load(pathJoin("sigio", sigio_ver)) sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" load(pathJoin("sfcio", sfcio_ver)) -nemsio_ver=os.getenv("nemsio_ver") or "2.5.2" +nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" load(pathJoin("nemsio", nemsio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.3" +g2_ver=os.getenv("g2_ver") or "3.4.5" load(pathJoin("g2", g2_ver)) prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" diff --git a/modulefiles/build.orion.intel.lua b/modulefiles/build.orion.intel.lua index fb1ec0569..ec13ac657 100644 --- a/modulefiles/build.orion.intel.lua +++ b/modulefiles/build.orion.intel.lua @@ -7,25 +7,25 @@ load(pathJoin("cmake", cmake_ver)) prepend_path("MODULEPATH", "/apps/contrib/NCEP/libs/hpc-stack/modulefiles/stack") -hpc_ver=os.getenv("hpc_ver") or "1.1.0" +hpc_ver=os.getenv("hpc_ver") or "1.2.0" load(pathJoin("hpc", hpc_ver)) -hpc_intel_ver=os.getenv("hpc_intel_ver") or "2018.4" +hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" load(pathJoin("hpc-intel", hpc_intel_ver)) -impi_ver=os.getenv("impi_ver") or "2018.4" +impi_ver=os.getenv("impi_ver") or "2022.1.2" load(pathJoin("hpc-impi", impi_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" load(pathJoin("bacio", bacio_ver)) -g2_ver=os.getenv("g2_ver") or "3.4.3" +g2_ver=os.getenv("g2_ver") or "3.4.5" load(pathJoin("g2", g2_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" +nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" load(pathJoin("nemsio", nemsio_ver)) sp_ver=os.getenv("sp_ver") or "2.3.3" @@ -44,7 +44,7 @@ zlib_ver=os.getenv("zlib_ver") or "1.2.11" load(pathJoin("zlib", zlib_ver)) png_ver=os.getenv("png_ver") or "1.6.35" -load(pathJoin("png", png_ver)) +load(pathJoin("libpng", png_ver)) hdf5_ver=os.getenv("hdf5_ver") or "1.10.6" load(pathJoin("hdf5", hdf5_ver)) @@ -52,10 +52,10 @@ load(pathJoin("hdf5", hdf5_ver)) netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" load(pathJoin("netcdf", netcdf_ver)) -nccmp_ver=os.getenv("nccmp_ver") or "1.8.7.0" +nccmp_ver=os.getenv("nccmp_ver") or "1.8.9.0" load(pathJoin("nccmp", nccmp_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_2_0" +esmf_ver=os.getenv("esmf_ver") or "8.2.0" load(pathJoin("esmf", esmf_ver)) whatis("Description: UFS_UTILS build environment") diff --git a/sorc/grid_tools.fd/filter_topo.fd/CMakeLists.txt b/sorc/grid_tools.fd/filter_topo.fd/CMakeLists.txt index f570adfc3..74f2c3850 100644 --- a/sorc/grid_tools.fd/filter_topo.fd/CMakeLists.txt +++ b/sorc/grid_tools.fd/filter_topo.fd/CMakeLists.txt @@ -5,7 +5,7 @@ set(exe_src filter_topo.F90) if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -assume byterecl -real_size 64 -fno-alias -stack_temps -safe_cray_ptr -ftz") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -assume byterecl -real-size 64 -fno-alias -stack-temps -safe-cray-ptr -ftz") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-0 -fdefault-real-8") endif() From b6efa8650eec2278901867e830b983714c001ffa Mon Sep 17 00:00:00 2001 From: Natalie Perlin <68030316+natalie-perlin@users.noreply.github.com> Date: Fri, 20 May 2022 08:57:56 -0400 Subject: [PATCH 032/109] Update build module on Cheyenne (#646) Update to Intel 2022, hpc-stack v1.2.0 and ESMF v8.3.0b09. Fixes #645. --- modulefiles/build.cheyenne.intel | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/modulefiles/build.cheyenne.intel b/modulefiles/build.cheyenne.intel index c1971328f..d323221d4 100644 --- a/modulefiles/build.cheyenne.intel +++ b/modulefiles/build.cheyenne.intel @@ -4,15 +4,19 @@ module purge module load ncarenv/1.3 -module load intel/19.1.1 -module load mpt/2.19 +module load intel/2022.1 +module load mpt/2.25 module load ncarcompilers/0.5.0 -module load cmake/3.16.4 +module load cmake/3.22.0 + +module use -a /glade/work/epicufsrt/GMTB/tools/intel/2022.1/hpc-stack-v1.2.0_6eb6/modulefiles/stack +module load hpc/1.2.0 +module load hpc-intel/2022.1 +module load hpc-mpt/2.25 -module use -a /glade/p/ral/jntp/GMTB/tools/NCEPLIBS-ufs-v2.0.0/intel-19.1.1/mpt-2.19/modules module load bacio/2.4.1 -module load g2/3.4.1 +module load g2/3.4.3 module load ip/3.3.3 module load nemsio/2.5.2 module load sp/2.3.3 @@ -21,8 +25,7 @@ module load sigio/2.3.2 module load sfcio/1.4.1 module load netcdf/4.7.4 - -setenv ESMFMKFILE /glade/p/ral/jntp/GMTB/tools/NCEPLIBS-ufs-v2.0.0/intel-19.1.1/mpt-2.19/lib64/esmf.mk +module load esmf/8.3.0b09 setenv CMAKE_C_COMPILER icc setenv CMAKE_Fortran_COMPILER ifort From 63229527c560a68a0766373c72c8c42fb11efa48 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Mon, 23 May 2022 10:22:09 -0400 Subject: [PATCH 033/109] Add processing of new global AFWA snow data to emcsfc_snow2mdl. (#648) Update emcsfc_snow2mdl to optionally use the new AFWA snow data. Add a new unit test and a new consistency test. Fixes #635. --- reg_tests/rt.sh | 5 +- reg_tests/snow2mdl/driver.hera.sh | 46 +++++++---- reg_tests/snow2mdl/driver.jet.sh | 43 ++++++---- reg_tests/snow2mdl/driver.orion.sh | 49 ++++++----- reg_tests/snow2mdl/driver.wcoss_cray.sh | 47 +++++++---- reg_tests/snow2mdl/driver.wcoss_dell_p3.sh | 41 ++++++---- reg_tests/snow2mdl/snow2mdl.global.sh | 57 +++++++++++++ .../snow2mdl/{snow2mdl.sh => snow2mdl.ops.sh} | 15 ++-- sorc/emcsfc_snow2mdl.fd/snowdat.F90 | 81 ++++++++++--------- tests/CMakeLists.txt | 1 + tests/emcsfc_snow2mdl/CMakeLists.txt | 21 +++++ tests/emcsfc_snow2mdl/LSanSuppress.supp | 1 + tests/emcsfc_snow2mdl/data/config.nml | 34 ++++++++ tests/emcsfc_snow2mdl/ftst_program_setup.F90 | 50 ++++++++++++ ush/emcsfc_snow.sh | 4 +- 15 files changed, 359 insertions(+), 136 deletions(-) create mode 100755 reg_tests/snow2mdl/snow2mdl.global.sh rename reg_tests/snow2mdl/{snow2mdl.sh => snow2mdl.ops.sh} (71%) create mode 100644 tests/emcsfc_snow2mdl/CMakeLists.txt create mode 100644 tests/emcsfc_snow2mdl/LSanSuppress.supp create mode 100644 tests/emcsfc_snow2mdl/data/config.nml create mode 100644 tests/emcsfc_snow2mdl/ftst_program_setup.F90 diff --git a/reg_tests/rt.sh b/reg_tests/rt.sh index dd25f276a..bf196f576 100755 --- a/reg_tests/rt.sh +++ b/reg_tests/rt.sh @@ -68,7 +68,7 @@ cd fix cd ../reg_tests sleep_time=0 -for dir in global_cycle chgres_cube grid_gen; do +for dir in snow2mdl global_cycle chgres_cube grid_gen; do cd $dir ./driver.$target.sh # Wait for job to complete @@ -89,8 +89,7 @@ elif [[ $target == "wcoss_cray" ]]; then module load xt-lsfhpc/9.1.3 fi - -for dir in snow2mdl ice_blend; do +for dir in ice_blend; do cd $dir if [[ $target == "hera" ]] || [[ $target == "jet" ]] || [[ $target == "orion" ]]; then sbatch -A ${PROJECT_CODE} ./driver.$target.sh diff --git a/reg_tests/snow2mdl/driver.hera.sh b/reg_tests/snow2mdl/driver.hera.sh index 11e854954..bc80942d8 100755 --- a/reg_tests/snow2mdl/driver.hera.sh +++ b/reg_tests/snow2mdl/driver.hera.sh @@ -2,12 +2,12 @@ #----------------------------------------------------------------------------- # -# Run snow2mdl consistency test on Hera. +# Run snow2mdl consistency tests on Hera. # -# Set $DATA to your working directory. Set the project code (SBATCH -A) +# Set $DATA_ROOT to your working directory. Set the project code (SBATCH -A) # and queue (SBATCH -q) as appropriate. # -# Invoke the script as follows: sbatch $script +# Invoke the script from the command line as follows: ./$script # # Log output is placed in consistency.log. A summary is # placed in summary.log @@ -18,15 +18,6 @@ # #----------------------------------------------------------------------------- -#SBATCH -J snow -#SBATCH -A fv3-cpu -#SBATCH --open-mode=truncate -#SBATCH -o consistency.log -#SBATCH -e consistency.log -#SBATCH --ntasks=1 -#SBATCH -q debug -#SBATCH -t 00:03:00 - set -x compiler=${compiler:-"intel"} @@ -36,8 +27,13 @@ module use ../../modulefiles module load build.$target.$compiler module list -export DATA="${WORK_DIR:-/scratch2/NCEPDEV/stmp1/$LOGNAME}" -export DATA="${DATA}/reg-tests/snow2mdl" +DATA_ROOT="${WORK_DIR:-/scratch2/NCEPDEV/stmp1/$LOGNAME}" +DATA_ROOT="${DATA_ROOT}/reg-tests/snow2mdl" + +rm -fr $DATA_ROOT + +PROJECT_CODE="${PROJECT_CODE:-fv3-cpu}" +QUEUE="${QUEUE:-batch}" #----------------------------------------------------------------------------- # Should not have to change anything below. @@ -50,13 +46,29 @@ if [ "$UPDATE_BASELINE" = "TRUE" ]; then source ../get_hash.sh fi -rm -fr $DATA - export HOMEreg=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/wgrib export WGRIB2=/scratch2/NCEPDEV/nwprod/NCEPLIBS/utils/grib_util.v1.1.1/exec/wgrib2 -./snow2mdl.sh +# The first test mimics GFS OPS. + +export DATA="${DATA_ROOT}/test.ops" +TEST1=$(sbatch --parsable -J snow.ops -A ${PROJECT_CODE} -o consistency.log -e consistency.log \ + --ntasks=1 -q ${QUEUE} -t 00:03:00 ./snow2mdl.ops.sh) + +# The second test is for the new AFWA global GRIB2 data. + +export DATA="${DATA_ROOT}/test.global" +TEST2=$(sbatch --parsable -J snow.global -A ${PROJECT_CODE} -o consistency.log -e consistency.log \ + --ntasks=1 -q ${QUEUE} -t 00:03:00 -d afterok:$TEST1 ./snow2mdl.global.sh) + +# Create summary file. + +sbatch --nodes=1 -t 0:01:00 -A ${PROJECT_CODE} -J snow_summary -o consistency.log -e consistency.log \ + --open-mode=append -q ${QUEUE} -d afterok:$TEST2 << EOF +#!/bin/bash +grep -a '<<<' consistency.log > summary.log +EOF exit 0 diff --git a/reg_tests/snow2mdl/driver.jet.sh b/reg_tests/snow2mdl/driver.jet.sh index cd06cf513..87ab421e5 100755 --- a/reg_tests/snow2mdl/driver.jet.sh +++ b/reg_tests/snow2mdl/driver.jet.sh @@ -2,12 +2,12 @@ #----------------------------------------------------------------------------- # -# Run snow2mdl consistency test on Jet. +# Run snow2mdl consistency tests on Jet. # -# Set $DATA to your working directory. Set the project code (SBATCH -A) -# and queue (SBATCH -q) as appropriate. +# Set $DATA_ROOT to your working directory. Set the project code and +# and queue as appropriate. # -# Invoke the script as follows: sbatch $script +# Invoke the script as follows: ./$script # # Log output is placed in consistency.log. A summary is # placed in summary.log @@ -18,13 +18,6 @@ # #----------------------------------------------------------------------------- -#SBATCH --nodes=1 -#SBATCH --partition=sjet -#SBATCH --time 0:01 -#SBATCH --account=emcda -#SBATCH --job-name=snow2mdl -#SBATCH -o consistency.log -#SBATCH -e consistency.log set -x @@ -33,8 +26,11 @@ module use ../../modulefiles module load build.$target.intel module list -export DATA="${WORK_DIR:-/lfs4/HFIP/emcda/$LOGNAME/stmp}" -export DATA="${DATA}/reg-tests/snow2mdl" +DATA_ROOT="${WORK_DIR:-/lfs4/HFIP/emcda/$LOGNAME/stmp}" +DATA_ROOT="${DATA_ROOT}/reg-tests/snow2mdl" + +PROJECT_CODE="${PROJECT_CODE:-hfv3gfs}" +QUEUE="${QUEUE:-batch}" #----------------------------------------------------------------------------- # Should not have to change anything below. @@ -52,8 +48,25 @@ export HOMEgfs=$PWD/../.. export WGRIB=/apps/wgrib/1.8.1.0b/bin/wgrib export WGRIB2=/apps/wgrib2/0.1.9.6a/bin/wgrib2 -rm -fr $DATA +rm -fr $DATA_ROOT + +# This tests the OPS GFS snow processing. + +export DATA="${DATA_ROOT}/test.ops" +TEST1=$(sbatch --parsable --nodes=1 --partition=xjet --time 0:02 -J snow.ops -o consistency.log \ + -e consistency.log -A $PROJECT_CODE -q $QUEUE ./snow2mdl.ops.sh) -./snow2mdl.sh +# Test the new global afwa grib2 data. +export DATA="${DATA_ROOT}/test.global" +TEST2=$(sbatch --parsable --nodes=1 --partition=xjet --time 0:02 -J snow.global -o consistency.log \ + -e consistency.log -A $PROJECT_CODE -q $QUEUE -d afterok:$TEST1 ./snow2mdl.global.sh) + +# Create summary file. + +sbatch --nodes=1 --partition=xjet -t 0:01:00 -A $PROJECT_CODE -J snow.summary -o consistency.log \ + -e consistency.log --open-mode=append -q $QUEUE -d afterok:$TEST2 << EOF +#!/bin/bash +grep -a '<<<' consistency.log > summary.log +EOF exit 0 diff --git a/reg_tests/snow2mdl/driver.orion.sh b/reg_tests/snow2mdl/driver.orion.sh index 99ad0c14f..4715557cb 100755 --- a/reg_tests/snow2mdl/driver.orion.sh +++ b/reg_tests/snow2mdl/driver.orion.sh @@ -2,31 +2,22 @@ #----------------------------------------------------------------------------- # -# Run snow2mdl consistency test on Orion. +# Run snow2mdl consistency tests on Orion. # -# Set $DATA to your working directory. Set the project code (SBATCH -A) -# and queue (SBATCH -q) as appropriate. +# Set $DATA_ROOT to your working directory. Set the project code +# and queue as appropriate. # -# Invoke the script as follows: sbatch $script +# Invoke the script as follows: ./$script # # Log output is placed in consistency.log. A summary is # placed in summary.log # # The test fails when its output does not match the baseline file -# as determined by the 'cmp' command. The baseline file is +# as determined by the 'cmp' command. The baseline files are # stored in HOMEreg. # #----------------------------------------------------------------------------- -#SBATCH -J snow -#SBATCH -A fv3-cpu -#SBATCH --open-mode=truncate -#SBATCH -o consistency.log -#SBATCH -e consistency.log -#SBATCH --ntasks=1 -#SBATCH -q debug -#SBATCH -t 00:03:00 - set -x source ../../sorc/machine-setup.sh > /dev/null 2>&1 @@ -36,8 +27,11 @@ module list ulimit -s unlimited -export DATA="${WORK_DIR:-/work/noaa/stmp/$LOGNAME}" -export DATA="${DATA}/reg-tests/snow2mdl" +export DATA_ROOT="${WORK_DIR:-/work/noaa/stmp/$LOGNAME}" +export DATA_ROOT="${DATA_ROOT}/reg-tests/snow2mdl" + +PROJECT_CODE="${PROJECT_CODE:-fv3-cpu}" +QUEUE="${QUEUE:-batch}" #----------------------------------------------------------------------------- # Should not have to change anything below. @@ -50,13 +44,32 @@ if [ "$UPDATE_BASELINE" = "TRUE" ]; then source ../get_hash.sh fi -rm -fr $DATA +rm -fr $DATA_ROOT export HOMEreg=/work/noaa/nems/role-nems/ufs_utils/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/wgrib export WGRIB2=/apps/contrib/NCEPLIBS/orion/utils/grib_util.v1.2.0/exec/wgrib2 -./snow2mdl.sh +# The first test mimics GFS OPS. + +export DATA="${DATA_ROOT}/test.ops" +TEST1=$(sbatch --parsable -J snow.ops -A $PROJECT_CODE -o consistency.log \ + -e consistency.log --ntasks=1 -q $QUEUE -t 00:03:00 ./snow2mdl.ops.sh) + +# This tests the afwa global grib2 data. + +export DATA="${DATA_ROOT}/test.global" +TEST2=$(sbatch --parsable -J snow.global -A $PROJECT_CODE -o consistency.log \ + -e consistency.log --ntasks=1 -q $QUEUE -t 00:03:00 --open-mode=append \ + -d afterok:$TEST1 ./snow2mdl.global.sh) + +# Create the summary file. + +sbatch --ntasks=1 -t 0:01:00 -A $PROJECT_CODE -J snow_summary -o consistency.log -e consistency.log \ + --open-mode=append -q $QUEUE -d afterok:$TEST2 << EOF +#!/bin/bash +grep -a '<<<' consistency.log > summary.log +EOF exit 0 diff --git a/reg_tests/snow2mdl/driver.wcoss_cray.sh b/reg_tests/snow2mdl/driver.wcoss_cray.sh index c0dc69509..2b92d4fa5 100755 --- a/reg_tests/snow2mdl/driver.wcoss_cray.sh +++ b/reg_tests/snow2mdl/driver.wcoss_cray.sh @@ -2,30 +2,22 @@ #----------------------------------------------------------------------------- # -# Run snow2mdl consistency test on WCOSS-Cray. +# Run snow2mdl consistency tests on WCOSS-Cray. # -# Set $DATA to your working directory. Set the project code (BSUB -P) -# and queue (BSUB -q) as appropriate. +# Set $DATA_ROOT to your working directory. Set the project code +# and queue as appropriate. # -# Invoke the script as follows: cat $script | bsub +# Invoke the script as follows: ./$script # # Log output is placed in consistency.log. A summary is # placed in summary.log # # The test fails when its output does not match the baseline file -# as determined by the 'cmp' command. The baseline file is +# as determined by the 'cmp' command. The baseline files are # stored in HOMEreg. # #----------------------------------------------------------------------------- -#BSUB -W 0:02 -#BSUB -o consistency.log -#BSUB -e consistency.log -#BSUB -J s2m_regt -#BSUB -q debug -#BSUB -R "rusage[mem=2000]" -#BSUB -P GFS-DEV - set -x source ../../sorc/machine-setup.sh > /dev/null 2>&1 @@ -33,8 +25,8 @@ module use ../../modulefiles module load build.$target.intel module list -export DATA="${WORK_DIR:-/gpfs/hps3/stmp/$LOGNAME}" -export DATA="${DATA}/reg-tests/snow2mdl" +DATA_ROOT="${WORK_DIR:-/gpfs/hps3/stmp/$LOGNAME}" +DATA_ROOT="${DATA_ROOT}/reg-tests/snow2mdl" #----------------------------------------------------------------------------- # Should not have to change anything below. @@ -47,13 +39,34 @@ if [ "$UPDATE_BASELINE" = "TRUE" ]; then source ../get_hash.sh fi +PROJECT_CODE=${PROJECT_CODE:-GFS-DEV} +QUEUE=${QUEUE:-dev} + export HOMEreg=/gpfs/hps3/emc/global/noscrub/George.Gayno/ufs_utils.git/reg_tests/snow2mdl export HOMEgfs=$PWD/../.. export WGRIB=/gpfs/hps/nco/ops/nwprod/grib_util.v1.0.2/exec/wgrib export WGRIB2=/gpfs/hps/nco/ops/nwprod/grib_util.v1.0.2/exec/wgrib2 -rm -fr $DATA +rm -fr $DATA_ROOT + +LOG_FILE="consistency.log" +SUM_FILE="summary.log" + +# Test the ops function of snow2mdl. + +export DATA=$DATA_ROOT/test.ops +bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J snow.ops -W 0:02 \ + -R "rusage[mem=2000]" "$PWD/snow2mdl.ops.sh" + +# Test the afwa global snow data. + +export DATA=$DATA_ROOT/test.global +bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J snow.global -W 0:02 \ + -R "rusage[mem=2000]" -w 'ended(snow.ops)' "$PWD/snow2mdl.global.sh" + +# Create a summary file. -./snow2mdl.sh +bsub -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J summary -R "rusage[mem=100]" -W 0:01 \ + -w 'ended(snow.global)' "grep -a '<<<' $LOG_FILE >> $SUM_FILE" exit 0 diff --git a/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh b/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh index f1e417587..89fd5b4ec 100755 --- a/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh +++ b/reg_tests/snow2mdl/driver.wcoss_dell_p3.sh @@ -2,30 +2,22 @@ #----------------------------------------------------------------------------- # -# Run snow2mdl consistency test on WCOSS-Dell. +# Run snow2mdl consistency tests on WCOSS-Dell. # -# Set $DATA to your working directory. Set the project code (BSUB -P) -# and queue (BSUB -q) as appropriate. +# Set $DATA_ROOT to your working directory. Set the project code +# and queue as appropriate. # -# Invoke the script as follows: cat $script | bsub +# Invoke the script as follows: ./$script # # Log output is placed in consistency.log. A summary is # placed in summary.log # # The test fails when its output does not match the baseline file -# as determined by the 'cmp' command. The baseline file is +# as determined by the 'cmp' command. The baseline files are # stored in HOMEreg. # #----------------------------------------------------------------------------- -#BSUB -W 0:02 -#BSUB -o consistency.log -#BSUB -e consistency.log -#BSUB -J s2m_regt -#BSUB -q debug -#BSUB -R "affinity[core(1)]" -#BSUB -P GFS-DEV - source ../../sorc/machine-setup.sh > /dev/null 2>&1 module use ../../modulefiles module load build.$target.intel @@ -34,8 +26,11 @@ module list set -x -export DATA="${WORK_DIR:-/gpfs/dell1/stmp/$LOGNAME}" -export DATA="${DATA}/reg-tests/snow2mdl" +export DATA_ROOT="${WORK_DIR:-/gpfs/dell1/stmp/$LOGNAME}" +export DATA_ROOT="${DATA_ROOT}/reg-tests/snow2mdl" + +PROJECT_CODE=${PROJECT_CODE:-"GFS-DEV"} +QUEUE=${QUEUE:-"debug"} #----------------------------------------------------------------------------- # Should not have to change anything below. @@ -53,8 +48,20 @@ export HOMEgfs=$PWD/../.. export WGRIB=/gpfs/dell1/nco/ops/nwprod/grib_util.v1.0.6/exec/wgrib export WGRIB2=/gpfs/dell1/nco/ops/nwprod/grib_util.v1.0.6/exec/wgrib2 -rm -fr $DATA +LOG_FILE=consistency.log +SUM_FILE=summary.log + +rm -fr $DATA_ROOT + +export DATA=$DATA_ROOT/test.ops +bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J snow.ops -W 0:02 \ + -R "affinity[core(1)]" "$PWD/snow2mdl.ops.sh" + +export DATA=$DATA_ROOT/test.global +bsub -e $LOG_FILE -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J snow.global -W 0:02 \ + -R "affinity[core(1)]" -w 'ended(snow.ops)' "$PWD/snow2mdl.global.sh" -./snow2mdl.sh +bsub -o $LOG_FILE -q $QUEUE -P $PROJECT_CODE -J summary -R "affinity[core(1)]" -R "rusage[mem=100]" -W 0:01 \ + -w 'ended(snow.global)' "grep -a '<<<' $LOG_FILE >> $SUM_FILE" exit 0 diff --git a/reg_tests/snow2mdl/snow2mdl.global.sh b/reg_tests/snow2mdl/snow2mdl.global.sh new file mode 100755 index 000000000..77b9b934d --- /dev/null +++ b/reg_tests/snow2mdl/snow2mdl.global.sh @@ -0,0 +1,57 @@ +#!/bin/bash + +#-------------------------------------------------------------------------- +# Create a snow file from afwa global data. This script is run from +# its machine-specific driver. +#-------------------------------------------------------------------------- + +set -x + +export IMS_FILE=$HOMEreg/input_data/imssnow96.afwa.global.grb +export AFWA_NH_FILE="" +export AFWA_SH_FILE="" +export AFWA_GLOBAL_FILE="$HOMEreg/input_data/afwa.global.grb2" + +export MODEL_LATITUDE_FILE=$HOMEgfs/fix/fix_am/global_latitudes.t1534.3072.1536.grb +export MODEL_LONGITUDE_FILE=$HOMEgfs/fix/fix_am/global_longitudes.t1534.3072.1536.grb +export MODEL_SLMASK_FILE=$HOMEgfs/fix/fix_am/global_slmask.t1534.3072.1536.grb +export GFS_LONSPERLAT_FILE=$HOMEgfs/fix/fix_am/global_lonsperlat.t1534.3072.1536.txt + +export OMP_NUM_THREADS=1 +export OUTPUT_GRIB2=.false. + +${HOMEgfs}/ush/emcsfc_snow.sh + +iret=$? +if [ $iret -ne 0 ]; then + set +x + echo "<<< SNOW2MDL GLOBAL TEST FAILED. <<<" + exit $iret +fi + +test_failed=0 + +cmp ${DATA}/snogrb_model $HOMEreg/baseline_data/t1534.global/snogrb_model +iret=$? +if [ $iret -ne 0 ]; then + test_failed=1 +fi + +set +x +if [ $test_failed -ne 0 ]; then + echo + echo "*********************************" + echo "<<< SNOW2MDL GLOBAL TEST FAILED. >>>" + echo "*********************************" + if [ "$UPDATE_BASELINE" = "TRUE" ]; then + cd $DATA + $HOMEgfs/reg_tests/update_baseline.sh $HOMEreg "t1534.global" $commit_num + fi +else + echo + echo "*********************************" + echo "<<< SNOW2MDL GLOBAL TEST PASSED. >>>" + echo "*********************************" +fi + +exit diff --git a/reg_tests/snow2mdl/snow2mdl.sh b/reg_tests/snow2mdl/snow2mdl.ops.sh similarity index 71% rename from reg_tests/snow2mdl/snow2mdl.sh rename to reg_tests/snow2mdl/snow2mdl.ops.sh index 4743ad42b..700839a3b 100755 --- a/reg_tests/snow2mdl/snow2mdl.sh +++ b/reg_tests/snow2mdl/snow2mdl.ops.sh @@ -1,7 +1,7 @@ #!/bin/bash #-------------------------------------------------------------------------- -# Create a T1534 snow file. This script is run from its machine-specific +# Mimic GFS OPS. This script is run from its machine-specific # driver. #-------------------------------------------------------------------------- @@ -24,14 +24,13 @@ ${HOMEgfs}/ush/emcsfc_snow.sh iret=$? if [ $iret -ne 0 ]; then set +x - echo "<<< SNOW2MDL TEST FAILED. <<<" - echo "<<< SNOW2MDL TEST FAILED. <<<" > ./summary.log + echo "<<< SNOW2MDL OPS TEST FAILED. <<<" exit $iret fi test_failed=0 -cmp ${DATA}/snogrb_model $HOMEreg/baseline_data/t1534/snogrb_model +cmp ${DATA}/snogrb_model $HOMEreg/baseline_data/t1534.ops/snogrb_model iret=$? if [ $iret -ne 0 ]; then test_failed=1 @@ -41,19 +40,17 @@ set +x if [ $test_failed -ne 0 ]; then echo echo "*********************************" - echo "<<< SNOW2MDL TEST FAILED. >>>" + echo "<<< SNOW2MDL OPS TEST FAILED. >>>" echo "*********************************" - echo "<<< SNOW2MDL TEST FAILED. >>>" > ./summary.log if [ "$UPDATE_BASELINE" = "TRUE" ]; then cd $DATA - $HOMEgfs/reg_tests/update_baseline.sh $HOMEreg "t1534" $commit_num + $HOMEgfs/reg_tests/update_baseline.sh $HOMEreg "t1534.ops" $commit_num fi else echo echo "*********************************" - echo "<<< SNOW2MDL TEST PASSED. >>>" + echo "<<< SNOW2MDL OPS TEST PASSED. >>>" echo "*********************************" - echo "<<< SNOW2MDL TEST PASSED. >>>" > ./summary.log fi exit diff --git a/sorc/emcsfc_snow2mdl.fd/snowdat.F90 b/sorc/emcsfc_snow2mdl.fd/snowdat.F90 index c9f91ee65..7ffe71944 100755 --- a/sorc/emcsfc_snow2mdl.fd/snowdat.F90 +++ b/sorc/emcsfc_snow2mdl.fd/snowdat.F90 @@ -509,7 +509,7 @@ end subroutine readnesdis !> Read snow depth data and masks. !! -!! @note Read nh and sh afwa snow depth data and +!! @note Read afwa snow depth data and !! land sea mask. !! !! program history log: @@ -519,7 +519,7 @@ end subroutine readnesdis !! !! files: !! input: -!! - global afwa data in grib 1 (if selected) +!! - global afwa data in grib 2 (if selected) !! - nh afwa data in grib 1 (if selected) !! - sh afwa data in grib 1 (if selected) !! @@ -529,13 +529,20 @@ end subroutine readnesdis !! !! @author George Gayno org: w/np2 @date 2005-Dec-16 subroutine readafwa + use grib_mod + implicit none - integer, parameter :: iunit=11 + integer, parameter :: iunit=17 integer :: jgds(200), jpds(200), kgds(200), kpds(200) - integer :: istat + integer :: istat, isgrib integer :: lugi, lskip, numbytes, numpts, message_num - integer :: isgrib + integer :: j, k, jdisc, jpdtn, jgdtn + integer :: jpdt(200), jgdt(200), jids(200) + + logical :: unpack + + type(gribfield) :: gfld bad_afwa_nh=.false. bad_afwa_sh=.false. @@ -555,9 +562,13 @@ subroutine readafwa return end if +!----------------------------------------------------------------------- +! If chosen, read global AFWA GRIB2 file. +!----------------------------------------------------------------------- + if ( len_trim(afwa_snow_global_file) > 0 ) then - print*,"- OPEN AND READ AFWA SNOW FILE ", trim(afwa_snow_global_file) + print*,"- OPEN AND READ global AFWA SNOW FILE ", trim(afwa_snow_global_file) call baopenr (iunit, afwa_snow_global_file, istat) if (istat /= 0) then print*,'- FATAL ERROR: BAD OPEN OF FILE, ISTAT IS ', istat @@ -565,48 +576,41 @@ subroutine readafwa call errexit(60) end if -!----------------------------------------------------------------------- -! tell degribber to look for requested data. -!----------------------------------------------------------------------- + call grib2_null(gfld) - lugi = 0 - lskip = -1 - jpds = -1 - jgds = -1 - jpds(5) = 66 ! snow depth - kpds = jpds - kgds = jgds + jdisc = 0 ! Search for discipline; 0 - meteorological products + j = 0 ! Search at beginning of file. + lugi = 0 ! No grib index file. + jids = -9999 ! Identification section, set to wildcard. + jgdt = -9999 ! Grid definition template, set to wildcard. + jgdtn = -1 ! Grid definition template number, set to wildcard. + jpdtn = 0 ! Search for product definition template number 0 - analysis or forecast + jpdt = -9999 ! Product definition template (Sec 4), initialize to wildcard. + jpdt(1) = 1 ! Search for parameter category 1 (Sec 4 oct 10) - + ! moisture. + jpdt(2) = 11 ! Search for parameter 11 (Sec 4 oct 11) - snow depth. + unpack = .true. ! Unpack data. - print*,"- GET GRIB HEADER" - call getgbh(iunit, lugi, lskip, jpds, jgds, numbytes, & - numpts, message_num, kpds, kgds, istat) + call getgb2(iunit, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, & + unpack, k, gfld, istat) if (istat /= 0) then - print*,"- FATAL ERROR: BAD DEGRIB OF HEADER. ISTAT IS ", istat + print*,"- FATAL ERROR: BAD DEGRIB OF GLOBAL DATA. ISTAT IS ", istat call w3tage('SNOW2MDL') call errexit(61) end if - - iafwa = kgds(2) - jafwa = kgds(3) - afwa_res = float(kgds(10))*0.001*111.0 ! in km. - - print*,"- DATA VALID AT (YYMMDDHH): ", kpds(8:11) + + print*,"- DATA VALID AT (YYMMDDHH): ", gfld%idsect(6:9) print*,"- DEGRIB SNOW DEPTH." + call gdt_to_gds(gfld%igdtnum, gfld%igdtmpl, gfld%igdtlen, kgds_afwa_global, & + iafwa, jafwa, afwa_res) + allocate(bitmap_afwa_global(iafwa,jafwa)) allocate(snow_dep_afwa_global(iafwa,jafwa)) - call getgb(iunit, lugi, (iafwa*jafwa), lskip, jpds, jgds, & - numpts, lskip, kpds, kgds, bitmap_afwa_global, snow_dep_afwa_global, istat) - - if (istat /= 0) then - print*,"- FATAL ERROR: BAD DEGRIB OF DATA. ISTAT IS ", istat - call w3tage('SNOW2MDL') - call errexit(61) - end if - - kgds_afwa_global = kgds + snow_dep_afwa_global = reshape(gfld%fld, (/iafwa,jafwa/)) + bitmap_afwa_global = reshape(gfld%bmap, (/iafwa,jafwa/)) call baclose(iunit, istat) @@ -617,10 +621,10 @@ subroutine readafwa use_global_afwa = .false. endif - use_nh_afwa=.false. ! use global or hemispheric files. not both. + use_nh_afwa=.false. ! Use global or hemispheric files. not both. use_sh_afwa=.false. - return ! use global or hemispheric files. not both. + return ! Use global or hemispheric files. not both. else @@ -1008,7 +1012,6 @@ subroutine nh_climo_check(kgds_data,snow_data,bitmap_data,idata,jdata,isrc,bad) print*,"- WARNING: PROBLEM READING GRIB FILE ", iret print*,"- WILL NOT PERFORM QC." deallocate(rlon_data,rlat_data) - deallocate(climo, bitmap_clim) call baclose(lugb,iret) return endif diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 67f3e3e0b..da5cf6e62 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -31,3 +31,4 @@ add_subdirectory(chgres_cube) add_subdirectory(fre-nctools) add_subdirectory(global_cycle) add_subdirectory(sfc_climo_gen) +add_subdirectory(emcsfc_snow2mdl) diff --git a/tests/emcsfc_snow2mdl/CMakeLists.txt b/tests/emcsfc_snow2mdl/CMakeLists.txt new file mode 100644 index 000000000..ae43bf418 --- /dev/null +++ b/tests/emcsfc_snow2mdl/CMakeLists.txt @@ -0,0 +1,21 @@ +# This is the cmake build file for the tests directory of the +# UFS_UTILS project. +# +# George Gayno + +if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -assume byterecl") +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-0 -fdefault-real-8") +endif() + +# Copy necessary test files from the source data directory to the +# build data directory. +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_CURRENT_SOURCE_DIR}/data/config.nml ${CMAKE_CURRENT_BINARY_DIR}/fort.41) +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_CURRENT_SOURCE_DIR}/LSanSuppress.supp ${CMAKE_CURRENT_BINARY_DIR}/LSanSuppress.supp) + +add_executable(ftst_program_setup_snow ftst_program_setup.F90) +target_link_libraries(ftst_program_setup_snow snow2mdl_lib) +add_test(NAME emcsfc_snow2mdl-ftst_program_setup COMMAND ftst_program_setup_snow) diff --git a/tests/emcsfc_snow2mdl/LSanSuppress.supp b/tests/emcsfc_snow2mdl/LSanSuppress.supp new file mode 100644 index 000000000..a1129aaa4 --- /dev/null +++ b/tests/emcsfc_snow2mdl/LSanSuppress.supp @@ -0,0 +1 @@ +leak:g2 diff --git a/tests/emcsfc_snow2mdl/data/config.nml b/tests/emcsfc_snow2mdl/data/config.nml new file mode 100644 index 000000000..922fcb718 --- /dev/null +++ b/tests/emcsfc_snow2mdl/data/config.nml @@ -0,0 +1,34 @@ + &source_data + autosnow_file="autosnow.grb" + nesdis_snow_file="imssnow96.grb" + nesdis_lsmask_file="mask.grb" + afwa_snow_global_file="global_snow.grb" + afwa_snow_nh_file="NPR.SNWN.SP.S1200.MESH16" + afwa_snow_sh_file="NPR.SNWS.SP.S1200.MESH16" + afwa_lsmask_nh_file="afwa_mask.nh.bin" + afwa_lsmask_sh_file="afwa_mask.sh.bin" + / + &qc + climo_qc_file="emcsfc_snow_cover_climo.grib2" + / + &model_specs + model_lat_file="global_latitudes.t1534.3072.1536.grb" + model_lon_file="global_longitudes.t1534.3072.1536.grb" + model_lsmask_file="global_slmask.t1534.3072.1536.grb" + gfs_lpl_file="global_lonsperlat.t1534.3072.1536.txt" + / + &output_data + model_snow_file="snogrb_model" + output_grib2=.false. + / + &output_grib_time + grib_year=2012 + grib_month=10 + grib_day=29 + grib_hour=0 + / + ¶meters + lat_threshold=55.0 + min_snow_depth=0.05 + snow_cvr_threshold=50.0 + / diff --git a/tests/emcsfc_snow2mdl/ftst_program_setup.F90 b/tests/emcsfc_snow2mdl/ftst_program_setup.F90 new file mode 100644 index 000000000..f5660dc6b --- /dev/null +++ b/tests/emcsfc_snow2mdl/ftst_program_setup.F90 @@ -0,0 +1,50 @@ +program ftst_program_setup + +! Unit test for emc_snow2mdl utility, program_setup. +! +! Reads the program namelist and compares each +! variable to expected values. +! +! Author: George Gayno + + use program_setup + + implicit none + + print*, "Starting test of program_setup." + print*, "testing read_setup_namelist with file fort.41..." + + call read_config_nml + + if (trim(autosnow_file) /= "autosnow.grb") stop 2 + if (trim(nesdis_snow_file) /= "imssnow96.grb") stop 3 + if (trim(nesdis_lsmask_file) /= "mask.grb") stop 4 + if (trim(afwa_snow_global_file) /= "global_snow.grb") stop 5 + if (trim(afwa_snow_nh_file) /= "NPR.SNWN.SP.S1200.MESH16") stop 6 + if (trim(afwa_snow_sh_file) /= "NPR.SNWS.SP.S1200.MESH16") stop 7 + if (trim(afwa_lsmask_nh_file) /= "afwa_mask.nh.bin") stop 8 + if (trim(afwa_lsmask_sh_file) /= "afwa_mask.sh.bin") stop 9 + + if (trim(climo_qc_file) /= "emcsfc_snow_cover_climo.grib2") stop 10 + + if (trim(model_lat_file) /= "global_latitudes.t1534.3072.1536.grb") stop 11 + if (trim(model_lon_file) /= "global_longitudes.t1534.3072.1536.grb") stop 12 + if (trim(model_lsmask_file) /= "global_slmask.t1534.3072.1536.grb") stop 13 + if (trim(gfs_lpl_file) /= "global_lonsperlat.t1534.3072.1536.txt") stop 14 + + if (trim(model_snow_file) /= "snogrb_model") stop 15 + if (output_grib2) stop 16 + + if (grib_year /= 12) stop 17 + if (grib_month /= 10) stop 18 + if (grib_day /= 29) stop 19 + if (grib_hour /= 0) stop 20 + + if (lat_threshold /= 55.0) stop 22 + if (min_snow_depth /= 0.05) stop 23 + if (snow_cvr_threshold /= 50.0) stop 24 + + print*, "OK" + print*, "SUCCESS!" + +end program ftst_program_setup diff --git a/ush/emcsfc_snow.sh b/ush/emcsfc_snow.sh index 7c4c6c429..a844cc317 100755 --- a/ush/emcsfc_snow.sh +++ b/ush/emcsfc_snow.sh @@ -24,6 +24,7 @@ # $MODEL_LONGITUDE_FILE - model longitude (grib 1 or 2) # $AFWA_NH_FILE - nh afwa snow data (grib 1) # $AFWA_SH_FILE - sh afwa snow data (grib 1) +# $AFWA_GLOBAL_FILE - global afwa snow data (grib 2) # $IMS_FILE - nh ims snow cover data (grib 2) # $CLIMO_QC - nh climatological snow cover (grib 2) # fort.41 - program configuration namelist @@ -108,6 +109,7 @@ GFS_LONSPERLAT_FILE=${GFS_LONSPERLAT_FILE:-global_lonsperlat.t1534.3072.1536.txt AFWA_NH_FILE=${AFWA_NH_FILE:-"NPR.SNWN.SP.S1200.MESH16"} AFWA_SH_FILE=${AFWA_SH_FILE:-"NPR.SNWS.SP.S1200.MESH16"} +AFWA_GLOBAL_FILE=${AFWA_GLOBAL_FILE:-""} IMS_FILE=${IMS_FILE:-"imssnow96.grb.grib2"} #------------------------------------------------------------------------ @@ -185,7 +187,7 @@ cat > ./fort.41 << ! autosnow_file="" nesdis_snow_file="${IMS_FILE}" nesdis_lsmask_file="" - afwa_snow_global_file="" + afwa_snow_global_file="${AFWA_GLOBAL_FILE}" afwa_snow_nh_file="${AFWA_NH_FILE}" afwa_snow_sh_file="${AFWA_SH_FILE}" afwa_lsmask_nh_file="" From 2fb239cd30bc06e33ef5b9257a78ccf73dfd1f0b Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Wed, 25 May 2022 10:37:28 -0400 Subject: [PATCH 034/109] global_cycle - Link to CCPP version of sfcsub.F (#636) Ensure the global_cycle program is using the same sfcsub.F module as the forecast model. Fixes #424. --- .../workflows/debug-docs-test_coverage.yml | 1 + .github/workflows/intel.yml | 1 + .github/workflows/linux-mac-nceplibs-mpi.yml | 1 + .github/workflows/netcdf-versions.yml | 1 + .gitmodules | 3 + README.md | 4 + ccpp-physics | 1 + sorc/global_cycle.fd/CMakeLists.txt | 2 +- sorc/global_cycle.fd/cycle.f90 | 32 +- sorc/global_cycle.fd/sfcsub.F | 9750 ----------------- 10 files changed, 43 insertions(+), 9753 deletions(-) create mode 100644 .gitmodules create mode 160000 ccpp-physics delete mode 100644 sorc/global_cycle.fd/sfcsub.F diff --git a/.github/workflows/debug-docs-test_coverage.yml b/.github/workflows/debug-docs-test_coverage.yml index 011645c34..9df96f5e4 100644 --- a/.github/workflows/debug-docs-test_coverage.yml +++ b/.github/workflows/debug-docs-test_coverage.yml @@ -88,6 +88,7 @@ jobs: uses: actions/checkout@v2 with: path: ufs_utils + submodules: recursive - name: build run: | diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index cbc79472f..e817a5961 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -154,6 +154,7 @@ jobs: uses: actions/checkout@v2 with: path: ufs_utils + submodules: recursive - name: build run: | diff --git a/.github/workflows/linux-mac-nceplibs-mpi.yml b/.github/workflows/linux-mac-nceplibs-mpi.yml index 205e41a34..0fa9f8d20 100644 --- a/.github/workflows/linux-mac-nceplibs-mpi.yml +++ b/.github/workflows/linux-mac-nceplibs-mpi.yml @@ -205,6 +205,7 @@ jobs: uses: actions/checkout@v2 with: path: ufs_utils + submodules: recursive - name: build run: | diff --git a/.github/workflows/netcdf-versions.yml b/.github/workflows/netcdf-versions.yml index 42eb28417..38940ff10 100644 --- a/.github/workflows/netcdf-versions.yml +++ b/.github/workflows/netcdf-versions.yml @@ -139,6 +139,7 @@ jobs: uses: actions/checkout@v2 with: path: ufs_utils + submodules: recursive - name: build run: | diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..0548a509e --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "ccpp-physics"] + path = ccpp-physics + url = https://github.com/NCAR/ccpp-physics.git diff --git a/README.md b/README.md index 1241c9b6d..ec3d9deb5 100644 --- a/README.md +++ b/README.md @@ -51,6 +51,10 @@ And for the following third party libraries: - [HDF5](https://www.hdfgroup.org/solutions/hdf5/) - [PNG](http://www.libpng.org/pub/png/) +It also uses the following repositories: + + - [NCAR common community physics package](https://github.com/NCAR/ccpp-physics) + ## Installing ``` diff --git a/ccpp-physics b/ccpp-physics new file mode 160000 index 000000000..3405ff171 --- /dev/null +++ b/ccpp-physics @@ -0,0 +1 @@ +Subproject commit 3405ff171d7fa55d6aa7fb45b316146516c6e3ca diff --git a/sorc/global_cycle.fd/CMakeLists.txt b/sorc/global_cycle.fd/CMakeLists.txt index c9e009f20..a6957be7f 100644 --- a/sorc/global_cycle.fd/CMakeLists.txt +++ b/sorc/global_cycle.fd/CMakeLists.txt @@ -6,7 +6,7 @@ set(lib_src machine.f90 num_parthds.f90 - sfcsub.F + ../../ccpp-physics/physics/sfcsub.F read_write_data.f90 utils.F90 land_increments.f90) diff --git a/sorc/global_cycle.fd/cycle.f90 b/sorc/global_cycle.fd/cycle.f90 index 05459f2c1..f126aef4b 100644 --- a/sorc/global_cycle.fd/cycle.f90 +++ b/sorc/global_cycle.fd/cycle.f90 @@ -307,6 +307,7 @@ SUBROUTINE SFCDRV(LUGB, IDIM,JDIM,LSM,LENSFC,LSOIL,DELTSFC, & ZSEA1,ZSEA2,ISOT,IVEGSRC,MYRANK) ! USE READ_WRITE_DATA + use machine USE MPI USE LAND_INCREMENTS, ONLY: ADD_INCREMENT_SOIL, & ADD_INCREMENT_SNOW, & @@ -336,6 +337,9 @@ SUBROUTINE SFCDRV(LUGB, IDIM,JDIM,LSM,LENSFC,LSOIL,DELTSFC, & INTEGER :: I, IERR INTEGER :: I_INDEX(LENSFC), J_INDEX(LENSFC) INTEGER :: IDUM(IDIM,JDIM) + integer :: num_parthds, num_threads + + real(kind=kind_io8) :: min_ice(lensfc) REAL :: SLMASK(LENSFC), OROG(LENSFC) REAL :: SIHFCS(LENSFC), SICFCS(LENSFC) @@ -365,6 +369,7 @@ SUBROUTINE SFCDRV(LUGB, IDIM,JDIM,LSM,LENSFC,LSOIL,DELTSFC, & REAL, ALLOCATABLE :: SLIFCS_FG(:) INTEGER, ALLOCATABLE :: LANDINC_MASK_FG(:), LANDINC_MASK(:) REAL, ALLOCATABLE :: SND_BCK(:), SND_INC(:), SWE_BCK(:) + REAL(KIND=KIND_IO8), ALLOCATABLE :: SLMASKL(:), SLMASKW(:) TYPE(NSST_DATA) :: NSST real, dimension(idim,jdim) :: tf_clm,tf_trd,sal_clm @@ -513,22 +518,45 @@ SUBROUTINE SFCDRV(LUGB, IDIM,JDIM,LSM,LENSFC,LSOIL,DELTSFC, & !-------------------------------------------------------------------------------- ! UPDATE SURFACE FIELDS. +! +! FIRST, SET WATER AND LAND MASKS - SLMASKW/SLMASKL. FOR UNCOUPLED +! (NON-FRACTIONAL) MODE, THESE ARE IDENTICAL TO THE CURRENT +! MASK - '0' WATER; '1' LAND. !-------------------------------------------------------------------------------- IF (DO_SFCCYCLE) THEN + ALLOCATE(SLMASKL(LENSFC), SLMASKW(LENSFC)) +! for running uncoupled (non-fractional grid) + DO I=1,LENSFC + IF(NINT(SLMASK(I)) == 1) THEN + SLMASKL(I) = 1.0_KIND_io8 + SLMASKW(I) = 1.0_KIND_io8 + ELSE + SLMASKL(I) = 0.0_KIND_io8 + SLMASKW(I) = 0.0_KIND_io8 + ENDIF + if(nint(slmask(i)) == 0) then + min_ice(i) = 0.15_KIND_io8 + else + min_ice(i) = 0.0_KIND_io8 + endif + ENDDO + num_threads = num_parthds() PRINT* PRINT*,"CALL SFCCYCLE TO UPDATE SURFACE FIELDS." CALL SFCCYCLE(LUGB,LENSFC,LSOIL,SIG1T,DELTSFC, & IY,IM,ID,IH,FH,RLA,RLO, & - SLMASK,OROG, OROG_UF, USE_UFO, DO_NSST, & + SLMASKL,SLMASKW, OROG, OROG_UF, USE_UFO, DO_NSST, & SIHFCS,SICFCS,SITFCS,SNDFCS,SLCFCS, & VMNFCS,VMXFCS,SLPFCS,ABSFCS, & TSFFCS,SWEFCS,ZORFCS,ALBFCS,TG3FCS, & CNPFCS,SMCFCS,STCFCS,SLIFCS,AISFCS, & VEGFCS,VETFCS,SOTFCS,ALFFCS, & - CVFCS,CVBFCS,CVTFCS,MYRANK,NLUNIT, & + CVFCS,CVBFCS,CVTFCS,MYRANK,num_threads, NLUNIT, & SZ_NML, INPUT_NML_FILE, & + min_ice, & IALB,ISOT,IVEGSRC,TILE_NUM,I_INDEX,J_INDEX) + DEALLOCATE(SLMASKL, SLMASKW) ENDIF !-------------------------------------------------------------------------------- diff --git a/sorc/global_cycle.fd/sfcsub.F b/sorc/global_cycle.fd/sfcsub.F deleted file mode 100644 index cd0604a89..000000000 --- a/sorc/global_cycle.fd/sfcsub.F +++ /dev/null @@ -1,9750 +0,0 @@ -C> @file -C> @brief This is a limited point version of surface program. -C> @author Shrinivas Moorthi Mark Iredell NOAA/EMC - -!> This program runs in two different modes: -!! -!! 1. analysis mode (fh=0.) -!! this program merges climatology, analysis and forecast guess to create -!! new surface fields. if analysis file is given, the program -!! uses it if date of the analysis matches with iy,im,id,ih (see note -!! below). -!! -!! 2. forecast mode (fh.gt.0.) -!! this program interpolates climatology to the date corresponding to the -!! forecast hour. if surface analysis file is given, for the corresponding -!! dates, the program will use it. -!! -!! if the date of the analysis does not match given iy,im,id,ih, (and fh), -!! the program searches an old analysis by going back 6 hours, then 12 hours, -!! then one day upto nrepmx days (parameter statement in the subrotine fixrd. -!! now defined as 8). this allows the user to provide non-daily analysis to -!! be used. if matching field is not found, the forecast guess will be used. -!! -!! use of a combined earlier surface analyses and current analysis is -!! not allowed (as was done in the old version for snow analysis in which -!! old snow analysis is used in combination with initial guess), except -!! for sea surface temperature. for sst anolmaly interpolation, you need to -!! set lanom=.true. and must provide sst analysis at initial time. -!! -!! if you want to do complex merging of past and present surface field analysis, -!! you need to create a separate file that contains daily surface field. -!! -!! for a dead start, do not supply fnbgsi or set fnbgsi=' ' -!! -!! - lugb is the unit number used in this subprogram -!! - len ... number of points on which sfccyc operates -!! - lsoil .. number of soil layers (2 as of april, 1994) -!! - iy,im,id,ih .. year, month, day, and hour of initial state. -!! - fh .. forecast hour -!! - rla, rlo -- latitude and longitudes of the len points -!! - sig1t .. sigma level 1 temperature for dead start. should be on gaussian -!! grid. if not dead start, no need for dimension but set to zero -!! as in the example below. -!! -!! @author M. Iredell, xuli, Hang Lei, George Gayno - module sfccyc_module - implicit none - save -! -! grib code for each parameter - used in subroutines sfccycle and setrmsk. -! - integer kpdtsf !< GRIB1 parameter number of skin temperature/SST. - integer kpdwet !< GRIB1 parameter number of soil wetness. - integer kpdsno !< GRIB1 parameter number of liquid equivalent snow - !! depth. - integer kpdzor !< GRIB1 parameter number of physical snow depth. - integer kpdais !< GRIB1 parameter number of roughness length. - integer kpdtg3 !< GRIB1 parameter number of soil substrate - !! temperature. - integer kpdplr !< GRIB1 parameter number of plant resistance. - integer kpdgla !< GRIB1 parameter number of glacial ice. - integer kpdmxi !< GRIB1 parameter number of maximum ice extent. - integer kpdscv !< GRIB1 parameter number of snow cover. - integer kpdsmc !< GRIB1 parameter number of soil moisture. - integer kpdoro !< GRIB1 parameter number of orography. - integer kpdmsk !< GRIB1 parameter number of land mask. - integer kpdstc !< GRIB1 parameter number of soil temperature. - integer kpdacn !< GRIB1 parameter number of sea ice concentration. - integer kpdveg !< GRIB1 parameter number of vegetation greenness. - integer kpdvet !< GRIB1 parameter number of vegetation type. - integer kpdsot !< GRIB1 parameter number of soil type. - integer kpdvmn !< GRIB1 parameter number of minimum vegetation - !! greenness. - integer kpdvmx !< GRIB1 parameter number of maximum vegetation - !! greenness. - integer kpdslp !< GRIB1 parameter number of slope type. - integer kpdabs !< GRIB1 parameter number of maximum snow albedo. - integer kpdsnd !< GRIB1 parameter number of physical snow depth. - integer kpdabs_0 !< GRIB1 parameter number of legacy maximum snow - !! albedo. - integer kpdabs_1 !< GRIB1 parameter number of modis-based - !! maximum snow albedo. - integer kpdalb(4) !< GRIB1 parameter number of 4-component - !! snow-free albedo. - parameter(kpdtsf=11, kpdwet=86, kpdsno=65, kpdzor=83, -! 1 kpdalb=84, kpdais=91, kpdtg3=11, kpdplr=224, - 1 kpdais=91, kpdtg3=11, kpdplr=224, - 2 kpdgla=238, kpdmxi=91, kpdscv=238, kpdsmc=144, - 3 kpdoro=8, kpdmsk=81, kpdstc=11, kpdacn=91, kpdveg=87, -!cbosu max snow albedo uses a grib id number of 159, not 255. - & kpdvmn=255, kpdvmx=255,kpdslp=236, kpdabs_0=255, - & kpdvet=225, kpdsot=224,kpdabs_1=159, - & kpdsnd=66 ) -! - integer, parameter :: kpdalb_0(4)=(/212,215,213,216/) !< GRIB1 parameter - !! numbers for brigleb - !! snow-free albedo. - integer, parameter :: kpdalb_1(4)=(/189,190,191,192/) !< GRIB1 parameter - !! numbers for modis - !! snow-free albedo. - integer, parameter :: kpdalf(2)=(/214,217/) !< GRIB1 parameter numbers of - !! fraction for strongly/weakly - !! zenith angle dependent albedo. - integer, parameter :: xdata=5000 !< Maximum 'i' dimension of input data. - integer, parameter :: ydata=2500 !< Maximum 'j' dimension of input data. - integer, parameter :: mdata=xdata*ydata !< Maximum number of input data points. - integer :: veg_type_landice !< Vegetation type category at permanent - !! land-ice points. - integer :: soil_type_landice !< Soil type category at permanent - !! land-ice points. - end module sfccyc_module - -!> Surface cycling driver routine. Update 'first guess' surface -!! fields with either analysis or climatological data. -!! -!! @param[in] lugb Fortran unit number used to read data files. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[in] sig1t Sigma level 1 temperature for dead start. -!! @param[in] deltsfc Cycling frequency in hours. -!! @param[in] iy Year of initial state. -!! @param[in] im Month of initial state. -!! @param[in] id Day of initial state. -!! @param[in] ih Hour of initial state. -!! @param[in] fh Forecast hour. -!! @param[in] rla Latitude of model points. -!! @param[in] rlo Longitude of model points. -!! @param[in] slmask Model land-sea mask without ice flag. -!! @param[in] orog Filtered orography on model grid. -!! @param[in] orog_uf Unfiltered orography on model grid. -!! @param[in] use_ufo When true, adjust sst and soil substrate -!! temperature for differences between filtered and unfiltered terrain. -!! @param[in] nst_anl Set to true when using nst model. -!! @param[inout] sihfcs Sea ice thickness on model grid. -!! @param[inout] sicfcs Sea ice concentration on model grid. -!! @param[inout] sitfcs Sea ice skin temperature on model grid. -!! @param[inout] swdfcs Physical snow depth on model grid. -!! @param[inout] slcfcs Liquid portion of volumentric soil moisture on -!! model grid. -!! @param[inout] vmnfcs Minimum greenness fraction of model grid. -!! @param[inout] vmxfcs Maximum greenness fraction of model grid. -!! @param[inout] slpfcs Slope type on model grid. -!! @param[inout] absfcs Maximum snow albedo on model grid. -!! @param[inout] tsffcs Skin temperature/SST on model grid. -!! @param[inout] snofcs Liquid equivalent snow depth on model grid. -!! @param[inout] zorfcs Roughness length on model grid. -!! @param[inout] albfcs Snow-free albedo on model grid. -!! @param[inout] tg3fcs Soil substrate temperature on model grid. -!! @param[inout] cnpfcs Canopy moisture content on model grid. -!! @param[inout] smcfcs Total volumetric soil moisture on model grid. -!! @param[inout] stcfcs Soil/ice depth temperature on model grid. -!! @param[inout] slifcs Model land-sea mask including ice flag. -!! @param[inout] aisfcs Model ice mask. -!! @param[inout] vegfcs Vegetation greenness on model grid. -!! @param[inout] vetfcs Vegetation type on model grid. -!! @param[inout] sotfcs Soil type on model grid. -!! @param[inout] alffcs Fraction for strongly and weakly -!! zenith angle dependent albedo on model grid. -!! @param[inout] cvfcs Convective cloud cover on model grid. -!! @param[inout] cvbfcs Convective cloud base on model grid. -!! @param[inout] cvtfcs Convective cloud top on model grid. -!! @param[in] me MPI task number. -!! @param[in] nlunit Program namelist unit number. -!! @param[in] sz_nml Dimension of input_nml_file. -!! @param[in] input_nml_file Name of program namelist file. -!! @param[in] ialb Use modis albedo when '1'. Use brigleb when '0'. -!! @param[in] isot When '1', use statsgo soil type. When '0' use -!! zobler soil type. -!! @param[in] ivegsrc When '1', use igbp vegetation type. When '2' -!! use sib vegetation type. -!! @param[in] tile_num_ch Model tile number to process. -!! @param[in] i_index The 'i' indices of the model grid to process. -!! @param[in] j_index The 'j' indices of the model grid to process. -!! @author Shrinivas Moorthi - subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc - &, iy,im,id,ih,fh - &, rla, rlo, slmask,orog,orog_uf,use_ufo,nst_anl - &, sihfcs,sicfcs,sitfcs - &, swdfcs,slcfcs - &, vmnfcs,vmxfcs,slpfcs,absfcs - &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs - &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs - &, vegfcs,vetfcs,sotfcs,alffcs - &, cvfcs,cvbfcs,cvtfcs,me,nlunit - &, sz_nml,input_nml_file - &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) -! - use machine , only : kind_io8,kind_io4 - use sfccyc_module - implicit none - character(len=*), intent(in) :: tile_num_ch - integer,intent(in) :: i_index(len), j_index(len) - logical use_ufo, nst_anl - real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse, - & orolmx,orolmn,oroomx,oroomn,orosmx, - & orosmn,oroimx,oroimn,orojmx,orojmn, - & alblmx,alblmn,albomx,albomn,albsmx, - & albsmn,albimx,albimn,albjmx,albjmn, - & wetlmx,wetlmn,wetomx,wetomn,wetsmx, - & wetsmn,wetimx,wetimn,wetjmx,wetjmn, - & snolmx,snolmn,snoomx,snoomn,snosmx, - & snosmn,snoimx,snoimn,snojmx,snojmn, - & zorlmx,zorlmn,zoromx,zoromn,zorsmx, - & zorsmn,zorimx,zorimn,zorjmx, zorjmn, - & plrlmx,plrlmn,plromx,plromn,plrsmx, - & plrsmn,plrimx,plrimn,plrjmx,plrjmn, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx, - & tsfsmn,tsfimx,tsfimn,tsfjmx,tsfjmn, - & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3smx, - & tg3smn,tg3imx,tg3imn,tg3jmx,tg3jmn, - & stclmx,stclmn,stcomx,stcomn,stcsmx, - & stcsmn,stcimx,stcimn,stcjmx,stcjmn, - & smclmx,smclmn,smcomx,smcomn,smcsmx, - & smcsmn,smcimx,smcimn,smcjmx,smcjmn, - & scvlmx,scvlmn,scvomx,scvomn,scvsmx, - & scvsmn,scvimx,scvimn,scvjmx,scvjmn, - & veglmx,veglmn,vegomx,vegomn,vegsmx, - & vegsmn,vegimx,vegimn,vegjmx,vegjmn, - & vetlmx,vetlmn,vetomx,vetomn,vetsmx, - & vetsmn,vetimx,vetimn,vetjmx,vetjmn, - & sotlmx,sotlmn,sotomx,sotomn,sotsmx, - & sotsmn,sotimx,sotimn,sotjmx,sotjmn, - & alslmx,alslmn,alsomx,alsomn,alssmx, - & alssmn,alsimx,alsimn,alsjmx,alsjmn, - & epstsf,epsalb,epssno,epswet,epszor, - & epsplr,epsoro,epssmc,epsscv,eptsfc, - & epstg3,epsais,epsacn,epsveg,epsvet, - & epssot,epsalf,qctsfs,qcsnos,qctsfi, - & aislim,snwmin,snwmax,cplrl,cplrs, - & cvegl,czors,csnol,csnos,czorl,csots, - & csotl,cvwgs,cvetl,cvets,calfs, - & fcalfl,fcalfs,ccvt,ccnp,ccv,ccvb, - & calbl,calfl,calbs,ctsfs,grboro, - & grbmsk,ctsfl,deltf,caisl,caiss, - & fsalfl,fsalfs,flalfs,falbl,ftsfl, - & ftsfs,fzorl,fzors,fplrl,fsnos,faisl, - & faiss,fsnol,bltmsk,falbs,cvegs,percrit, - & deltsfc,critp2,critp3,blnmsk,critp1, - & fcplrl,fcplrs,fczors,fvets,fsotl,fsots, - & fvetl,fplrs,fvegl,fvegs,fcsnol,fcsnos, - & fczorl,fcalbs,fctsfl,fctsfs,fcalbl, - & falfs,falfl,fh,crit,zsca,ztsfc,tem1,tem2 - &, fsihl,fsihs,fsicl,fsics, - & csihl,csihs,csicl,csics,epssih,epssic - &, fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, - & fabsl,fabss,cvmnl,cvmns,cvmxl,cvmxs, - & cslpl,cslps,cabsl,cabss,epsvmn,epsvmx, - & epsslp,epsabs - &, sihlmx,sihlmn,sihomx,sihomn,sihsmx, - & sihsmn,sihimx,sihimn,sihjmx,sihjmn, - & siclmx,siclmn,sicomx,sicomn,sicsmx, - & sicsmn,sicimx,sicimn,sicjmx,sicjmn - &, glacir_hice - &, vmnlmx,vmnlmn,vmnomx,vmnomn,vmnsmx, - & vmnsmn,vmnimx,vmnimn,vmnjmx,vmnjmn, - & vmxlmx,vmxlmn,vmxomx,vmxomn,vmxsmx, - & vmxsmn,vmximx,vmximn,vmxjmx,vmxjmn, - & slplmx,slplmn,slpomx,slpomn,slpsmx, - & slpsmn,slpimx,slpimn,slpjmx,slpjmn, - & abslmx,abslmn,absomx,absomn,abssmx, - & abssmn,absimx,absimn,absjmx,absjmn - &, sihnew - - integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor, - & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg, - & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, - & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, - & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, - & icsnos,irttg3,me,kqcm,nlunit,sz_nml,ialb - &, irtvmn, irtvmx, irtslp, irtabs, isot, ivegsrc - logical gausm, deads, qcmsk, znlst, monclm, monanl, - & monfcs, monmer, mondif, landice - character(len=*), intent(in) :: input_nml_file(sz_nml) - - integer num_parthds -! -! variable naming conventions: -! -! oro .. orography -! alb .. albedo -! wet .. soil wetness as defined for bucket model -! sno .. snow depth -! zor .. surface roughness length -! vet .. vegetation type -! plr .. plant evaporation resistance -! tsf .. surface skin temperature. sea surface temp. over ocean. -! tg3 .. deep soil temperature (at 500cm) -! stc .. soil temperature (lsoil layrs) -! smc .. soil moisture (lsoil layrs) -! scv .. snow cover (not snow depth) -! ais .. sea ice mask (0 or 1) -! acn .. sea ice concentration (fraction) -! gla .. glacier (permanent snow) mask (0 or 1) -! mxi .. maximum sea ice extent (0 or 1) -! msk .. land ocean mask (0=ocean 1=land) -! cnp .. canopy water content -! cv .. convective cloud cover -! cvb .. convective cloud base -! cvt .. convective cloud top -! sli .. land/sea/sea-ice mask. (1/0/2 respectively) -! veg .. vegetation cover -! sot .. soil type -!cwu [+2l] add sih & sic -! sih .. sea ice thickness -! sic .. sea ice concentration -!clu [+6l] add swd,slc,vmn,vmx,slp,abs -! swd .. actual snow depth -! slc .. liquid soil moisture (lsoil layers) -! vmn .. vegetation cover minimum -! vmx .. vegetation cover maximum -! slp .. slope type -! abs .. maximum snow albedo - -! -! definition of land/sea mask. sllnd for land and slsea for sea. -! definition of sea/ice mask. aicice for ice, aicsea for sea. -! tgice=max ice temperature -! rlapse=lapse rate for sst correction due to surface angulation -! - parameter(sllnd =1.0,slsea =0.0) - parameter(aicice=1.0,aicsea=0.0) - parameter(tgice=271.2) - parameter(rlapse=0.65e-2) -! -! max/min of fields for check and replace. -! -! ???lmx .. max over bare land -! ???lmn .. min over bare land -! ???omx .. max over open ocean -! ???omn .. min over open ocean -! ???smx .. max over snow surface (land and sea-ice) -! ???smn .. min over snow surface (land and sea-ice) -! ???imx .. max over bare sea ice -! ???imn .. min over bare sea ice -! ???jmx .. max over snow covered sea ice -! ???jmn .. min over snow covered sea ice -! - parameter(orolmx=8000.,orolmn=-1000.,oroomx=3000.,oroomn=-1000., - & orosmx=8000.,orosmn=-1000.,oroimx=3000.,oroimn=-1000., - & orojmx=3000.,orojmn=-1000.) -! parameter(alblmx=0.80,alblmn=0.06,albomx=0.06,albomn=0.06, -! & albsmx=0.80,albsmn=0.06,albimx=0.80,albimn=0.80, -! & albjmx=0.80,albjmn=0.80) -!cwu [-3l/+9l] change min/max for alb; add min/max for sih & sic -! parameter(alblmx=0.80,alblmn=0.01,albomx=0.01,albomn=0.01, -! & albsmx=0.80,albsmn=0.01,albimx=0.01,albimn=0.01, -! & albjmx=0.01,albjmn=0.01) -! note: the range values for bare land and snow covered land -! (alblmx, alblmn, albsmx, albsmn) are set below -! based on whether the old or new radiation is selected - parameter(albomx=0.06,albomn=0.06, - & albimx=0.80,albimn=0.06, - & albjmx=0.80,albjmn=0.06) - parameter(sihlmx=0.0,sihlmn=0.0,sihomx=5.0,sihomn=0.0, - & sihsmx=5.0,sihsmn=0.0,sihimx=5.0,sihimn=0.10, - & sihjmx=5.0,sihjmn=0.10,glacir_hice=3.0) -!cwu change sicimn & sicjmn Jan 2015 -! parameter(siclmx=0.0,siclmn=0.0,sicomx=1.0,sicomn=0.0, -! & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.50, -! & sicjmx=1.0,sicjmn=0.50) -! -! parameter(sihlmx=0.0,sihlmn=0.0,sihomx=8.0,sihomn=0.0, -! & sihsmx=8.0,sihsmn=0.0,sihimx=8.0,sihimn=0.10, -! & sihjmx=8.0,sihjmn=0.10,glacir_hice=3.0) - parameter(siclmx=0.0,siclmn=0.0,sicomx=1.0,sicomn=0.0, - & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.15, - & sicjmx=1.0,sicjmn=0.15) - - parameter(wetlmx=0.15,wetlmn=0.00,wetomx=0.15,wetomn=0.15, - & wetsmx=0.15,wetsmn=0.15,wetimx=0.15,wetimn=0.15, - & wetjmx=0.15,wetjmn=0.15) - parameter(snolmx=0.0,snolmn=0.0,snoomx=0.0,snoomn=0.0, - & snosmx=55000.,snosmn=0.001,snoimx=0.,snoimn=0.0, - & snojmx=10000.,snojmn=0.01) - parameter(zorlmx=300.,zorlmn=1.0,zoromx=1.0,zoromn=1.e-05, - & zorsmx=300.,zorsmn=1.0,zorimx=1.0,zorimn=1.0, - & zorjmx=1.0,zorjmn=1.0) - parameter(plrlmx=1000.,plrlmn=0.0,plromx=1000.0,plromn=0.0, - & plrsmx=1000.,plrsmn=0.0,plrimx=1000.,plrimn=0.0, - & plrjmx=1000.,plrjmn=0.0) -!clu [-1l/+1l] relax tsfsmx (for noah lsm) - parameter(tsflmx=353.,tsflmn=173.0,tsfomx=313.0,tsfomn=271.2, - & tsfsmx=305.0,tsfsmn=173.0,tsfimx=271.2,tsfimn=173.0, - & tsfjmx=273.16,tsfjmn=173.0) -! parameter(tsflmx=353.,tsflmn=173.0,tsfomx=313.0,tsfomn=271.21, -!* & tsfsmx=273.16,tsfsmn=173.0,tsfimx=271.21,tsfimn=173.0, -! & tsfsmx=305.0,tsfsmn=173.0,tsfimx=271.21,tsfimn=173.0, - parameter(tg3lmx=310.,tg3lmn=200.0,tg3omx=310.0,tg3omn=200.0, - & tg3smx=310.,tg3smn=200.0,tg3imx=310.0,tg3imn=200.0, - & tg3jmx=310.,tg3jmn=200.0) - parameter(stclmx=353.,stclmn=173.0,stcomx=313.0,stcomn=200.0, - & stcsmx=310.,stcsmn=200.0,stcimx=310.0,stcimn=200.0, - & stcjmx=310.,stcjmn=200.0) -!landice mods force a flag value of soil moisture of 1.0 -! at non-land points - parameter(smclmx=0.55,smclmn=0.0,smcomx=1.0,smcomn=1.0, - & smcsmx=0.55,smcsmn=0.0,smcimx=1.0,smcimn=1.0, - & smcjmx=1.0,smcjmn=1.0) - parameter(scvlmx=0.0,scvlmn=0.0,scvomx=0.0,scvomn=0.0, - & scvsmx=1.0,scvsmn=1.0,scvimx=0.0,scvimn=0.0, - & scvjmx=1.0,scvjmn=1.0) - parameter(veglmx=1.0,veglmn=0.0,vegomx=0.0,vegomn=0.0, - & vegsmx=1.0,vegsmn=0.0,vegimx=0.0,vegimn=0.0, - & vegjmx=0.0,vegjmn=0.0) - parameter(vmnlmx=1.0,vmnlmn=0.0,vmnomx=0.0,vmnomn=0.0, - & vmnsmx=1.0,vmnsmn=0.0,vmnimx=0.0,vmnimn=0.0, - & vmnjmx=0.0,vmnjmn=0.0) - parameter(vmxlmx=1.0,vmxlmn=0.0,vmxomx=0.0,vmxomn=0.0, - & vmxsmx=1.0,vmxsmn=0.0,vmximx=0.0,vmximn=0.0, - & vmxjmx=0.0,vmxjmn=0.0) - parameter(slplmx=9.0,slplmn=1.0,slpomx=0.0,slpomn=0.0, - & slpsmx=9.0,slpsmn=1.0,slpimx=0.,slpimn=0., - & slpjmx=0.,slpjmn=0.) -! note: the range values for bare land and snow covered land -! (alblmx, alblmn, albsmx, albsmn) are set below -! based on whether the old or new radiation is selected - parameter(absomx=0.0,absomn=0.0, - & absimx=0.0,absimn=0.0, - & absjmx=0.0,absjmn=0.0) -! vegetation type - parameter(vetlmx=20.,vetlmn=1.0,vetomx=0.0,vetomn=0.0, - & vetsmx=20.,vetsmn=1.0,vetimx=0.,vetimn=0., - & vetjmx=0.,vetjmn=0.) -! soil type - parameter(sotlmx=16.,sotlmn=1.0,sotomx=0.0,sotomn=0.0, - & sotsmx=16.,sotsmn=1.0,sotimx=0.,sotimn=0., - & sotjmx=0.,sotjmn=0.) -! fraction of vegetation for strongly and weakly zeneith angle dependent -! albedo - parameter(alslmx=1.0,alslmn=0.0,alsomx=0.0,alsomn=0.0, - & alssmx=1.0,alssmn=0.0,alsimx=0.0,alsimn=0.0, - & alsjmx=0.0,alsjmn=0.0) -! -! criteria used for monitoring -! - parameter(epstsf=0.01,epsalb=0.001,epssno=0.01, - & epswet=0.01,epszor=0.0000001,epsplr=1.,epsoro=0., - & epssmc=0.0001,epsscv=0.,eptsfc=0.01,epstg3=0.01, - & epsais=0.,epsacn=0.01,epsveg=0.01, - & epssih=0.001,epssic=0.001, - & epsvmn=0.01,epsvmx=0.01,epsabs=0.001,epsslp=0.01, - & epsvet=.01,epssot=.01,epsalf=.001) -! -! quality control of analysis snow and sea ice -! -! qctsfs .. surface temperature above which no snow allowed -! qcsnos .. snow depth above which snow must exist -! qctsfi .. sst above which sea-ice is not allowed -! -!clu relax qctsfs (for noah lsm) -!* parameter(qctsfs=283.16,qcsnos=100.,qctsfi=280.16) -!* parameter(qctsfs=288.16,qcsnos=100.,qctsfi=280.16) - parameter(qctsfs=293.16,qcsnos=100.,qctsfi=280.16) -! -!cwu [-2l] -!* ice concentration for ice limit (55 percent) -! -!* parameter(aislim=0.55) -! -! parameters to obtain snow depth from snow cover and temperature -! -! parameter(snwmin=25.,snwmax=100.) - parameter(snwmin=5.0,snwmax=100.) - real (kind=kind_io8), parameter :: ten=10.0, one=1.0 -! -! coeeficients of blending forecast and interpolated clim -! (or analyzed) fields over sea or land(l) (not for clouds) -! 1.0 = use of forecast -! 0.0 = replace with interpolated analysis -! -! these values are set for analysis mode. -! -! variables land sea -! --------------------------------------------------------- -! surface temperature forecast analysis -! surface temperature forecast forecast (over sea ice) -! albedo analysis analysis -! sea-ice analysis analysis -! snow analysis forecast (over sea ice) -! roughness analysis forecast -! plant resistance analysis analysis -! soil wetness (layer) weighted average analysis -! soil temperature forecast analysis -! canopy waver content forecast forecast -! convective cloud cover forecast forecast -! convective cloud bottm forecast forecast -! convective cloud top forecast forecast -! vegetation cover analysis analysis -! vegetation type analysis analysis -! soil type analysis analysis -! sea-ice thickness forecast forecast -! sea-ice concentration analysis analysis -! vegetation cover min analysis analysis -! vegetation cover max analysis analysis -! max snow albedo analysis analysis -! slope type analysis analysis -! liquid soil wetness analysis-weighted analysis -! actual snow depth analysis-weighted analysis -! -! note: if analysis file is not given, then time interpolated climatology -! is used. if analyiss file is given, it will be used as far as the -! date and time matches. if they do not match, it uses forecast. -! -! critical percentage value for aborting bad points when lgchek=.true. -! - logical lgchek - data lgchek/.true./ - data critp1,critp2,critp3/80.,80.,25./ -! -! integer kpdalb(4), kpdalf(2) -! data kpdalb/212,215,213,216/, kpdalf/214,217/ -! save kpdalb, kpdalf -! -! mask orography and variance on gaussian grid -! - real (kind=kind_io8) slmask(len),orog(len), orog_uf(len) - &, orogd(len) - real (kind=kind_io8) rla(len), rlo(len) -! -! permanent/extremes -! - character*500 fnglac,fnmxic - real (kind=kind_io8), allocatable :: glacir(:),amxice(:),tsfcl0(:) -! -! tsfcl0 is the climatological tsf at fh=0 -! -! climatology surface fields (last character 'c' or 'clm' indicate climatology) -! - character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc, - & fnvegc,fnvetc,fnsotc - &, fnvmnc,fnvmxc,fnslpc,fnabsc, fnalbc2 - real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len), - & zorclm(len), albclm(len,4), aisclm(len), - & tg3clm(len), acnclm(len), cnpclm(len), - & cvclm (len), cvbclm(len), cvtclm(len), - & scvclm(len), tsfcl2(len), vegclm(len), - & vetclm(len), sotclm(len), alfclm(len,2), sliclm(len), - & smcclm(len,lsoil), stcclm(len,lsoil) - &, sihclm(len), sicclm(len) - &, vmnclm(len), vmxclm(len), slpclm(len), absclm(len) -! -! analyzed surface fields (last character 'a' or 'anl' indicate analysis) -! - character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna, - & fnvega,fnveta,fnsota - &, fnvmna,fnvmxa,fnslpa,fnabsa -! - real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & tg3anl(len), acnanl(len), cnpanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & scvanl(len), tsfan2(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2), slianl(len), - & smcanl(len,lsoil), stcanl(len,lsoil) - &, sihanl(len), sicanl(len) - &, vmnanl(len), vmxanl(len), slpanl(len), absanl(len) -! - real (kind=kind_io8) tsfan0(len) ! sea surface temperature analysis at ft=0. -! -! predicted surface fields (last characters 'fcs' indicates forecast) -! - real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), - & zorfcs(len), albfcs(len,4), aisfcs(len), - & tg3fcs(len), acnfcs(len), cnpfcs(len), - & cvfcs (len), cvbfcs(len), cvtfcs(len), - & slifcs(len), vegfcs(len), - & vetfcs(len), sotfcs(len), alffcs(len,2), - & smcfcs(len,lsoil), stcfcs(len,lsoil) - &, sihfcs(len), sicfcs(len), sitfcs(len) - &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len) - &, swdfcs(len), slcfcs(len,lsoil) -! -! ratio of sigma level 1 wind and 10m wind (diagnozed by model and not touched -! in this program). -! - real (kind=kind_io8) f10m (len) - real (kind=kind_io8) fsmcl(25),fsmcs(25),fstcl(25),fstcs(25) - real (kind=kind_io8) fcsmcl(25),fcsmcs(25),fcstcl(25),fcstcs(25) - -!clu [+1l] add swratio (soil moisture liquid-to-total ratio) - real (kind=kind_io8) swratio(len,lsoil) -!clu [+1l] add fixratio (option to adjust slc from smc) - logical fixratio(lsoil) -! - integer icsmcl(25), icsmcs(25), icstcl(25), icstcs(25) -! - real (kind=kind_io8) csmcl(25), csmcs(25) - real (kind=kind_io8) cstcl(25), cstcs(25) -! - real (kind=kind_io8) slmskh(mdata) - character*500 fnmskh - integer kpd7, kpd9 -! - logical icefl1(len), icefl2(len) -! -! input and output surface fields (bges) file names -! -! -! sigma level 1 temperature for dead start -! - real (kind=kind_io8) sig1t(len) -! - character*32 label -! -! = 1 ==> forecast is used -! = 0 ==> analysis (or climatology) is used -! -! output file ... primary surface file for radiation and forecast -! -! rec. 1 label -! rec. 2 date record -! rec. 3 tsf -! rec. 4 soilm(two layers) ----> 4 layers -! rec. 5 snow -! rec. 6 soilt(two layers) ----> 4 layers -! rec. 7 tg3 -! rec. 8 zor -! rec. 9 cv -! rec. 10 cvb -! rec. 11 cvt -! rec. 12 albedo (four types) -! rec. 13 slimsk -! rec. 14 vegetation cover -! rec. 14 plantr -----> skip this record -! rec. 15 f10m -----> canopy -! rec. 16 canopy water content (cnpanl) -----> f10m -! rec. 17 vegetation type -! rec. 18 soil type -! rec. 19 zeneith angle dependent vegetation fraction (two types) -! rec. 20 uustar -! rec. 21 ffmm -! rec. 22 ffhh -!cwu add sih & sic -! rec. 23 sih(one category only) -! rec. 24 sic -!clu [+8l] add prcp, flag, swd, slc, vmn, vmx, slp, abs -! rec. 25 tprcp -! rec. 26 srflag -! rec. 27 swd -! rec. 28 slc (4 layers) -! rec. 29 vmn -! rec. 30 vmx -! rec. 31 slp -! rec. 32 abs - -! -! debug only -! ldebug=.true. creates bges files for climatology and analysis -! lqcbgs=.true. quality controls input bges file before merging (should have been -! qced in the forecast program) -! - logical ldebug,lqcbgs - logical lprnt -! -! debug only -! - character*500 fndclm,fndanl -! - logical lanom - -! - namelist/namsfc/fnglac,fnmxic, - & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc, - & fnvegc,fnvetc,fnsotc,fnalbc2, - & fnvmnc,fnvmxc,fnslpc,fnabsc, - & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna, - & fnvega,fnveta,fnsota, - & fnvmna,fnvmxa,fnslpa,fnabsa, - & fnmskh, - & ldebug,lgchek,lqcbgs,critp1,critp2,critp3, - & fndclm,fndanl, - & lanom, - & ftsfl,ftsfs,falbl,falbs,faisl,faiss,fsnol,fsnos, - & fzorl,fzors,fplrl,fplrs,fsmcl,fsmcs, - & fstcl,fstcs,fvegl,fvegs,fvetl,fvets,fsotl,fsots, - & fctsfl,fctsfs,fcalbl,fcalbs,fcsnol,fcsnos, - & fczorl,fczors,fcplrl,fcplrs,fcsmcl,fcsmcs, - & fcstcl,fcstcs,fsalfl,fsalfs,fcalfl,flalfs, - & fsihl,fsicl,fsihs,fsics,aislim,sihnew, - & fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, - & fabsl,fabss, - & ictsfl,ictsfs,icalbl,icalbs,icsnol,icsnos, - & iczorl,iczors,icplrl,icplrs,icsmcl,icsmcs, - & icstcl,icstcs,icalfl,icalfs, - & gausm, deads, qcmsk, znlst, - & monclm, monanl, monfcs, monmer, mondif, igrdbg, - & blnmsk, bltmsk, landice -! - data gausm/.true./, deads/.false./, blnmsk/0.0/, bltmsk/90.0/ - &, qcmsk/.false./, znlst/.false./, igrdbg/-1/ - &, monclm/.false./, monanl/.false./, monfcs/.false./ - &, monmer/.false./, mondif/.false./, landice/.true./ -! -! defaults file names -! - data fnmskh/'global_slmask.t126.grb'/ - data fnalbc/'global_albedo4.1x1.grb'/ - data fnalbc2/'global_albedo4.1x1.grb'/ - data fntsfc/'global_sstclim.2x2.grb'/ - data fnsotc/'global_soiltype.1x1.grb'/ - data fnvegc/'global_vegfrac.1x1.grb'/ - data fnvetc/'global_vegtype.1x1.grb'/ - data fnglac/'global_glacier.2x2.grb'/ - data fnmxic/'global_maxice.2x2.grb'/ - data fnsnoc/'global_snoclim.1.875.grb'/ - data fnzorc/'global_zorclim.1x1.grb'/ - data fnaisc/'global_iceclim.2x2.grb'/ - data fntg3c/'global_tg3clim.2.6x1.5.grb'/ - data fnsmcc/'global_soilmcpc.1x1.grb'/ -!clu [+4l] add fn()c for vmn, vmx, abs, slp - data fnvmnc/'global_shdmin.0.144x0.144.grb'/ - data fnvmxc/'global_shdmax.0.144x0.144.grb'/ - data fnslpc/'global_slope.1x1.grb'/ - data fnabsc/'global_snoalb.1x1.grb'/ -! - data fnwetc/' '/ - data fnplrc/' '/ - data fnstcc/' '/ - data fnscvc/' '/ - data fnacnc/' '/ -! - data fntsfa/' '/ - data fnweta/' '/ - data fnsnoa/' '/ - data fnzora/' '/ - data fnalba/' '/ - data fnaisa/' '/ - data fnplra/' '/ - data fntg3a/' '/ - data fnsmca/' '/ - data fnstca/' '/ - data fnscva/' '/ - data fnacna/' '/ - data fnvega/' '/ - data fnveta/' '/ - data fnsota/' '/ -!clu [+4l] add fn()a for vmn, vmx, abs, slp - data fnvmna/' '/ - data fnvmxa/' '/ - data fnslpa/' '/ - data fnabsa/' '/ -! - data ldebug/.false./, lqcbgs/.true./ - data fndclm/' '/ - data fndanl/' '/ - data lanom/.false./ -! -! default relaxation time in hours to analysis or climatology - data ftsfl/99999.0/, ftsfs/0.0/ - data falbl/0.0/, falbs/0.0/ - data falfl/0.0/, falfs/0.0/ - data faisl/0.0/, faiss/0.0/ - data fsnol/0.0/, fsnos/99999.0/ - data fzorl/0.0/, fzors/99999.0/ - data fplrl/0.0/, fplrs/0.0/ - data fvetl/0.0/, fvets/99999.0/ - data fsotl/0.0/, fsots/99999.0/ - data fvegl/0.0/, fvegs/99999.0/ -!cwu [+4l] add f()l and f()s for sih, sic and aislim, sihlim - data fsihl/99999.0/, fsihs/99999.0/ -! data fsicl/99999.0/, fsics/99999.0/ - data fsicl/0.0/, fsics/0.0/ -! default ice concentration limit (50%), new ice thickness (20cm) -!cwu change ice concentration limit (15%) Jan 2015 -! data aislim/0.50/, sihnew/0.2/ - data aislim/0.15/, sihnew/0.2/ -!clu [+4l] add f()l and f()s for vmn, vmx, abs, slp - data fvmnl/0.0/, fvmns/99999.0/ - data fvmxl/0.0/, fvmxs/99999.0/ - data fslpl/0.0/, fslps/99999.0/ - data fabsl/0.0/, fabss/99999.0/ -! default relaxation time in hours to climatology if analysis missing - data fctsfl/99999.0/, fctsfs/99999.0/ - data fcalbl/99999.0/, fcalbs/99999.0/ - data fcsnol/99999.0/, fcsnos/99999.0/ - data fczorl/99999.0/, fczors/99999.0/ - data fcplrl/99999.0/, fcplrs/99999.0/ -! default flag to apply climatological annual cycle - data ictsfl/0/, ictsfs/1/ - data icalbl/1/, icalbs/1/ - data icalfl/1/, icalfs/1/ - data icsnol/0/, icsnos/0/ - data iczorl/1/, iczors/0/ - data icplrl/1/, icplrs/0/ -! - data ccnp/1.0/ - data ccv/1.0/, ccvb/1.0/, ccvt/1.0/ -! - data ifp/0/ -! - save ifp,fnglac,fnmxic, - & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, - & fnvetc,fnveta, - & fnsotc,fnsota, -!clu [+2l] add fn()c and fn()a for vmn, vmx, slp, abs - & fnvmnc,fnvmxc,fnabsc,fnslpc, - & fnvmna,fnvmxa,fnabsa,fnslpa, - & ldebug,lgchek,lqcbgs,critp1,critp2,critp3, - & fndclm,fndanl, - & lanom, - & ftsfl,ftsfs,falbl,falbs,faisl,faiss,fsnol,fsnos, - & fzorl,fzors,fplrl,fplrs,fsmcl,fsmcs,falfl,falfs, - & fstcl,fstcs,fvegl,fvegs,fvetl,fvets,fsotl,fsots, - & fctsfl,fctsfs,fcalbl,fcalbs,fcsnol,fcsnos, - & fczorl,fczors,fcplrl,fcplrs,fcsmcl,fcsmcs, - & fcstcl,fcstcs,fcalfl,fcalfs, -!cwu [+1l] add f()l and f()s for sih, sic and aislim, sihnew - & fsihl,fsihs,fsicl,fsics,aislim,sihnew, -!clu [+2l] add f()l and f()s for vmn, vmx, slp, abs - & fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, - & fabsl,fabss, - & ictsfl,ictsfs,icalbl,icalbs,icsnol,icsnos, - & iczorl,iczors,icplrl,icplrs,icsmcl,icsmcs, - & icstcl,icstcs,icalfl,icalfs, - & gausm, deads, qcmsk, - & monclm, monanl, monfcs, monmer, mondif, igrdbg, - & grboro, grbmsk, -! - & ctsfl, ctsfs, calbl, calfl, calbs, calfs, csmcs, - & csnol, csnos, czorl, czors, cplrl, cplrs, cstcl, - & cstcs, cvegl, cvwgs, cvetl, cvets, csotl, csots, - & csmcl -!cwu [+1l] add c()l and c()s for sih, sic - &, csihl, csihs, csicl, csics -!clu [+2l] add c()l and c()s for vmn, vmx, slp, abs - &, cvmnl, cvmns, cvmxl, cvmxs, cslpl, cslps, - & cabsl, cabss - &, imsk, jmsk, slmskh, blnmsk, bltmsk - &, glacir, amxice, tsfcl0 - &, caisl, caiss, cvegs -! - lprnt = .false. - iprnt = 1 -! do i=1,len -! if (ifp .eq. 0 .and. rla(i) .gt. 80.0) print *,' rla=',rla(i) -! *,' rlo=',rlo(i) -! tem1 = abs(rla(i) - 48.75) -! tem2 = abs(rlo(i) - (-68.50)) -! if(tem1 .lt. 0.25 .and. tem2 .lt. 0.50) then -! lprnt = .true. -! iprnt = i -! print *,' lprnt=',lprnt,' iprnt=',iprnt -! print *,' rla(i)=',rla(i),' rlo(i)=',rlo(i) -! endif -! enddo - if (ialb == 1) then - kpdabs = kpdabs_1 - kpdalb = kpdalb_1 - alblmx = .99 - albsmx = .99 - alblmn = .01 - albsmn = .01 - abslmx = 1.0 - abssmx = 1.0 - abssmn = .01 - abslmn = .01 - else - kpdabs = kpdabs_0 - kpdalb = kpdalb_0 - alblmx = .80 - albsmx = .80 - alblmn = .06 - albsmn = .06 - abslmx = .80 - abssmx = .80 - abslmn = .01 - abssmn = .01 - endif - if(ifp.eq.0) then - ifp = 1 - do k=1,lsoil - fsmcl(k) = 99999. - fsmcs(k) = 0. - fstcl(k) = 99999. - fstcs(k) = 0. - enddo -#ifdef INTERNAL_FILE_NML - read(input_nml_file, nml=namsfc) -#else -! print *,' in sfcsub nlunit=',nlunit,' me=',me,' ialb=',ialb - rewind(nlunit) - read (nlunit,namsfc) -#endif -! write(6,namsfc) -! - if (me .eq. 0) then - print *,'ftsfl,falbl,faisl,fsnol,fzorl=', - & ftsfl,falbl,faisl,fsnol,fzorl - print *,'fsmcl=',fsmcl(1:lsoil) - print *,'fstcl=',fstcl(1:lsoil) - print *,'ftsfs,falbs,faiss,fsnos,fzors=', - & ftsfs,falbs,faiss,fsnos,fzors - print *,'fsmcs=',fsmcs(1:lsoil) - print *,'fstcs=',fstcs(1:lsoil) - print *,' aislim=',aislim,' sihnew=',sihnew - print *,' isot=', isot,' ivegsrc=',ivegsrc - endif - - if (ivegsrc == 2) then ! sib - veg_type_landice=13 - else - veg_type_landice=15 - endif - if (isot == 0) then - soil_type_landice=9 - else - soil_type_landice=16 - endif -! - deltf = deltsfc / 24.0 -! - ctsfl=0. !... tsfc over land - if(ftsfl.ge.99999.) ctsfl=1. - if((ftsfl.gt.0.).and.(ftsfl.lt.99999)) ctsfl=exp(-deltf/ftsfl) -! - ctsfs=0. !... tsfc over sea - if(ftsfs.ge.99999.) ctsfs=1. - if((ftsfs.gt.0.).and.(ftsfs.lt.99999)) ctsfs=exp(-deltf/ftsfs) -! - do k=1,lsoil - csmcl(k)=0. !... soilm over land - if(fsmcl(k).ge.99999.) csmcl(k)=1. - if((fsmcl(k).gt.0.).and.(fsmcl(k).lt.99999)) - & csmcl(k)=exp(-deltf/fsmcl(k)) - csmcs(k)=0. !... soilm over sea - if(fsmcs(k).ge.99999.) csmcs(k)=1. - if((fsmcs(k).gt.0.).and.(fsmcs(k).lt.99999)) - & csmcs(k)=exp(-deltf/fsmcs(k)) - enddo -! - calbl=0. !... albedo over land - if(falbl.ge.99999.) calbl=1. - if((falbl.gt.0.).and.(falbl.lt.99999)) calbl=exp(-deltf/falbl) -! - calfl=0. !... fraction field for albedo over land - if(falfl.ge.99999.) calfl=1. - if((falfl.gt.0.).and.(falfl.lt.99999)) calfl=exp(-deltf/falfl) -! - calbs=0. !... albedo over sea - if(falbs.ge.99999.) calbs=1. - if((falbs.gt.0.).and.(falbs.lt.99999)) calbs=exp(-deltf/falbs) -! - calfs=0. !... fraction field for albedo over sea - if(falfs.ge.99999.) calfs=1. - if((falfs.gt.0.).and.(falfs.lt.99999)) calfs=exp(-deltf/falfs) -! - caisl=0. !... sea ice over land - if(faisl.ge.99999.) caisl=1. - if((faisl.gt.0.).and.(faisl.lt.99999)) caisl=1. -! - caiss=0. !... sea ice over sea - if(faiss.ge.99999.) caiss=1. - if((faiss.gt.0.).and.(faiss.lt.99999)) caiss=1. -! - csnol=0. !... snow over land - if(fsnol.ge.99999.) csnol=1. - if((fsnol.gt.0.).and.(fsnol.lt.99999)) csnol=exp(-deltf/fsnol) -! using the same way to bending snow as narr when fsnol is the negative value -! the magnitude of fsnol is the thread to determine the lower and upper bound -! of final swe - if(fsnol.lt.0.)csnol=fsnol -! - csnos=0. !... snow over sea - if(fsnos.ge.99999.) csnos=1. - if((fsnos.gt.0.).and.(fsnos.lt.99999)) csnos=exp(-deltf/fsnos) -! - czorl=0. !... roughness length over land - if(fzorl.ge.99999.) czorl=1. - if((fzorl.gt.0.).and.(fzorl.lt.99999)) czorl=exp(-deltf/fzorl) -! - czors=0. !... roughness length over sea - if(fzors.ge.99999.) czors=1. - if((fzors.gt.0.).and.(fzors.lt.99999)) czors=exp(-deltf/fzors) -! -! cplrl=0. !... plant resistance over land -! if(fplrl.ge.99999.) cplrl=1. -! if((fplrl.gt.0.).and.(fplrl.lt.99999)) cplrl=exp(-deltf/fplrl) -! -! cplrs=0. !... plant resistance over sea -! if(fplrs.ge.99999.) cplrs=1. -! if((fplrs.gt.0.).and.(fplrs.lt.99999)) cplrs=exp(-deltf/fplrs) -! - do k=1,lsoil - cstcl(k)=0. !... soilt over land - if(fstcl(k).ge.99999.) cstcl(k)=1. - if((fstcl(k).gt.0.).and.(fstcl(k).lt.99999)) - & cstcl(k)=exp(-deltf/fstcl(k)) - cstcs(k)=0. !... soilt over sea - if(fstcs(k).ge.99999.) cstcs(k)=1. - if((fstcs(k).gt.0.).and.(fstcs(k).lt.99999)) - & cstcs(k)=exp(-deltf/fstcs(k)) - enddo -! - cvegl=0. !... vegetation fraction over land - if(fvegl.ge.99999.) cvegl=1. - if((fvegl.gt.0.).and.(fvegl.lt.99999)) cvegl=exp(-deltf/fvegl) -! - cvegs=0. !... vegetation fraction over sea - if(fvegs.ge.99999.) cvegs=1. - if((fvegs.gt.0.).and.(fvegs.lt.99999)) cvegs=exp(-deltf/fvegs) -! - cvetl=0. !... vegetation type over land - if(fvetl.ge.99999.) cvetl=1. - if((fvetl.gt.0.).and.(fvetl.lt.99999)) cvetl=exp(-deltf/fvetl) -! - cvets=0. !... vegetation type over sea - if(fvets.ge.99999.) cvets=1. - if((fvets.gt.0.).and.(fvets.lt.99999)) cvets=exp(-deltf/fvets) -! - csotl=0. !... soil type over land - if(fsotl.ge.99999.) csotl=1. - if((fsotl.gt.0.).and.(fsotl.lt.99999)) csotl=exp(-deltf/fsotl) -! - csots=0. !... soil type over sea - if(fsots.ge.99999.) csots=1. - if((fsots.gt.0.).and.(fsots.lt.99999)) csots=exp(-deltf/fsots) - -!cwu [+16l]--------------------------------------------------------------- -! - csihl=0. !... sea ice thickness over land - if(fsihl.ge.99999.) csihl=1. - if((fsihl.gt.0.).and.(fsihl.lt.99999)) csihl=exp(-deltf/fsihl) -! - csihs=0. !... sea ice thickness over sea - if(fsihs.ge.99999.) csihs=1. - if((fsihs.gt.0.).and.(fsihs.lt.99999)) csihs=exp(-deltf/fsihs) -! - csicl=0. !... sea ice concentration over land - if(fsicl.ge.99999.) csicl=1. - if((fsicl.gt.0.).and.(fsicl.lt.99999)) csicl=exp(-deltf/fsicl) -! - csics=0. !... sea ice concentration over sea - if(fsics.ge.99999.) csics=1. - if((fsics.gt.0.).and.(fsics.lt.99999)) csics=exp(-deltf/fsics) - -!clu [+32l]--------------------------------------------------------------- -! - cvmnl=0. !... min veg cover over land - if(fvmnl.ge.99999.) cvmnl=1. - if((fvmnl.gt.0.).and.(fvmnl.lt.99999)) cvmnl=exp(-deltf/fvmnl) -! - cvmns=0. !... min veg cover over sea - if(fvmns.ge.99999.) cvmns=1. - if((fvmns.gt.0.).and.(fvmns.lt.99999)) cvmns=exp(-deltf/fvmns) -! - cvmxl=0. !... max veg cover over land - if(fvmxl.ge.99999.) cvmxl=1. - if((fvmxl.gt.0.).and.(fvmxl.lt.99999)) cvmxl=exp(-deltf/fvmxl) -! - cvmxs=0. !... max veg cover over sea - if(fvmxs.ge.99999.) cvmxs=1. - if((fvmxs.gt.0.).and.(fvmxs.lt.99999)) cvmxs=exp(-deltf/fvmxs) -! - cslpl=0. !... slope type over land - if(fslpl.ge.99999.) cslpl=1. - if((fslpl.gt.0.).and.(fslpl.lt.99999)) cslpl=exp(-deltf/fslpl) -! - cslps=0. !... slope type over sea - if(fslps.ge.99999.) cslps=1. - if((fslps.gt.0.).and.(fslps.lt.99999)) cslps=exp(-deltf/fslps) -! - cabsl=0. !... snow albedo over land - if(fabsl.ge.99999.) cabsl=1. - if((fabsl.gt.0.).and.(fabsl.lt.99999)) cabsl=exp(-deltf/fabsl) -! - cabss=0. !... snow albedo over sea - if(fabss.ge.99999.) cabss=1. - if((fabss.gt.0.).and.(fabss.lt.99999)) cabss=exp(-deltf/fabss) -!clu ---------------------------------------------------------------------- -! -! read a high resolution mask field for use in grib interpolation -! - call hmskrd(lugb,imsk,jmsk,fnmskh, - & kpdmsk,slmskh,gausm,blnmsk,bltmsk,me) -! if (qcmsk) call qcmask(slmskh,sllnd,slsea,imsk,jmsk,rla,rlo) -! - if (me .eq. 0) then - write(6,*) ' ' - write(6,*) ' lugb=',lugb,' len=',len, ' lsoil=',lsoil - write(6,*) 'iy=',iy,' im=',im,' id=',id,' ih=',ih,' fh=',fh - &, ' sig1t(1)=',sig1t(1) - &, ' gausm=',gausm,' blnmsk=',blnmsk,' bltmsk=',bltmsk - write(6,*) ' ' - endif -! -! reading permanent/extreme features (glacier points and maximum ice extent) -! - allocate (tsfcl0(len)) - allocate (glacir(len)) - allocate (amxice(len)) -! -! read glacier -! - kpd9 = -1 - kpd7 = -1 - call fixrdc(lugb,fnglac,kpdgla,kpd7,kpd9,slmask, - & glacir,len,iret - &, imsk, jmsk, slmskh, gausm, blnmsk, bltmsk - &, rla, rlo, me) -! znnt=1. -! call nntprt(glacir,len,znnt) -! -! read maximum ice extent -! - kpd7 = -1 - call fixrdc(lugb,fnmxic,kpdmxi,kpd7,kpd9,slmask, - & amxice,len,iret - &, imsk, jmsk, slmskh, gausm, blnmsk, bltmsk - &, rla, rlo, me) -! znnt=1. -! call nntprt(amxice,len,znnt) -! - crit=0.5 - call rof01(glacir,len,'ge',crit) - call rof01(amxice,len,'ge',crit) -! -! quality control max ice limit based on glacier points -! - call qcmxice(glacir,amxice,len,me) -! - endif ! first time loop finished -! - do i=1,len - sliclm(i) = 1. - snoclm(i) = 0. - icefl1(i) = .true. - enddo -! if(lprnt) print *,' tsffcsin=',tsffcs(iprnt) -! -! read climatology fields -! - if (me .eq. 0) then - write(6,*) '==============' - write(6,*) 'climatology' - write(6,*) '==============' - endif -! - percrit=critp1 -! - call clima(lugb,iy,im,id,ih,fh,len,lsoil,slmask, - & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fnvetc,fnsotc, - & fnvmnc,fnvmxc,fnslpc,fnabsc, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm, - & vetclm,sotclm,alfclm, - & vmnclm,vmxclm,slpclm,absclm, - & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kpdvet,kpdsot,kpdalf,tsfcl0, - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & deltsfc, lanom - &, imsk, jmsk, slmskh, rla, rlo, gausm, blnmsk, bltmsk,me - &, lprnt,iprnt,fnalbc2,ialb,tile_num_ch,i_index,j_index) -! if(lprnt) print *,'tsfclm=',tsfclm(iprnt),' tsfcl2=',tsfcl2(iprnt) -! -! scale surface roughness and albedo to model required units -! - zsca=100. - call scale(zorclm,len,zsca) - zsca=0.01 - call scale(albclm,len,zsca) - call scale(albclm(1,2),len,zsca) - call scale(albclm(1,3),len,zsca) - call scale(albclm(1,4),len,zsca) - call scale(alfclm,len,zsca) - call scale(alfclm(1,2),len,zsca) -!clu [+4l] scale vmn, vmx, abs from percent to fraction - zsca=0.01 - call scale(vmnclm,len,zsca) - call scale(vmxclm,len,zsca) - call scale(absclm,len,zsca) - -! -! set albedo over ocean to albomx -! - call albocn(albclm,slmask,albomx,len) -! -! make sure vegetation type and soil type are non zero over land -! - call landtyp(vetclm,sotclm,slpclm,slmask,len) -! -!cwu [-1l/+1l] -!* ice concentration or ice mask (only ice mask used in the model now) -! ice concentration and ice mask (both are used in the model now) -! - if(fnaisc(1:8).ne.' ') then -!cwu [+5l/-1l] update sihclm, sicclm - do i=1,len - sihclm(i) = 3.0*aisclm(i) - sicclm(i) = aisclm(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicclm(i).ne.1.) then - sicclm(i) = sicimx - sihfcs(i) = glacir_hice - endif - enddo - crit=aislim -!* crit=0.5 - call rof01(aisclm,len,'ge',crit) - elseif(fnacnc(1:8).ne.' ') then -!cwu [+4l] update sihclm, sicclm - do i=1,len - sihclm(i) = 3.0*acnclm(i) - sicclm(i) = acnclm(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicclm(i).ne.1.) then - sicclm(i) = sicimx - sihfcs(i) = glacir_hice - endif - enddo - call rof01(acnclm,len,'ge',aislim) - do i=1,len - aisclm(i) = acnclm(i) - enddo - endif -! -! quality control of sea ice mask -! - call qcsice(aisclm,glacir,amxice,aicice,aicsea,sllnd,slmask, - & rla,rlo,len,me) -! -! set ocean/land/sea-ice mask -! - call setlsi(slmask,aisclm,len,aicice,sliclm) -! if(lprnt) print *,' aisclm=',aisclm(iprnt),' sliclm=' -! *,sliclm(iprnt),' slmask=',slmask(iprnt) -! -! write(6,*) 'sliclm' -! znnt=1. -! call nntprt(sliclm,len,znnt) -! -! quality control of snow -! - call qcsnow(snoclm,slmask,aisclm,glacir,len,snosmx,landice,me) -! - call setzro(snoclm,epssno,len) -! -! snow cover handling (we assume climatological snow depth is available) -! quality control of snow depth (note that snow should be corrected first -! because it influences tsf -! - kqcm=1 - call qcmxmn('snow ',snoclm,sliclm,snoclm,icefl1, - & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, - & snojmx,snojmn,snosmx,snosmn,epssno, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! write(6,*) 'snoclm' -! znnt=1. -! call nntprt(snoclm,len,znnt) -! -! get snow cover from snow depth array -! - if(fnscvc(1:8).eq.' ') then - call getscv(snoclm,scvclm,len) - endif -! -! set tsfc over snow to tsfsmx if greater -! - call snosfc(snoclm,tsfclm,tsfsmx,len,me) -! call snosfc(snoclm,tsfcl2,tsfsmx,len) - -! -! quality control -! - do i=1,len - icefl2(i) = sicclm(i) .gt. 0.99999 - enddo - kqcm=1 - call qcmxmn('tsfc ',tsfclm,sliclm,snoclm,icefl2, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, - & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('tsf2 ',tsfcl2,sliclm,snoclm,icefl2, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, - & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, - & rla,rlo,len,kqcm,percrit,lgchek,me) - do kk = 1, 4 - call qcmxmn('albc ',albclm(1,kk),sliclm,snoclm,icefl1, - & alblmx,alblmn,albomx,albomn,albimx,albimn, - & albjmx,albjmn,albsmx,albsmn,epsalb, - & rla,rlo,len,kqcm,percrit,lgchek,me) - enddo - if(fnwetc(1:8).ne.' ') then - call qcmxmn('wetc ',wetclm,sliclm,snoclm,icefl1, - & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, - & wetjmx,wetjmn,wetsmx,wetsmn,epswet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('zorc ',zorclm,sliclm,snoclm,icefl1, - & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn, - & zorjmx,zorjmn,zorsmx,zorsmn,epszor, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! if(fnplrc(1:8).ne.' ') then -! call qcmxmn('plntc ',plrclm,sliclm,snoclm,icefl1, -! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn, -! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, -! & rla,rlo,len,kqcm,percrit,lgchek,me) -! endif - call qcmxmn('tg3c ',tg3clm,sliclm,snoclm,icefl1, - & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn, - & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! -! get soil temp and moisture (after all the qcs are completed) -! - if(fnsmcc(1:8).eq.' ') then - call getsmc(wetclm,len,lsoil,smcclm,me) - endif - call qcmxmn('smc1c ',smcclm(1,1),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2c ',smcclm(1,2),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcclm(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4c ',smcclm(1,4),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - if(fnstcc(1:8).eq.' ') then - call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) - endif - call qcmxmn('stc1c ',stcclm(1,1),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2c ',stcclm(1,2),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcclm(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4c ',stcclm(1,4),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, - & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, - & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetc ',vetclm,sliclm,snoclm,icefl1, - & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, - & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotc ',sotclm,sliclm,snoclm,icefl1, - & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, - & sotjmx,sotjmn,sotsmx,sotsmn,epssot, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!cwu [+8l] --------------------------------------------------------------- - call qcmxmn('sihc ',sihclm,sliclm,snoclm,icefl1, - & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, - & sihjmx,sihjmn,sihsmx,sihsmn,epssih, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicc ',sicclm,sliclm,snoclm,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+16l] --------------------------------------------------------------- - call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1, - & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, - & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxc ',vmxclm,sliclm,snoclm,icefl1, - & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, - & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpc ',slpclm,sliclm,snoclm,icefl1, - & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, - & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('absc ',absclm,sliclm,snoclm,icefl1, - & abslmx,abslmn,absomx,absomn,absimx,absimn, - & absjmx,absjmn,abssmx,abssmn,epsabs, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu ---------------------------------------------------------------------- -! -! monitoring prints -! - if (monclm) then - if (me .eq. 0) then - print *,' ' - print *,'monitor of time and space interpolated climatology' - print *,' ' -! call count(sliclm,snoclm,len) - print *,' ' - call monitr('tsfclm',tsfclm,sliclm,snoclm,len) - call monitr('albclm',albclm(1,1),sliclm,snoclm,len) - call monitr('albclm',albclm(1,2),sliclm,snoclm,len) - call monitr('albclm',albclm(1,3),sliclm,snoclm,len) - call monitr('albclm',albclm(1,4),sliclm,snoclm,len) - call monitr('aisclm',aisclm,sliclm,snoclm,len) - call monitr('snoclm',snoclm,sliclm,snoclm,len) - call monitr('scvclm',scvclm,sliclm,snoclm,len) - call monitr('smcclm1',smcclm(1,1),sliclm,snoclm,len) - call monitr('smcclm2',smcclm(1,2),sliclm,snoclm,len) - call monitr('stcclm1',stcclm(1,1),sliclm,snoclm,len) - call monitr('stcclm2',stcclm(1,2),sliclm,snoclm,len) -!clu [+4l] add smcclm(3:4) and stcclm(3:4) - if(lsoil.gt.2) then - call monitr('smcclm3',smcclm(1,3),sliclm,snoclm,len) - call monitr('smcclm4',smcclm(1,4),sliclm,snoclm,len) - call monitr('stcclm3',stcclm(1,3),sliclm,snoclm,len) - call monitr('stcclm4',stcclm(1,4),sliclm,snoclm,len) - endif - call monitr('tg3clm',tg3clm,sliclm,snoclm,len) - call monitr('zorclm',zorclm,sliclm,snoclm,len) -! if (gaus) then - call monitr('cvaclm',cvclm ,sliclm,snoclm,len) - call monitr('cvbclm',cvbclm,sliclm,snoclm,len) - call monitr('cvtclm',cvtclm,sliclm,snoclm,len) -! endif - call monitr('sliclm',sliclm,sliclm,snoclm,len) -! call monitr('plrclm',plrclm,sliclm,snoclm,len) - call monitr('orog ',orog ,sliclm,snoclm,len) - call monitr('vegclm',vegclm,sliclm,snoclm,len) - call monitr('vetclm',vetclm,sliclm,snoclm,len) - call monitr('sotclm',sotclm,sliclm,snoclm,len) -!cwu [+2l] add sih, sic - call monitr('sihclm',sihclm,sliclm,snoclm,len) - call monitr('sicclm',sicclm,sliclm,snoclm,len) -!clu [+4l] add vmn, vmx, slp, abs - call monitr('vmnclm',vmnclm,sliclm,snoclm,len) - call monitr('vmxclm',vmxclm,sliclm,snoclm,len) - call monitr('slpclm',slpclm,sliclm,snoclm,len) - call monitr('absclm',absclm,sliclm,snoclm,len) - endif - endif -! -! - if (me .eq. 0) then - write(6,*) '==============' - write(6,*) ' analysis' - write(6,*) '==============' - endif -! -! fill in analysis array with climatology before reading analysis. -! - call filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,scvanl,veganl, - & vetanl,sotanl,alfanl, - & sihanl,sicanl, - & vmnanl,vmxanl,slpanl,absanl, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm, - & vetclm,sotclm,alfclm, - & sihclm,sicclm, - & vmnclm,vmxclm,slpclm,absclm, - & len,lsoil) -! -! reverse scaling to match with grib analysis input -! - zsca=0.01 - call scale(zoranl,len, zsca) - zsca=100. - call scale(albanl,len,zsca) - call scale(albanl(1,2),len,zsca) - call scale(albanl(1,3),len,zsca) - call scale(albanl(1,4),len,zsca) - call scale(alfanl,len,zsca) - call scale(alfanl(1,2),len,zsca) -!clu [+4l] reverse scale for vmn, vmx, abs - zsca=100. - call scale(vmnanl,len,zsca) - call scale(vmxanl,len,zsca) - call scale(absanl,len,zsca) -! - percrit=critp2 -! -! read analysis fields -! - call analy(lugb,iy,im,id,ih,fh,len,lsoil,slmask, - & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, - & fnveta,fnsota, - & fnvmna,fnvmxa,fnslpa,fnabsa, - & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & smcanl,stcanl,slianl,scvanl,acnanl,veganl, - & vetanl,sotanl,alfanl,tsfan0, - & vmnanl,vmxanl,slpanl,absanl, - & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais, - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kpdvet,kpdsot,kpdalf, - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvet,irtsot,irtalf - &, irtvmn,irtvmx,irtslp,irtabs, - & imsk, jmsk, slmskh, rla, rlo, gausm, blnmsk, bltmsk - &, me, lanom) -! if(lprnt) print *,' tsfanl=',tsfanl(iprnt) -! -! scale zor and alb to match forecast model units -! - zsca=100. - call scale(zoranl,len, zsca) - zsca=0.01 - call scale(albanl,len,zsca) - call scale(albanl(1,2),len,zsca) - call scale(albanl(1,3),len,zsca) - call scale(albanl(1,4),len,zsca) - call scale(alfanl,len,zsca) - call scale(alfanl(1,2),len,zsca) -!clu [+4] scale vmn, vmx, abs from percent to fraction - zsca=0.01 - call scale(vmnanl,len,zsca) - call scale(vmxanl,len,zsca) - call scale(absanl,len,zsca) -! -! interpolate climatology but fixing initial anomaly -! - if(fh > 0.0 .and. fntsfa(1:8) /= ' ' .and. lanom) then - call anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len) - endif -! -! if the tsfanl is at sea level, then bring it to the surface using -! unfiltered orography (for lakes). if the analysis is at lake surface -! as in the nst model, then this call should be removed - moorthi 09/23/2011 -! - if (use_ufo .and. .not. nst_anl) then - ztsfc = 0.0 - call tsfcor(tsfanl,orog_uf,slmask,ztsfc,len,rlapse) - endif -! -! ice concentration or ice mask (only ice mask used in the model now) -! - if(fnaisa(1:8).ne.' ') then -!cwu [+5l/-1l] update sihanl, sicanl - do i=1,len - sihanl(i) = 3.0*aisanl(i) - sicanl(i) = aisanl(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicanl(i).ne.1.) then - sicanl(i) = sicimx - sihfcs(i) = glacir_hice - endif - enddo - crit=aislim -!* crit=0.5 - call rof01(aisanl,len,'ge',crit) - elseif(fnacna(1:8).ne.' ') then -!cwu [+17l] update sihanl, sicanl - do i=1,len - sihanl(i) = 3.0*acnanl(i) - sicanl(i) = acnanl(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicanl(i).ne.1.) then - sicanl(i) = sicimx - sihfcs(i) = glacir_hice - endif - enddo - crit=aislim - do i=1,len - if((slianl(i).eq.0.).and.(sicanl(i).ge.crit)) then - slianl(i)=2. -! print *,'cycle - new ice form: fice=',sicanl(i) - else if((slianl(i).ge.2.).and.(sicanl(i).lt.crit)) then - slianl(i)=0. -! print *,'cycle - ice free: fice=',sicanl(i) - else if((slianl(i).eq.1.).and.(sicanl(i).ge.sicimn)) then -! print *,'cycle - land covered by sea-ice: fice=',sicanl(i) - sicanl(i)=0. - endif - enddo -! znnt=10. -! call nntprt(acnanl,len,znnt) -! if(lprnt) print *,' acnanl=',acnanl(iprnt) -! do i=1,len -! if (acnanl(i) .gt. 0.3 .and. aisclm(i) .eq. 1.0 -! & .and. aisfcs(i) .ge. 0.75) acnanl(i) = aislim -! enddo -! if(lprnt) print *,' acnanl=',acnanl(iprnt) - call rof01(acnanl,len,'ge',aislim) - do i=1,len - aisanl(i)=acnanl(i) - enddo - endif -! if(lprnt) print *,' aisanl1=',aisanl(iprnt),' glacir=' -! &,glacir(iprnt),' slmask=',slmask(iprnt) -! - call qcsice(aisanl,glacir,amxice,aicice,aicsea,sllnd,slmask, - & rla,rlo,len,me) -! -! set ocean/land/sea-ice mask -! - call setlsi(slmask,aisanl,len,aicice,slianl) -! if(lprnt) print *,' aisanl=',aisanl(iprnt),' slianl=' -! *,slianl(iprnt),' slmask=',slmask(iprnt) -! -! - do k=1,lsoil - do i=1,len - if (slianl(i) .eq. 0) then - smcanl(i,k) = smcomx - stcanl(i,k) = tsfanl(i) - endif - enddo - enddo - -! write(6,*) 'slianl' -! znnt=1. -! call nntprt(slianl,len,znnt) -!cwu [+8l]---------------------------------------------------------------------- - call qcmxmn('siha ',sihanl,slianl,snoanl,icefl1, - & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, - & sihjmx,sihjmn,sihsmx,sihsmn,epssih, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sica ',sicanl,slianl,snoanl,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! -! set albedo over ocean to albomx -! - call albocn(albanl,slmask,albomx,len) -! -! quality control of snow and sea-ice -! process snow depth or snow cover -! - if(fnsnoa(1:8).ne.' ') then - call setzro(snoanl,epssno,len) - call qcsnow(snoanl,slmask,aisanl,glacir,len,ten,landice,me) - if (.not.landice) then - call snodpth2(glacir,snosmx,snoanl, len, me) - endif - kqcm=1 - call snosfc(snoanl,tsfanl,tsfsmx,len,me) - call qcmxmn('snoa ',snoanl,slianl,snoanl,icefl1, - & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, - & snojmx,snojmn,snosmx,snosmn,epssno, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call getscv(snoanl,scvanl,len) - call qcmxmn('sncva ',scvanl,slianl,snoanl,icefl1, - & scvlmx,scvlmn,scvomx,scvomn,scvimx,scvimn, - & scvjmx,scvjmn,scvsmx,scvsmn,epsscv, - & rla,rlo,len,kqcm,percrit,lgchek,me) - else - crit=0.5 - call rof01(scvanl,len,'ge',crit) - call qcsnow(scvanl,slmask,aisanl,glacir,len,one,landice,me) - call qcmxmn('sncva ',scvanl,slianl,scvanl,icefl1, - & scvlmx,scvlmn,scvomx,scvomn,scvimx,scvimn, - & scvjmx,scvjmn,scvsmx,scvsmn,epsscv, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call snodpth(scvanl,slianl,tsfanl,snoclm, - & glacir,snwmax,snwmin,landice,len,snoanl,me) - call qcsnow(scvanl,slmask,aisanl,glacir,len,snosmx,landice,me) - call snosfc(snoanl,tsfanl,tsfsmx,len,me) - call qcmxmn('snowa ',snoanl,slianl,snoanl,icefl1, - & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, - & snojmx,snojmn,snosmx,snosmn,epssno, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif -! - do i=1,len - icefl2(i) = sicanl(i) .gt. 0.99999 - enddo - call qcmxmn('tsfa ',tsfanl,slianl,snoanl,icefl2, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, - & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, - & rla,rlo,len,kqcm,percrit,lgchek,me) - do kk = 1, 4 - call qcmxmn('alba ',albanl(1,kk),slianl,snoanl,icefl1, - & alblmx,alblmn,albomx,albomn,albimx,albimn, - & albjmx,albjmn,albsmx,albsmn,epsalb, - & rla,rlo,len,kqcm,percrit,lgchek,me) - enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) then - call qcmxmn('weta ',wetanl,slianl,snoanl,icefl1, - & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, - & wetjmx,wetjmn,wetsmx,wetsmn,epswet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('zora ',zoranl,slianl,snoanl,icefl1, - & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn, - & zorjmx,zorjmn,zorsmx,zorsmn,epszor, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! if(fnplrc(1:8).ne.' ' .or. fnplra(1:8).ne.' ' ) then -! call qcmxmn('plna ',plranl,slianl,snoanl,icefl1, -! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn, -! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, -! & rla,rlo,len,kqcm,percrit,lgchek,me) -! endif - call qcmxmn('tg3a ',tg3anl,slianl,snoanl,icefl1, - & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn, - & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! -! get soil temp and moisture -! - if(fnsmca(1:8).eq.' ' .and. fnsmcc(1:8).eq.' ') then - call getsmc(wetanl,len,lsoil,smcanl,me) - endif - call qcmxmn('smc1a ',smcanl(1,1),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2a ',smcanl(1,2),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4a ',smcanl(1,4),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - if(fnstca(1:8).eq.' ') then - call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) - endif - call qcmxmn('stc1a ',stcanl(1,1),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2a ',stcanl(1,2),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4a ',stcanl(1,4),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, - & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, - & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('veta ',vetanl,slianl,snoanl,icefl1, - & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, - & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sota ',sotanl,slianl,snoanl,icefl1, - & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, - & sotjmx,sotjmn,sotsmx,sotsmn,epssot, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+16l]---------------------------------------------------------------------- - call qcmxmn('vmna ',vmnanl,slianl,snoanl,icefl1, - & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, - & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxa ',vmxanl,slianl,snoanl,icefl1, - & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, - & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpa ',slpanl,slianl,snoanl,icefl1, - & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, - & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('absa ',absanl,slianl,snoanl,icefl1, - & abslmx,abslmn,absomx,absomn,absimx,absimn, - & absjmx,absjmn,abssmx,abssmn,epsabs, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu ---------------------------------------------------------------------------- -! -! monitoring prints -! - if (monanl) then - if (me .eq. 0) then - print *,' ' - print *,'monitor of time and space interpolated analysis' - print *,' ' -! call count(slianl,snoanl,len) - print *,' ' - call monitr('tsfanl',tsfanl,slianl,snoanl,len) - call monitr('albanl',albanl,slianl,snoanl,len) - call monitr('aisanl',aisanl,slianl,snoanl,len) - call monitr('snoanl',snoanl,slianl,snoanl,len) - call monitr('scvanl',scvanl,slianl,snoanl,len) - call monitr('smcanl1',smcanl(1,1),slianl,snoanl,len) - call monitr('smcanl2',smcanl(1,2),slianl,snoanl,len) - call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len) - call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len) -!clu [+4l] add smcanl(3:4) and stcanl(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) - endif - call monitr('tg3anl',tg3anl,slianl,snoanl,len) - call monitr('zoranl',zoranl,slianl,snoanl,len) -! if (gaus) then - call monitr('cvaanl',cvanl ,slianl,snoanl,len) - call monitr('cvbanl',cvbanl,slianl,snoanl,len) - call monitr('cvtanl',cvtanl,slianl,snoanl,len) -! endif - call monitr('slianl',slianl,slianl,snoanl,len) -! call monitr('plranl',plranl,slianl,snoanl,len) - call monitr('orog ',orog ,slianl,snoanl,len) - call monitr('veganl',veganl,slianl,snoanl,len) - call monitr('vetanl',vetanl,slianl,snoanl,len) - call monitr('sotanl',sotanl,slianl,snoanl,len) -!cwu [+2l] add sih, sic - call monitr('sihanl',sihanl,slianl,snoanl,len) - call monitr('sicanl',sicanl,slianl,snoanl,len) -!clu [+4l] add vmn, vmx, slp, abs - call monitr('vmnanl',vmnanl,slianl,snoanl,len) - call monitr('vmxanl',vmxanl,slianl,snoanl,len) - call monitr('slpanl',slpanl,slianl,snoanl,len) - call monitr('absanl',absanl,slianl,snoanl,len) - endif - - endif -! -! read in forecast fields if needed -! - if (me .eq. 0) then - write(6,*) '==============' - write(6,*) ' fcst guess' - write(6,*) '==============' - endif -! - percrit=critp2 -! - if(deads) then -! -! fill in guess array with analysis if dead start. -! - percrit=critp3 - if (me .eq. 0) write(6,*) 'this run is dead start run' - call filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, - & tg3fcs,cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, - & vegfcs,vetfcs,sotfcs,alffcs, -!cwu [+1l] add ()fcs for sih, sic - & sihfcs,sicfcs, -!clu [+1l] add ()fcs for vmn, vmx, slp, abs - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsfanl,wetanl,snoanl,zoranl,albanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,aisanl, - & veganl,vetanl,sotanl,alfanl, -!cwu [+1l] add ()anl for sih, sic - & sihanl,sicanl, -!clu [+1l] add ()anl for vmn, vmx, slp, abs - & vmnanl,vmxanl,slpanl,absanl, - & len,lsoil) - if(sig1t(1).ne.0.) then - call usesgt(sig1t,slianl,tg3anl,len,lsoil,tsffcs,stcfcs, - & tsfimx) - do i=1,len - icefl2(i) = sicfcs(i) .gt. 0.99999 - enddo - kqcm=1 - call qcmxmn('tsff ',tsffcs,slifcs,snofcs,icefl2, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, - & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - else - percrit=critp2 -! -! make reverse angulation correction to tsf -! make reverse orography correction to tg3 -! - if (use_ufo) then - orogd = orog - orog_uf -! -! The tiled version of the substrate temperature is properly -! adjusted to the terrain. Only invoke when using the old -! global tg3 grib file. -! - if ( index(fntg3c, "tileX.nc") == 0) then ! global file - ztsfc = 1.0 - call tsfcor(tg3fcs,orogd,slmask,ztsfc,len,-rlapse) - endif - ztsfc = 0. - call tsfcor(tsffcs,orogd,slmask,ztsfc,len,-rlapse) - else - ztsfc = 0. - call tsfcor(tsffcs,orog,slmask,ztsfc,len,-rlapse) - endif - -!clu [+12l] -------------------------------------------------------------- -! -! compute soil moisture liquid-to-total ratio over land -! - do j=1, lsoil - do i=1, len - if(smcfcs(i,j) .ne. 0.) then - swratio(i,j) = slcfcs(i,j)/smcfcs(i,j) - else - swratio(i,j) = -999. - endif - enddo - enddo -!clu ----------------------------------------------------------------------- -! - if(lqcbgs .and. irtacn .eq. 0) then - call qcsli(slianl,slifcs,len,me) - call albocn(albfcs,slmask,albomx,len) - do i=1,len - icefl2(i) = sicfcs(i) .gt. 0.99999 - enddo - kqcm=1 - call qcmxmn('snof ',snofcs,slifcs,snofcs,icefl1, - & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, - & snojmx,snojmn,snosmx,snosmn,epssno, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('tsff ',tsffcs,slifcs,snofcs,icefl2, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, - & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, - & rla,rlo,len,kqcm,percrit,lgchek,me) - do kk = 1, 4 - call qcmxmn('albf ',albfcs(1,kk),slifcs,snofcs,icefl1, - & alblmx,alblmn,albomx,albomn,albimx,albimn, - & albjmx,albjmn,albsmx,albsmn,epsalb, - & rla,rlo,len,kqcm,percrit,lgchek,me) - enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) - & then - call qcmxmn('wetf ',wetfcs,slifcs,snofcs,icefl1, - & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, - & wetjmx,wetjmn,wetsmx,wetsmn,epswet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('zorf ',zorfcs,slifcs,snofcs,icefl1, - & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn, - & zorjmx,zorjmn,zorsmx,zorsmn,epszor, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! if(fnplrc(1:8).ne.' ' .or. fnplra(1:8).ne.' ' ) -! call qcmxmn('plnf ',plrfcs,slifcs,snofcs,icefl1, -! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn, -! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, -! & rla,rlo,len,kqcm,percrit,lgchek,me) -! endif - call qcmxmn('tg3f ',tg3fcs,slifcs,snofcs,icefl1, - & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn, - & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!cwu [+8l] --------------------------------------------------------------- - call qcmxmn('sihf ',sihfcs,slifcs,snofcs,icefl1, - & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, - & sihjmx,sihjmn,sihsmx,sihsmn,epssih, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicf ',sicfcs,slifcs,snofcs,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc1f ',smcfcs(1,1),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2f ',smcfcs(1,2),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3f ',smcfcs(1,3),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4f ',smcfcs(1,4),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3f ',stcfcs(1,3),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4f ',stcfcs(1,4),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, - & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, - & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetf ',vetfcs,slifcs,snofcs,icefl1, - & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, - & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotf ',sotfcs,slifcs,snofcs,icefl1, - & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, - & sotjmx,sotjmn,sotsmx,sotsmn,epssot, - & rla,rlo,len,kqcm,percrit,lgchek,me) - -!clu [+16l] --------------------------------------------------------------- - call qcmxmn('vmnf ',vmnfcs,slifcs,snofcs,icefl1, - & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, - & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxf ',vmxfcs,slifcs,snofcs,icefl1, - & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, - & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpf ',slpfcs,slifcs,snofcs,icefl1, - & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, - & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('absf ',absfcs,slifcs,snofcs,icefl1, - & abslmx,abslmn,absomx,absomn,absimx,absimn, - & absjmx,absjmn,abssmx,abssmn,epsabs, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu ----------------------------------------------------------------------- - endif - endif -! - if (monfcs) then - if (me .eq. 0) then - print *,' ' - print *,'monitor of guess' - print *,' ' -! call count(slifcs,snofcs,len) - print *,' ' - call monitr('tsffcs',tsffcs,slifcs,snofcs,len) - call monitr('albfcs',albfcs,slifcs,snofcs,len) - call monitr('aisfcs',aisfcs,slifcs,snofcs,len) - call monitr('snofcs',snofcs,slifcs,snofcs,len) - call monitr('smcfcs1',smcfcs(1,1),slifcs,snofcs,len) - call monitr('smcfcs2',smcfcs(1,2),slifcs,snofcs,len) - call monitr('stcfcs1',stcfcs(1,1),slifcs,snofcs,len) - call monitr('stcfcs2',stcfcs(1,2),slifcs,snofcs,len) -!clu [+4l] add smcfcs(3:4) and stcfcs(3:4) - if(lsoil.gt.2) then - call monitr('smcfcs3',smcfcs(1,3),slifcs,snofcs,len) - call monitr('smcfcs4',smcfcs(1,4),slifcs,snofcs,len) - call monitr('stcfcs3',stcfcs(1,3),slifcs,snofcs,len) - call monitr('stcfcs4',stcfcs(1,4),slifcs,snofcs,len) - endif - call monitr('tg3fcs',tg3fcs,slifcs,snofcs,len) - call monitr('zorfcs',zorfcs,slifcs,snofcs,len) -! if (gaus) then - call monitr('cvafcs',cvfcs ,slifcs,snofcs,len) - call monitr('cvbfcs',cvbfcs,slifcs,snofcs,len) - call monitr('cvtfcs',cvtfcs,slifcs,snofcs,len) -! endif - call monitr('slifcs',slifcs,slifcs,snofcs,len) -! call monitr('plrfcs',plrfcs,slifcs,snofcs,len) - call monitr('orog ',orog ,slifcs,snofcs,len) - call monitr('vegfcs',vegfcs,slifcs,snofcs,len) - call monitr('vetfcs',vetfcs,slifcs,snofcs,len) - call monitr('sotfcs',sotfcs,slifcs,snofcs,len) -!cwu [+2l] add sih, sic - call monitr('sihfcs',sihfcs,slifcs,snofcs,len) - call monitr('sicfcs',sicfcs,slifcs,snofcs,len) -!clu [+4l] add vmn, vmx, slp, abs - call monitr('vmnfcs',vmnfcs,slifcs,snofcs,len) - call monitr('vmxfcs',vmxfcs,slifcs,snofcs,len) - call monitr('slpfcs',slpfcs,slifcs,snofcs,len) - call monitr('absfcs',absfcs,slifcs,snofcs,len) - endif - endif -! -!... update annual cycle in the sst guess.. -! -! if(lprnt) print *,'tsfclm=',tsfclm(iprnt),' tsfcl2=',tsfcl2(iprnt) -! *,' tsffcs=',tsffcs(iprnt),' slianl=',slianl(iprnt) - - if (fh-deltsfc > -0.001 ) then - do i=1,len - if(slianl(i) == 0.0) then - tsffcs(i) = tsffcs(i) + (tsfclm(i) - tsfcl2(i)) - endif - enddo - endif -! -! quality control analysis using forecast guess -! - call qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi,len,lsoil, - & snoanl,aisanl,slianl,tsfanl,albanl, - & zoranl,smcanl, - & smcclm,tsfsmx,albomx,zoromx,me) -! -! blend climatology and predicted fields -! - if(me .eq. 0) then - write(6,*) '==============' - write(6,*) ' merging' - write(6,*) '==============' - endif -! if(lprnt) print *,' tsffcs=',tsffcs(iprnt) -! - percrit=critp3 -! -! merge analysis and forecast. note tg3, ais are not merged -! - call merge(len,lsoil,iy,im,id,ih,fh,deltsfc, - & sihfcs,sicfcs, - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs, - & cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs, - & vetfcs,sotfcs,alffcs, - & sihanl,sicanl, - & vmnanl,vmxanl,slpanl,absanl, - & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl, - & cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,veganl, - & vetanl,sotanl,alfanl, - & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl, - & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs, - & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots, - & calfl,calfs, - & csihl,csihs,csicl,csics, - & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvmn,irtvmx,irtslp,irtabs, - & irtvet,irtsot,irtalf,landice,me) - - call setzro(snoanl,epssno,len) - -! if(lprnt) print *,' tanlm=',tsfanl(iprnt),' tfcsm=',tsffcs(iprnt) -! if(lprnt) print *,' sliam=',slianl(iprnt),' slifm=',slifcs(iprnt) - -! -! new ice/melted ice -! - call newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, -!cwu [+1l] add sihnew, aislim, sihanl & sicanl - & sihnew,aislim,sihanl,sicanl, - & albanl,snoanl,zoranl,smcanl,stcanl, - & albomx,snoomx,zoromx,smcomx,smcimx, -!cwu [-1l/+1l] change albimx to albimn - note albimx & albimn have been modified -! & tsfomn,tsfimx,albimx,zorimx,tgice, - & tsfomn,tsfimx,albimn,zorimx,tgice, - & rla,rlo,me) - -! if(lprnt) print *,'tsfanl=',tsfanl(iprnt),' tsffcs=',tsffcs(iprnt) -! if(lprnt) print *,' slian=',slianl(iprnt),' slifn=',slifcs(iprnt) -! -! set tsfc to tsnow over snow -! - call snosfc(snoanl,tsfanl,tsfsmx,len,me) -! - do i=1,len - icefl2(i) = sicanl(i) .gt. 0.99999 - enddo - kqcm=0 - call qcmxmn('snowm ',snoanl,slianl,snoanl,icefl1, - & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, - & snojmx,snojmn,snosmx,snosmn,epssno, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('tsfm ',tsfanl,slianl,snoanl,icefl2, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, - & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, - & rla,rlo,len,kqcm,percrit,lgchek,me) - do kk = 1, 4 - call qcmxmn('albm ',albanl(1,kk),slianl,snoanl,icefl1, - & alblmx,alblmn,albomx,albomn,albimx,albimn, - & albjmx,albjmn,albsmx,albsmn,epsalb, - & rla,rlo,len,kqcm,percrit,lgchek,me) - enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) - & then - call qcmxmn('wetm ',wetanl,slianl,snoanl,icefl1, - & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, - & wetjmx,wetjmn,wetsmx,wetsmn,epswet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('zorm ',zoranl,slianl,snoanl,icefl1, - & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn, - & zorjmx,zorjmn,zorsmx,zorsmn,epszor, - & rla,rlo,len,kqcm,percrit,lgchek,me) -! if(fnplrc(1:8).ne.' ' .or. fnplra(1:8).ne.' ' ) -! & then -! call qcmxmn('plntm ',plranl,slianl,snoanl,icefl1, -! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn, -! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, -! & rla,rlo,len,kqcm,percrit,lgchek,me) -! endif - call qcmxmn('stc1m ',stcanl(1,1),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2m ',stcanl(1,2),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4m ',stcanl(1,4),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('smc1m ',smcanl(1,1),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2m ',smcanl(1,2),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4m ',smcanl(1,4),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - kqcm=1 - call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, - & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, - & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetm ',vetanl,slianl,snoanl,icefl1, - & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, - & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotm ',sotanl,slianl,snoanl,icefl1, - & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, - & sotjmx,sotjmn,sotsmx,sotsmn,epssot, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!cwu [+8l] add sih, sic, - call qcmxmn('sihm ',sihanl,slianl,snoanl,icefl1, - & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, - & sihjmx,sihjmn,sihsmx,sihsmn,epssih, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicm ',sicanl,slianl,snoanl,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+16l] add vmn, vmx, slp, abs - call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1, - & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, - & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxm ',vmxanl,slianl,snoanl,icefl1, - & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, - & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpm ',slpanl,slianl,snoanl,icefl1, - & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, - & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('absm ',absanl,slianl,snoanl,icefl1, - & abslmx,abslmn,absomx,absomn,absimx,absimn, - & absjmx,absjmn,abssmx,abssmn,epsabs, - & rla,rlo,len,kqcm,percrit,lgchek,me) - -! - if(me .eq. 0) then - write(6,*) '==============' - write(6,*) 'final results' - write(6,*) '==============' - endif -! -! foreward correction to tg3 and tsf at the last stage -! -! if(lprnt) print *,' tsfbc=',tsfanl(iprnt) - if (use_ufo) then -! -! The tiled version of the substrate temperature is properly -! adjusted to the terrain. Only invoke when using the old -! global tg3 grib file. -! - if ( index(fntg3c, "tileX.nc") == 0) then ! global file - ztsfc = 1. - call tsfcor(tg3anl,orogd,slmask,ztsfc,len,rlapse) - endif - ztsfc = 0. - call tsfcor(tsfanl,orogd,slmask,ztsfc,len,rlapse) - else - ztsfc = 0. - call tsfcor(tsfanl,orog,slmask,ztsfc,len,rlapse) - endif -! if(lprnt) print *,' tsfaf=',tsfanl(iprnt) -! -! check the final merged product -! - if (monmer) then - if(me .eq. 0) then - print *,' ' - print *,'monitor of updated surface fields' - print *,' (includes angulation correction)' - print *,' ' -! call count(slianl,snoanl,len) - print *,' ' - call monitr('tsfanl',tsfanl,slianl,snoanl,len) - call monitr('albanl',albanl,slianl,snoanl,len) - call monitr('aisanl',aisanl,slianl,snoanl,len) - call monitr('snoanl',snoanl,slianl,snoanl,len) - call monitr('smcanl1',smcanl(1,1),slianl,snoanl,len) - call monitr('smcanl2',smcanl(1,2),slianl,snoanl,len) - call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len) - call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len) -!clu [+4l] add smcanl(3:4) and stcanl(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) - call monitr('tg3anl',tg3anl,slianl,snoanl,len) - call monitr('zoranl',zoranl,slianl,snoanl,len) - endif -! if (gaus) then - call monitr('cvaanl',cvanl ,slianl,snoanl,len) - call monitr('cvbanl',cvbanl,slianl,snoanl,len) - call monitr('cvtanl',cvtanl,slianl,snoanl,len) -! endif - call monitr('slianl',slianl,slianl,snoanl,len) -! call monitr('plranl',plranl,slianl,snoanl,len) - call monitr('orog ',orog ,slianl,snoanl,len) - call monitr('cnpanl',cnpanl,slianl,snoanl,len) - call monitr('veganl',veganl,slianl,snoanl,len) - call monitr('vetanl',vetanl,slianl,snoanl,len) - call monitr('sotanl',sotanl,slianl,snoanl,len) -!cwu [+2l] add sih, sic, - call monitr('sihanl',sihanl,slianl,snoanl,len) - call monitr('sicanl',sicanl,slianl,snoanl,len) -!clu [+4l] add vmn, vmx, slp, abs - call monitr('vmnanl',vmnanl,slianl,snoanl,len) - call monitr('vmxanl',vmxanl,slianl,snoanl,len) - call monitr('slpanl',slpanl,slianl,snoanl,len) - call monitr('absanl',absanl,slianl,snoanl,len) - endif - endif -! - if (mondif) then - do i=1,len - tsffcs(i) = tsfanl(i) - tsffcs(i) - snofcs(i) = snoanl(i) - snofcs(i) - tg3fcs(i) = tg3anl(i) - tg3fcs(i) - zorfcs(i) = zoranl(i) - zorfcs(i) -! plrfcs(i) = plranl(i) - plrfcs(i) -! albfcs(i) = albanl(i) - albfcs(i) - slifcs(i) = slianl(i) - slifcs(i) - aisfcs(i) = aisanl(i) - aisfcs(i) - cnpfcs(i) = cnpanl(i) - cnpfcs(i) - vegfcs(i) = veganl(i) - vegfcs(i) - vetfcs(i) = vetanl(i) - vetfcs(i) - sotfcs(i) = sotanl(i) - sotfcs(i) -!clu [+2l] add sih, sic - sihfcs(i) = sihanl(i) - sihfcs(i) - sicfcs(i) = sicanl(i) - sicfcs(i) -!clu [+4l] add vmn, vmx, slp, abs - vmnfcs(i) = vmnanl(i) - vmnfcs(i) - vmxfcs(i) = vmxanl(i) - vmxfcs(i) - slpfcs(i) = slpanl(i) - slpfcs(i) - absfcs(i) = absanl(i) - absfcs(i) - enddo - do j = 1,lsoil - do i = 1,len - smcfcs(i,j) = smcanl(i,j) - smcfcs(i,j) - stcfcs(i,j) = stcanl(i,j) - stcfcs(i,j) - enddo - enddo - do j = 1,4 - do i = 1,len - albfcs(i,j) = albanl(i,j) - albfcs(i,j) - enddo - enddo -! -! monitoring prints -! - if(me .eq. 0) then - print *,' ' - print *,'monitor of difference' - print *,' (includes angulation correction)' - print *,' ' - call monitr('tsfdif',tsffcs,slianl,snoanl,len) - call monitr('albdif',albfcs,slianl,snoanl,len) - call monitr('albdif1',albfcs,slianl,snoanl,len) - call monitr('albdif2',albfcs(1,2),slianl,snoanl,len) - call monitr('albdif3',albfcs(1,3),slianl,snoanl,len) - call monitr('albdif4',albfcs(1,4),slianl,snoanl,len) - call monitr('aisdif',aisfcs,slianl,snoanl,len) - call monitr('snodif',snofcs,slianl,snoanl,len) - call monitr('smcanl1',smcfcs(1,1),slianl,snoanl,len) - call monitr('smcanl2',smcfcs(1,2),slianl,snoanl,len) - call monitr('stcanl1',stcfcs(1,1),slianl,snoanl,len) - call monitr('stcanl2',stcfcs(1,2),slianl,snoanl,len) -!clu [+4l] add smcfcs(3:4) and stc(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcfcs(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcfcs(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcfcs(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcfcs(1,4),slianl,snoanl,len) - endif - call monitr('tg3dif',tg3fcs,slianl,snoanl,len) - call monitr('zordif',zorfcs,slianl,snoanl,len) -! if (gaus) then - call monitr('cvadif',cvfcs ,slianl,snoanl,len) - call monitr('cvbdif',cvbfcs,slianl,snoanl,len) - call monitr('cvtdif',cvtfcs,slianl,snoanl,len) -! endif - call monitr('slidif',slifcs,slianl,snoanl,len) -! call monitr('plrdif',plrfcs,slianl,snoanl,len) - call monitr('cnpdif',cnpfcs,slianl,snoanl,len) - call monitr('vegdif',vegfcs,slianl,snoanl,len) - call monitr('vetdif',vetfcs,slianl,snoanl,len) - call monitr('sotdif',sotfcs,slianl,snoanl,len) -!cwu [+2l] add sih, sic - call monitr('sihdif',sihfcs,slianl,snoanl,len) - call monitr('sicdif',sicfcs,slianl,snoanl,len) -!clu [+4l] add vmn, vmx, slp, abs - call monitr('vmndif',vmnfcs,slianl,snoanl,len) - call monitr('vmxdif',vmxfcs,slianl,snoanl,len) - call monitr('slpdif',slpfcs,slianl,snoanl,len) - call monitr('absdif',absfcs,slianl,snoanl,len) - endif - endif -! -! - do i=1,len - tsffcs(i) = tsfanl(i) - snofcs(i) = snoanl(i) - tg3fcs(i) = tg3anl(i) - zorfcs(i) = zoranl(i) -! plrfcs(i) = plranl(i) -! albfcs(i) = albanl(i) - slifcs(i) = slianl(i) - aisfcs(i) = aisanl(i) - cvfcs(i) = cvanl(i) - cvbfcs(i) = cvbanl(i) - cvtfcs(i) = cvtanl(i) - cnpfcs(i) = cnpanl(i) - vegfcs(i) = veganl(i) - vetfcs(i) = vetanl(i) - sotfcs(i) = sotanl(i) -!clu [+4l] add vmn, vmx, slp, abs - vmnfcs(i) = vmnanl(i) - vmxfcs(i) = vmxanl(i) - slpfcs(i) = slpanl(i) - absfcs(i) = absanl(i) - enddo - do j = 1,lsoil - do i = 1,len - smcfcs(i,j) = smcanl(i,j) - if (slifcs(i) .gt. 0.0) then - stcfcs(i,j) = stcanl(i,j) - else - stcfcs(i,j) = tsffcs(i) - endif - enddo - enddo - do j = 1,4 - do i = 1,len - albfcs(i,j) = albanl(i,j) - enddo - enddo - do j = 1,2 - do i = 1,len - alffcs(i,j) = alfanl(i,j) - enddo - enddo - -!cwu [+20l] update sihfcs, sicfcs. remove sea ice over non-ice points - crit=aislim - do i=1,len - sihfcs(i) = sihanl(i) - sitfcs(i) = tsffcs(i) - if (slifcs(i).ge.2.) then - if (sicfcs(i).gt.crit) then - tsffcs(i) = (sicanl(i)*tsffcs(i) - & + (sicfcs(i)-sicanl(i))*tgice)/sicfcs(i) - sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) / sicfcs(i) - else - tsffcs(i) = tsfanl(i) -! tsffcs(i) = tgice - sihfcs(i) = sihnew - endif - endif - sicfcs(i) = sicanl(i) - enddo - do i=1,len - if (slifcs(i).lt.1.5) then - sihfcs(i) = 0. - sicfcs(i) = 0. - sitfcs(i) = tsffcs(i) - else if ((slifcs(i).ge.1.5).and.(sicfcs(i).lt.crit)) then - print *,'warning: check, slifcs and sicfcs', - & slifcs(i),sicfcs(i) - endif - enddo - -! -! ensure the consistency between slc and smc -! - do k=1, lsoil - fixratio(k) = .false. - if (fsmcl(k).lt.99999.) fixratio(k) = .true. - enddo - - if(me .eq. 0) then - print *,'dbgx --fixratio:',(fixratio(k),k=1,lsoil) - endif - - do k=1, lsoil - if(fixratio(k)) then - do i = 1, len - if(swratio(i,k) .eq. -999.) then - slcfcs(i,k) = smcfcs(i,k) - else - slcfcs(i,k) = swratio(i,k) * smcfcs(i,k) - endif - if (slifcs(i) .ne. 1.0) slcfcs(i,k) = 1.0 ! flag value for non-land points. - enddo - endif - enddo -! set liquid soil moisture to a flag value of 1.0 - if (landice) then - do i = 1, len - if (slifcs(i) .eq. 1.0 .and. - & nint(vetfcs(i)) == veg_type_landice) then - do k=1, lsoil - slcfcs(i,k) = 1.0 - enddo - endif - enddo - end if -! -! ensure the consistency between snwdph and sheleg -! - if(fsnol .lt. 99999.) then - if(me .eq. 0) then - print *,'dbgx -- scale snwdph from sheleg' - endif - do i = 1, len - if(slifcs(i).eq.1.) swdfcs(i) = 10.* snofcs(i) - enddo - endif - -! sea ice model only uses the liquid equivalent depth. -! so update the physical depth only for display purposes. -! use the same 3:1 ratio used by ice model. - - do i = 1, len - if (slifcs(i).ne.1) swdfcs(i) = 3.*snofcs(i) - enddo - - do i = 1, len - if(slifcs(i).eq.1.) then - if(snofcs(i).ne.0. .and. swdfcs(i).eq.0.) then - print *,'dbgx --scale snwdph from sheleg', - + i, swdfcs(i), snofcs(i) - swdfcs(i) = 10.* snofcs(i) - endif - endif - enddo -! landice mods - impose same minimum snow depth at -! landice as noah lsm. also ensure -! lower thermal boundary condition -! and skin t is no warmer than freezing -! after adjustment to terrain. - if (landice) then - do i = 1, len - if (slifcs(i) .eq. 1.0 .and. - & nint(vetfcs(i)) == veg_type_landice) then - snofcs(i) = max(snofcs(i),100.0) ! in mm - swdfcs(i) = max(swdfcs(i),1000.0) ! in mm - tg3fcs(i) = min(tg3fcs(i),273.15) - tsffcs(i) = min(tsffcs(i),273.15) - endif - enddo - end if -! -! if(lprnt) print *,' tsffcsf=',tsffcs(iprnt) - return - end subroutine sfccycle - -!> Counts the number of model points that are snow covered land, -!! snow-free land, open water, sea ice, and snow covered sea ice. -!! -!! @param[in] slimsk The land-sea-ice mask. -!! @param[in] sno Snow -!! @param[in] ijmax Number of model points to process. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine count(slimsk,sno,ijmax) - use machine , only : kind_io8,kind_io4 - implicit none - real (kind=kind_io8) rl3,rl1,rl0,rl2,rl6,rl7,rl4,rl5 - integer l8,l7,l1,l2,ijmax,l0,l3,l5,l6,l4,ij -! - real (kind=kind_io8) slimsk(1),sno(1) -! -! count number of points for the four surface conditions -! - l0 = 0 - l1 = 0 - l2 = 0 - l3 = 0 - l4 = 0 - do ij=1,ijmax - if(slimsk(ij).eq.0.) l1 = l1 + 1 - if(slimsk(ij).eq.1. .and. sno(ij).le.0.) l0 = l0 + 1 - if(slimsk(ij).eq.2. .and. sno(ij).le.0.) l2 = l2 + 1 - if(slimsk(ij).eq.1. .and. sno(ij).gt.0.) l3 = l3 + 1 - if(slimsk(ij).eq.2. .and. sno(ij).gt.0.) l4 = l4 + 1 - enddo - l5 = l0 + l3 - l6 = l2 + l4 - l7 = l1 + l6 - l8 = l1 + l5 + l6 - rl0 = float(l0) / float(l8)*100. - rl3 = float(l3) / float(l8)*100. - rl1 = float(l1) / float(l8)*100. - rl2 = float(l2) / float(l8)*100. - rl4 = float(l4) / float(l8)*100. - rl5 = float(l5) / float(l8)*100. - rl6 = float(l6) / float(l8)*100. - rl7 = float(l7) / float(l8)*100. - print *,'1) no. of not snow-covered land points ',l0,' ',rl0,' ' - print *,'2) no. of snow covered land points ',l3,' ',rl3,' ' - print *,'3) no. of open sea points ',l1,' ',rl1,' ' - print *,'4) no. of not snow-covered seaice points ',l2,' ',rl2,' ' - print *,'5) no. of snow covered sea ice points ',l4,' ',rl4,' ' - print *,' ' - print *,'6) no. of land points ',l5,' ',rl5,' ' - print *,'7) no. sea points (including sea ice) ',l7,' ',rl7,' ' - print *,' (no. of sea ice points) (',l6,')',' ',rl6,' ' - print *,' ' - print *,'9) no. of total grid points ',l8 -! print *,' ' -! print *,' ' - -! -! if(lprnt) print *,' tsffcsf=',tsffcs(iprnt) - return - end - -!> Determine the maximum and minimum values of a surface field -!! at snow-free and snow covered land, open water, and -!! snow-free and snow covered sea ice. -!! -!! @param[in] lfld The name of the surface field to monitory. -!! @param[in] fld The surface field to monitor. -!! @param[in] slimsk Land-sea-ice mask. -!! @param[in] sno Snow. -!! @param[in] ijmax Number of model points to process. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine monitr(lfld,fld,slimsk,sno,ijmax) - use machine , only : kind_io8,kind_io4 - implicit none - integer ij,n,ijmax -! - real (kind=kind_io8) fld(ijmax), slimsk(ijmax),sno(ijmax) -! - real (kind=kind_io8) rmax(5),rmin(5) - character(len=*) lfld -! -! find max/min -! - do n=1,5 - rmax(n) = -9.e20 - rmin(n) = 9.e20 - enddo -! - do ij=1,ijmax - if(slimsk(ij).eq.0.) then - rmax(1) = max(rmax(1), fld(ij)) - rmin(1) = min(rmin(1), fld(ij)) - elseif(slimsk(ij).eq.1.) then - if(sno(ij).le.0.) then - rmax(2) = max(rmax(2), fld(ij)) - rmin(2) = min(rmin(2), fld(ij)) - else - rmax(4) = max(rmax(4), fld(ij)) - rmin(4) = min(rmin(4), fld(ij)) - endif - else - if(sno(ij).le.0.) then - rmax(3) = max(rmax(3), fld(ij)) - rmin(3) = min(rmin(3), fld(ij)) - else - rmax(5) = max(rmax(5), fld(ij)) - rmin(5) = min(rmin(5), fld(ij)) - endif - endif - enddo -! - print 100,lfld - print 101,rmax(1),rmin(1) - print 102,rmax(2),rmin(2), rmax(4), rmin(4) - print 103,rmax(3),rmin(3), rmax(5), rmin(5) -! -! print 102,rmax(2),rmin(2) -! print 103,rmax(3),rmin(3) -! print 104,rmax(4),rmin(4) -! print 105,rmax(5),rmin(5) - 100 format('0 *** ',a8,' ***') - 101 format(' open sea ......... max=',e12.4,' min=',e12.4) - 102 format(' land nosnow/snow .. max=',e12.4,' min=',e12.4 - &, ' max=',e12.4,' min=',e12.4) - 103 format(' seaice nosnow/snow max=',e12.4,' min=',e12.4 - &, ' max=',e12.4,' min=',e12.4) -! -! 100 format('0',2x,'*** ',a8,' ***') -! 102 format(2x,' land without snow ..... max=',e12.4,' min=',e12.4) -! 103 format(2x,' seaice without snow ... max=',e12.4,' min=',e12.4) -! 104 format(2x,' land with snow ........ max=',e12.4,' min=',e12.4) -! 105 format(2x,' sea ice with snow ..... max=',e12.4,' min=',e12.4) -! - return - end - -!> Compute day of the year based on month and day. -!! -!! @param[in] iyr Year. -!! @param[in] imo Month. -!! @param[in] idy Day. -!! @param[out] ldy Day of the year. -!! @author Mark Iredell NOAA/EMC - subroutine dayoyr(iyr,imo,idy,ldy) - implicit none - integer ldy,i,idy,iyr,imo -! -! this routine figures out the day of the year given imo and idy -! - integer month(13) - data month/0,31,28,31,30,31,30,31,31,30,31,30,31/ - if(mod(iyr,4).eq.0) month(3) = 29 - ldy = idy - do i = 1, imo - ldy = ldy + month(i) - enddo - return - end - -!> Read a high-resolution land mask. It will be used -!! as a surrogate for GRIB input data without a bitmap. -!! This is NOT the model land mask. This mask file is GRIB1. -!! -!! @param[in] lugb Fortran unit number of the mask file. -!! @param[out] imsk 'i' dimension of the mask. -!! @param[out] jmsk 'j' dimension of the mask. -!! @param[in] fnmskh Name of the mask file. -!! @param[in] kpds5 GRIB1 parameter number for mask. -!! @param[out] slmskh The high-resolution mask. -!! @param[out] gausm When true, mask is on a gaussian grid. -!! @param[out] blnmsk Corner point longitude of the mask grid. -!! @param[out] bltmsk Corner point latitude of the mask grid. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine hmskrd(lugb,imsk,jmsk,fnmskh, - & kpds5,slmskh,gausm,blnmsk,bltmsk,me) - use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : mdata, xdata, ydata - implicit none - integer kpds5,me,i,imsk,jmsk,lugb -! - character*500 fnmskh -! - real (kind=kind_io8) slmskh(mdata) - logical gausm - real (kind=kind_io8) blnmsk,bltmsk -! - imsk = xdata - jmsk = ydata - - if (me .eq. 0) then - write(6,*)' imsk=',imsk,' jmsk=',jmsk,' xdata=',xdata,' ydata=' - &, ydata - endif - - call fixrdg(lugb,imsk,jmsk,fnmskh, - & kpds5,slmskh,gausm,blnmsk,bltmsk,me) - -! print *,'in sfc_sub, aft fixrdg,slmskh=',maxval(slmskh), -! & minval(slmskh),'mdata=',mdata,'imsk*jmsk=',imsk*jmsk - - do i=1,imsk*jmsk - slmskh(i) = nint(slmskh(i)) - enddo -! - return - end - -!> Read a GRIB1 file. Return the requested data record -!! and some grid specifications. -!! -!! @param[in] lugb Fortran unit number of the grib file. -!! @param[inout] idim "i" dimension of the data. -!! @param[inout] jdim "j" dimension of the data. -!! @param[in] fngrib Name of the grib file. -!! @param[in] kpds5 The grib1 parameter number for the requested field. -!! @param[out] gdata The requested data. -!! @param[out] gaus When true, grid is gaussian. -!! @param[out] blno Corner point longitude of grid. -!! @param[out] blto Corner point latitude of grid. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine fixrdg(lugb,idim,jdim,fngrib, - & kpds5,gdata,gaus,blno,blto,me) - use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : mdata - implicit none - integer lgrib,n,lskip,jret,j,ndata,lugi,jdim,idim,lugb, - & iret, me,kpds5,kdata,i,w3kindreal,w3kindint -! - character*(*) fngrib -! - real (kind=kind_io8) gdata(idim*jdim) - logical gaus - real (kind=kind_io8) blno,blto - real (kind=kind_io8), allocatable :: data8(:) - real (kind=kind_io4), allocatable :: data4(:) -! - logical*1, allocatable :: lbms(:) -! - integer kpds(200),kgds(200) - integer jpds(200),jgds(200), kpds0(200) -! - allocate(data8(1:idim*jdim)) - allocate(lbms(1:mdata)) - kpds = 0 - kgds = 0 - jpds = 0 - jgds = 0 - kpds0 = 0 -! -! if(me .eq. 0) then -! write(6,*) ' ' -! write(6,*) '************************************************' -! endif -! - close(lugb) - call baopenr(lugb,fngrib,iret) - if (iret .ne. 0) then - write(6,*) ' FATAL ERROR: in opening file ',trim(fngrib) - print *,'FATAL ERROR: in opening file ',trim(fngrib) - call abort - endif - if (me .eq. 0) write(6,*) ' file ',trim(fngrib), - & ' opened. unit=',lugb - lugi = 0 - lskip = -1 - n = 0 - jpds = -1 - jgds = -1 - jpds(5) = kpds5 - kpds = jpds -! - call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, - & lskip,kpds,kgds,iret) -! - if(me .eq. 0) then - write(6,*) ' first grib record.' - write(6,*) ' kpds( 1-10)=',(kpds(j),j= 1,10) - write(6,*) ' kpds(11-20)=',(kpds(j),j=11,20) - write(6,*) ' kpds(21- )=',(kpds(j),j=21,22) - endif -! - kpds0=jpds - kpds0(4)=-1 - kpds0(18)=-1 - if(iret.ne.0) then - write(6,*) ' FATAL ERROR: in getgbh. iret: ', iret - if (iret == 99) write(6,*) ' field not found.' - call abort - endif -! - jpds = kpds0 - lskip = -1 - kdata=idim*jdim - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - else if (w3kindreal == 4) then - allocate(data4(1:idim*jdim)) - call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8 = real(data4, kind=kind_io8) - deallocate(data4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal ' - call abort - endif -! - if(jret == 0) then - if(ndata.eq.0) then - write(6,*) ' FATAL ERROR: in getgb' - write(6,*) ' kpds=',kpds - write(6,*) ' kgds=',kgds - call abort - endif - idim = kgds(2) - jdim = kgds(3) - gaus = kgds(1).eq.4 - blno = kgds(5)*1.d-3 - blto = kgds(4)*1.d-3 - gdata(1:idim*jdim) = data8(1:idim*jdim) - if (me == 0) write(6,*) 'idim,jdim=',idim,jdim - &, ' gaus=',gaus,' blno=',blno,' blto=',blto - else - if (me ==. 0) write(6,*) 'idim,jdim=',idim,jdim - &, ' gaus=',gaus,' blno=',blno,' blto=',blto - write(6,*) ' FATAL ERROR in getgb : jret=',jret - write(6,*) ' kpds(13)=',kpds(13),' kpds(15)=',kpds(15) - call abort - endif -! - deallocate(data8) - deallocate(lbms) - return - end - -!> For a given GRIB1 grid description section array, determine -!! some grid specifications. -!! -!! @param[in] kgds GRIB1 grid description section array. -!! @param[out] dlat Grid resolution in the 'j' direction. -!! @param[out] dlon Grid resolution in the 'i' direction. -!! @param[out] rslat Latitude of the southern row of data. -!! @param[out] rnlat Latitude of the northern row of data. -!! @param[out] wlon Longitude of the western column of data. -!! @param[out] elon Longitude of the eastern column of data. -!! @param[out] ijordr When false, adjacent points in the 'i' direction -!! are consecutive. Otherwise, 'j' points are consecutive. -!! @param[in] me MPI rank number. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr - &, me) - use machine , only : kind_io8,kind_io4 - implicit none - integer j,me,kgds11 - real (kind=kind_io8) f0lon,f0lat,elon,dlon,dlat,rslat,wlon,rnlat -! -! get area of the grib record -! - integer kgds(22) - logical ijordr -! - if (me .eq. 0) then - write(6,*) ' kgds( 1-12)=',(kgds(j),j= 1,12) - write(6,*) ' kgds(13-22)=',(kgds(j),j=13,22) - endif -! - if(kgds(1).eq.0) then ! lat/lon grid -! - if (me .eq. 0) write(6,*) 'lat/lon grid' - dlat = float(kgds(10)) * 0.001 - dlon = float(kgds( 9)) * 0.001 - f0lon = float(kgds(5)) * 0.001 - f0lat = float(kgds(4)) * 0.001 - kgds11 = kgds(11) - if(kgds11.ge.128) then - wlon = f0lon - dlon*(kgds(2)-1) - elon = f0lon - if(dlon*kgds(2).gt.359.99) then - wlon =f0lon - dlon*kgds(2) - endif - dlon = -dlon - kgds11 = kgds11 - 128 - else - wlon = f0lon - elon = f0lon + dlon*(kgds(2)-1) - if(dlon*kgds(2).gt.359.99) then - elon = f0lon + dlon*kgds(2) - endif - endif - if(kgds11.ge.64) then - rnlat = f0lat + dlat*(kgds(3)-1) - rslat = f0lat - kgds11 = kgds11 - 64 - else - rnlat = f0lat - rslat = f0lat - dlat*(kgds(3)-1) - dlat = -dlat - endif - if(kgds11.ge.32) then - ijordr = .false. - else - ijordr = .true. - endif - - if(wlon.gt.180.) wlon = wlon - 360. - if(elon.gt.180.) elon = elon - 360. - wlon = nint(wlon*1000.) * 0.001 - elon = nint(elon*1000.) * 0.001 - rslat = nint(rslat*1000.) * 0.001 - rnlat = nint(rnlat*1000.) * 0.001 - return -! - elseif(kgds(1).eq.1) then ! mercator projection - write(6,*) 'FATAL ERROR: cannot process mercator grid.' - call abort -! - elseif(kgds(1).eq.2) then ! gnomonic projection - write(6,*) 'FATAL ERROR: cannot process gnomonic grid.' - call abort -! - elseif(kgds(1).eq.3) then ! lambert conformal - write(6,*) 'FATAL ERROR: cannot process lambert conf grid.' - call abort - elseif(kgds(1).eq.4) then ! gaussian grid -! - if (me .eq. 0) write(6,*) 'gaussian grid' - dlat = 99. - dlon = float(kgds( 9)) / 1000.0 - f0lon = float(kgds(5)) / 1000.0 - f0lat = 99. - kgds11 = kgds(11) - if(kgds11.ge.128) then - wlon = f0lon - elon = f0lon - if(dlon*kgds(2).gt.359.99) then - wlon = f0lon - dlon*kgds(2) - endif - dlon = -dlon - kgds11 = kgds11-128 - else - wlon = f0lon - elon = f0lon + dlon*(kgds(2)-1) - if(dlon*kgds(2).gt.359.99) then - elon = f0lon + dlon*kgds(2) - endif - endif - if(kgds11.ge.64) then - rnlat = 99. - rslat = 99. - kgds11 = kgds11 - 64 - else - rnlat = 99. - rslat = 99. - dlat = -99. - endif - if(kgds11.ge.32) then - ijordr = .false. - else - ijordr = .true. - endif - return -! - elseif(kgds(1).eq.5) then ! polar strereographic - write(6,*) 'FATAL ERROR: cannot process' - write(6,*) 'polar stereographic grid.' - call abort - return -! - elseif(kgds(1).eq.13) then ! oblique lambert conformal - write(6,*) 'FATAL ERROR: cannot process' - write(6,*) 'oblique lambert conformal grid.' - call abort -! - elseif(kgds(1).eq.50) then ! spherical coefficient - write(6,*) 'FATAL ERROR: cannot process' - write(6,*) 'spherical coefficient grid.' - call abort - return -! - elseif(kgds(1).eq.90) then ! space view perspective -! (orthographic grid) - write(6,*) 'FATAL ERROR: cannot process' - write(6,*) 'space view perspective grid.' - call abort - return -! - else ! unknown projection. abort. - write(6,*) 'FATAL ERROR: unknown map projection' - write(6,*) 'kgds(1)=',kgds(1) - print *,'FATAL ERROR: unknown map projection' - print *,'kgds(1)=',kgds(1) - call abort - endif -! - return - end - -!> Take an array of data on a lat/lon based grid and rearrange -!! it so the corner point is in the 'lower left' and adjacent -!! points in the 'i' direction are consecutive. -!! -!! @param[inout] data The data to be adjusted. -!! @param[in] imax 'i' dimension of data. -!! @param[in] jmax 'j' dimension of data. -!! @param[in] dlon Delta longitude of the data. -!! @param[in] dlat Delta latitude of the data. -!! @param[in] ijordr When false, adjacent points in the 'i' direction -!! are consecutive. Otherwise, 'j' points are consecutive. -!! @author Shrinivas Moorthi - subroutine subst(data,imax,jmax,dlon,dlat,ijordr) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,j,ii,jj,jmax,imax,iret - real (kind=kind_io8) dlat,dlon -! - logical ijordr -! - real (kind=kind_io8) data(imax,jmax) - real (kind=kind_io8), allocatable :: work(:,:) -! - if(.not.ijordr.or. - & (ijordr.and.(dlat.gt.0..or.dlon.lt.0.))) then - allocate (work(imax,jmax)) - - if(.not.ijordr) then - do j=1,jmax - do i=1,imax - work(i,j) = data(j,i) - enddo - enddo - else - do j=1,jmax - do i=1,imax - work(i,j) = data(i,j) - enddo - enddo - endif - if (dlat > 0.0) then - if (dlon > 0.0) then - do j=1,jmax - jj = jmax - j + 1 - do i=1,imax - data(i,jj) = work(i,j) - enddo - enddo - else - do i=1,imax - data(imax-i+1,jj) = work(i,j) - enddo - endif - else - if (dlon > 0.0) then - do j=1,jmax - do i=1,imax - data(i,j) = work(i,j) - enddo - enddo - else - do j=1,jmax - do i=1,imax - data(imax-i+1,j) = work(i,j) - enddo - enddo - endif - endif - deallocate (work, stat=iret) - endif - return - end - -!> Interpolate data from a lat/lon grid to the model grid. -!! -!! @param[in] regin Input data. -!! @param[in] imxin 'i' dimension of input data. -!! @param[in] jmxin 'j' dimension of input data. -!! @param[in] rinlon -!! @param[in] rinlat -!! @param[in] rlon -!! @param[in] rlat -!! @param[in] inttyp -!! @param[out] gauout The interpolated data on the model grid. -!! @param[in] len Number of model points to process. -!! @param[in] lmask -!! @param[in] rslmsk -!! @param[in] slmask Model land-sea-ice mask. -!! @param[in] outlat Latitudes on the model grid. -!! @param[in] outlon Longitudes on the model grid. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorth - subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp, - & gauout,len,lmask,rslmsk,slmask - &, outlat, outlon,me) - use machine , only : kind_io8,kind_io4 - implicit none - real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, - & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, - & wi1j2,wi2j1,rlat,rlon,aphi, - & rnume,alamd,denom - integer jy,ifills,ix,len,inttyp,me,i,j,jmxin,imxin,jq,jx,j1,j2, - & ii,i1,i2,kmami,it - integer nx,kxs,kxt - integer, allocatable, save :: imxnx(:) - integer, allocatable :: ifill(:) -! -! interpolation from lat/lon or gaussian grid to other lat/lon grid -! - real (kind=kind_io8) outlon(len),outlat(len),gauout(len), - & slmask(len) - real (kind=kind_io8) regin (imxin,jmxin),rslmsk(imxin,jmxin) -! - real (kind=kind_io8) rinlat(jmxin), rinlon(imxin) - integer iindx1(len), iindx2(len) - integer jindx1(len), jindx2(len) - real (kind=kind_io8) ddx(len), ddy(len), wrk(len) -! - logical lmask -! - logical first - integer num_threads - data first /.true./ - save num_threads, first -! - integer len_thread_m, len_thread, i1_t, i2_t - integer num_parthds -! - if (first) then - num_threads = num_parthds() - first = .false. - if (.not. allocated(imxnx)) allocate (imxnx(num_threads)) - endif -! -! if (me == 0) print *,' num_threads =',num_threads,' me=',me -! -! if(me .eq. 0) then -! print *,'rlon=',rlon,' me=',me -! print *,'rlat=',rlat,' me=',me,' imxin=',imxin,' jmxin=',jmxin -! endif -! -! do j=1,jmxin -! if(rlat.gt.0.) then -! rinlat(j) = rlat - float(j-1)*dlain -! else -! rinlat(j) = rlat + float(j-1)*dlain -! endif -! enddo -! -! if (me .eq. 0) then -! print *,'rinlat=' -! print *,(rinlat(j),j=1,jmxin) -! print *,'rinlon=' -! print *,(rinlon(i),i=1,imxin) -! -! print *,'outlat=' -! print *,(outlat(j),j=1,len) -! print *,(outlon(j),j=1,len) -! endif -! -! do i=1,imxin -! rinlon(i) = rlon + float(i-1)*dloin -! enddo -! -! print *,'rinlon=' -! print *,(rinlon(i),i=1,imxin) -! - len_thread_m = (len+num_threads-1) / num_threads - - if (inttyp /=1) allocate (ifill(num_threads)) -! -!$omp parallel do default(none) -!$omp+private(i1_t,i2_t,len_thread,it,i,ii,i1,i2) -!$omp+private(j,j1,j2,jq,ix,jy,nx,kxs,kxt,kmami) -!$omp+private(alamd,denom,rnume,aphi,x,y,wsum,wsumiv,sum1,sum2) -!$omp+private(sum3,sum4,wi1j1,wi2j1,wi1j2,wi2j2,wei1,wei2,wei3,wei4) -!$omp+private(sumn,sums) -!$omp+shared(imxin,jmxin,ifill) -!$omp+shared(outlon,outlat,wrk,iindx1,rinlon,jindx1,rinlat,ddx,ddy) -!$omp+shared(rlon,rlat,regin,gauout,imxnx) -!$omp+private(tem) -!$omp+shared(num_threads,len_thread_m,len,lmask,iindx2,jindx2,rslmsk) -!$omp+shared(inttyp,me,slmask) -! - do it=1,num_threads ! start of threaded loop ................... - i1_t = (it-1)*len_thread_m+1 - i2_t = min(i1_t+len_thread_m-1,len) - len_thread = i2_t-i1_t+1 -! -! find i-index for interpolation -! - do i=i1_t, i2_t - alamd = outlon(i) - if (alamd .lt. rlon) alamd = alamd + 360.0 - if (alamd .gt. 360.0+rlon) alamd = alamd - 360.0 - wrk(i) = alamd - iindx1(i) = imxin - enddo - do i=i1_t,i2_t - do ii=1,imxin - if(wrk(i) .ge. rinlon(ii)) iindx1(i) = ii - enddo - enddo - do i=i1_t,i2_t - i1 = iindx1(i) - if (i1 .lt. 1) i1 = imxin - i2 = i1 + 1 - if (i2 .gt. imxin) i2 = 1 - iindx1(i) = i1 - iindx2(i) = i2 - denom = rinlon(i2) - rinlon(i1) - if(denom.lt.0.) denom = denom + 360. - rnume = wrk(i) - rinlon(i1) - if(rnume.lt.0.) rnume = rnume + 360. - ddx(i) = rnume / denom - enddo -! -! find j-index for interplation -! - if(rlat.gt.0.) then - do j=i1_t,i2_t - jindx1(j)=0 - enddo - do jx=1,jmxin - do j=i1_t,i2_t - if(outlat(j).le.rinlat(jx)) jindx1(j) = jx - enddo - enddo - do j=i1_t,i2_t - jq = jindx1(j) - aphi=outlat(j) - if(jq.ge.1 .and. jq .lt. jmxin) then - j2=jq+1 - j1=jq - ddy(j)=(aphi-rinlat(j1))/(rinlat(j2)-rinlat(j1)) - elseif (jq .eq. 0) then - j2=1 - j1=1 - if(abs(90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - else - j2=jmxin - j1=jmxin - if(abs(-90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(-90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - endif - jindx1(j)=j1 - jindx2(j)=j2 - enddo - else - do j=i1_t,i2_t - jindx1(j) = jmxin+1 - enddo - do jx=jmxin,1,-1 - do j=i1_t,i2_t - if(outlat(j).le.rinlat(jx)) jindx1(j) = jx - enddo - enddo - do j=i1_t,i2_t - jq = jindx1(j) - aphi=outlat(j) - if(jq.gt.1 .and. jq .le. jmxin) then - j2=jq - j1=jq-1 - ddy(j)=(aphi-rinlat(j1))/(rinlat(j2)-rinlat(j1)) - elseif (jq .eq. 1) then - j2=1 - j1=1 - if(abs(-90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(-90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - else - j2=jmxin - j1=jmxin - if(abs(90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - endif - jindx1(j)=j1 - jindx2(j)=j2 - enddo - endif -! -! if (me .eq. 0 .and. inttyp .eq. 1) then -! print *,'la2ga' -! print *,'iindx1' -! print *,(iindx1(n),n=1,len) -! print *,'iindx2' -! print *,(iindx2(n),n=1,len) -! print *,'jindx1' -! print *,(jindx1(n),n=1,len) -! print *,'jindx2' -! print *,(jindx2(n),n=1,len) -! print *,'ddy' -! print *,(ddy(n),n=1,len) -! print *,'ddx' -! print *,(ddx(n),n=1,len) -! endif -! - sum1 = 0. - sum2 = 0. - sum3 = 0. - sum4 = 0. - if (lmask) then - wei1 = 0. - wei2 = 0. - wei3 = 0. - wei4 = 0. - do i=1,imxin - sum1 = sum1 + regin(i,1) * rslmsk(i,1) - sum2 = sum2 + regin(i,jmxin) * rslmsk(i,jmxin) - wei1 = wei1 + rslmsk(i,1) - wei2 = wei2 + rslmsk(i,jmxin) -! - sum3 = sum3 + regin(i,1) * (1.0-rslmsk(i,1)) - sum4 = sum4 + regin(i,jmxin) * (1.0-rslmsk(i,jmxin)) - wei3 = wei3 + (1.0-rslmsk(i,1)) - wei4 = wei4 + (1.0-rslmsk(i,jmxin)) - enddo -! - if(wei1.gt.0.) then - sum1 = sum1 / wei1 - else - sum1 = 0. - endif - if(wei2.gt.0.) then - sum2 = sum2 / wei2 - else - sum2 = 0. - endif - if(wei3.gt.0.) then - sum3 = sum3 / wei3 - else - sum3 = 0. - endif - if(wei4.gt.0.) then - sum4 = sum4 / wei4 - else - sum4 = 0. - endif - else - do i=1,imxin - sum1 = sum1 + regin(i,1) - sum2 = sum2 + regin(i,jmxin) - enddo - sum1 = sum1 / imxin - sum2 = sum2 / imxin - sum3 = sum1 - sum4 = sum2 - endif -! -! print *,' sum1=',sum1,' sum2=',sum2 -! *,' sum3=',sum3,' sum4=',sum4 -! print *,' rslmsk=',(rslmsk(i,1),i=1,imxin) -! print *,' slmask=',(slmask(i),i=1,imxout) -! *,' j1=',jindx1(1),' j2=',jindx2(1) -! -! -! inttyp=1 take the closest point value -! - if(inttyp.eq.1) then - - do i=i1_t,i2_t - jy = jindx1(i) - if(ddy(i) .ge. 0.5) jy = jindx2(i) - ix = iindx1(i) - if(ddx(i) .ge. 0.5) ix = iindx2(i) -! -!cggg start -! - if (.not. lmask) then - - gauout(i) = regin(ix,jy) - - else - - if(slmask(i).eq.rslmsk(ix,jy)) then - - gauout(i) = regin(ix,jy) - - else - - i1 = ix - j1 = jy - -! spiral around until matching mask is found. - do nx=1,jmxin*imxin/2 - kxs=sqrt(4*nx-2.5) - kxt=nx-int(kxs**2/4+1) - select case(mod(kxs,4)) - case(1) - ix=i1-kxs/4+kxt - jx=j1-kxs/4 - case(2) - ix=i1+1+kxs/4 - jx=j1-kxs/4+kxt - case(3) - ix=i1+1+kxs/4-kxt - jx=j1+1+kxs/4 - case default - ix=i1-kxs/4 - jx=j1+kxs/4-kxt - end select - if(jx.lt.1) then - ix=ix+imxin/2 - jx=2-jx - elseif(jx.gt.jmxin) then - ix=ix+imxin/2 - jx=2*jmxin-jx - endif - ix=modulo(ix-1,imxin)+1 - if(slmask(i).eq.rslmsk(ix,jx)) then - gauout(i) = regin(ix,jx) - go to 81 - endif - enddo - -!cggg here, set the gauout value to be 0, and let's sarah's land -!cggg routine assign a default. - - if (num_threads == 1) then - print*,'no matching mask found ',i,i1,j1,ix,jx - print*,'set to default value.' - endif - gauout(i) = 0.0 - - - 81 continue - - end if - - end if - -!cggg end - - enddo -! kmami=1 -! if (me == 0 .and. num_threads == 1) -! & call maxmin(gauout(i1_t),len_thread,kmami) - else ! nearest neighbor interpolation - -! -! quasi-bilinear interpolation -! - ifill(it) = 0 - imxnx(it) = 0 - do i=i1_t,i2_t - y = ddy(i) - j1 = jindx1(i) - j2 = jindx2(i) - x = ddx(i) - i1 = iindx1(i) - i2 = iindx2(i) -! - wi1j1 = (1.-x) * (1.-y) - wi2j1 = x *( 1.-y) - wi1j2 = (1.-x) * y - wi2j2 = x * y -! - tem = 4.*slmask(i) - rslmsk(i1,j1) - rslmsk(i2,j1) - & - rslmsk(i1,j2) - rslmsk(i2,j2) - if(lmask .and. abs(tem) .gt. 0.01) then - if(slmask(i).eq.1.) then - wi1j1 = wi1j1 * rslmsk(i1,j1) - wi2j1 = wi2j1 * rslmsk(i2,j1) - wi1j2 = wi1j2 * rslmsk(i1,j2) - wi2j2 = wi2j2 * rslmsk(i2,j2) - else - wi1j1 = wi1j1 * (1.0-rslmsk(i1,j1)) - wi2j1 = wi2j1 * (1.0-rslmsk(i2,j1)) - wi1j2 = wi1j2 * (1.0-rslmsk(i1,j2)) - wi2j2 = wi2j2 * (1.0-rslmsk(i2,j2)) - endif - endif -! - wsum = wi1j1 + wi2j1 + wi1j2 + wi2j2 - wrk(i) = wsum - if(wsum.ne.0.) then - wsumiv = 1./wsum -! - if(j1.ne.j2) then - gauout(i) = (wi1j1*regin(i1,j1) + wi2j1*regin(i2,j1) + - & wi1j2*regin(i1,j2) + wi2j2*regin(i2,j2)) - & *wsumiv - else -! - if (rlat .gt. 0.0) then - if (slmask(i) .eq. 1.0) then - sumn = sum1 - sums = sum2 - else - sumn = sum3 - sums = sum4 - endif - if( j1 .eq. 1) then - gauout(i) = (wi1j1*sumn +wi2j1*sumn + - & wi1j2*regin(i1,j2)+wi2j2*regin(i2,j2)) - & * wsumiv - elseif (j1 .eq. jmxin) then - gauout(i) = (wi1j1*regin(i1,j1)+wi2j1*regin(i2,j1)+ - & wi1j2*sums +wi2j2*sums ) - & * wsumiv - endif -! print *,' slmask=',slmask(i),' sums=',sums,' sumn=',sumn -! & ,' regin=',regin(i1,j2),regin(i2,j2),' j1=',j1,' j2=',j2 -! & ,' wij=',wi1j1, wi2j1, wi1j2, wi2j2,wsumiv - else - if (slmask(i) .eq. 1.0) then - sums = sum1 - sumn = sum2 - else - sums = sum3 - sumn = sum4 - endif - if( j1 .eq. 1) then - gauout(i) = (wi1j1*regin(i1,j1)+wi2j1*regin(i2,j1)+ - & wi1j2*sums +wi2j2*sums ) - & * wsumiv - elseif (j1 .eq. jmxin) then - gauout(i) = (wi1j1*sumn +wi2j1*sumn + - & wi1j2*regin(i1,j2)+wi2j2*regin(i2,j2)) - & * wsumiv - endif - endif - endif ! if j1 .ne. j2 - endif - enddo - do i=i1_t,i2_t - j1 = jindx1(i) - j2 = jindx2(i) - i1 = iindx1(i) - i2 = iindx2(i) - if(wrk(i) .eq. 0.0) then - if(.not.lmask) then - write(6,*) ' FATAL ERROR: la2ga called with lmask=true' - write(6,*) ' But bad rslmsk or slmask given.' - call abort - endif - ifill(it) = ifill(it) + 1 - if(ifill(it) <= 2 ) then - if (me == 0 .and. num_threads == 1) then - write(6,*) 'i1,i2,j1,j2=',i1,i2,j1,j2 - write(6,*) 'rslmsk=',rslmsk(i1,j1),rslmsk(i1,j2), - & rslmsk(i2,j1),rslmsk(i2,j2) -! write(6,*) 'i,j=',i,j,' slmask(i)=',slmask(i) - write(6,*) 'i=',i,' slmask(i)=',slmask(i) - &, ' outlon=',outlon(i),' outlat=',outlat(i) - endif - endif -! spiral around until matching mask is found. - do nx=1,jmxin*imxin/2 - kxs=sqrt(4*nx-2.5) - kxt=nx-int(kxs**2/4+1) - select case(mod(kxs,4)) - case(1) - ix=i1-kxs/4+kxt - jx=j1-kxs/4 - case(2) - ix=i1+1+kxs/4 - jx=j1-kxs/4+kxt - case(3) - ix=i1+1+kxs/4-kxt - jx=j1+1+kxs/4 - case default - ix=i1-kxs/4 - jx=j1+kxs/4-kxt - end select - if(jx.lt.1) then - ix=ix+imxin/2 - jx=2-jx - elseif(jx.gt.jmxin) then - ix=ix+imxin/2 - jx=2*jmxin-jx - endif - ix=modulo(ix-1,imxin)+1 - if(slmask(i).eq.rslmsk(ix,jx)) then - gauout(i) = regin(ix,jx) - imxnx(it) = max(imxnx(it),nx) - go to 71 - endif - enddo -! - write(6,*) ' FATAL ERROR: no filling value' - write(6,*) ' found in la2ga.' -! write(6,*) ' i ix jx slmask(i) rslmsk ', -! & i,ix,jx,slmask(i),rslmsk(ix,jx) - call abort -! - 71 continue - endif -! - enddo - endif - enddo ! end of threaded loop ................... -!$omp end parallel do -! - if(inttyp /= 1)then - ifills = 0 - do it=1,num_threads - ifills = ifills + ifill(it) - enddo - - if(ifills.gt.1) then - if (me .eq. 0) then - write(6,*) ' unable to interpolate. filled with nearest', - & ' point value at ',ifills,' points' -! & ' point value at ',ifills,' points imxnx=',imxnx(:) - endif - endif - deallocate (ifill) - endif -! -! kmami = 1 -! if (me == 0) call maxmin(gauout,len,kmami) -! - return - end subroutine la2ga - -!> Compute the maxmimum and minimum of a field. -!! -!! @param[in] f The field to check. -!! @param[in] imax The horizontal dimension of the field. -!! @param[in] kmax Number of vertical levels of the field. -!! @author Shrinivas Moorthi - subroutine maxmin(f,imax,kmax) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,iimin,iimax,kmax,imax,k - real (kind=kind_io8) fmin,fmax -! - real (kind=kind_io8) f(imax,kmax) -! - do k=1,kmax -! - fmax = f(1,k) - fmin = f(1,k) -! - do i=1,imax - if(fmax.le.f(i,k)) then - fmax = f(i,k) - iimax = i - endif - if(fmin.ge.f(i,k)) then - fmin = f(i,k) - iimin = i - endif - enddo -! -! write(6,100) k,fmax,iimax,fmin,iimin -! 100 format(2x,'level=',i2,' max=',e11.4,' at i=',i7, -! & ' min=',e11.4,' at i=',i7) -! - enddo -! - return - end - -!> Fill in analysis arrays with climatology before reading analysis -!! data. -!! -!! @param[out] tsfanl Skin temperature/SST analysis on model grid. -!! @param[out] tsfan2 Skin temperature/SST analysis on model grid -!! at time minus deltsfc. -!! @param[out] wetanl Soil wetness analysis on model grid. -!! @param[out] snoanl Liquid equivalent snow depth analysis on model grid. -!! @param[out] zoranl Roughness length analysis on model grid. -!! @param[out] albanl Snow-free albedo analysis on model grid. -!! @param[out] aisanl Sea ice mask analysis on model grid. -!! @param[out] tg3anl Soil substrate temperature analysis on model grid. -!! @param[out] cvanl Convective cloud cover analysis on model grid. -!! @param[out] cvbanl Convective cloud base analysis on model grid. -!! @param[out] cvtanl Convective cloud top analysis on model grid. -!! @param[out] cnpanl Canopy water content analysis on model grid. -!! @param[out] smcanl Soil moisture analysis on model grid. -!! @param[out] stcanl Soil temperature analysis on model grid. -!! @param[out] slianl Land-sea-ice mask analysis on model grid. -!! @param[out] scvanl Snow cover analysis on model grid. -!! @param[out] veganl Vegetation greenness analysis on model grid. -!! @param[out] vetanl Vegetation type analysis on model grid. -!! @param[out] sotanl Soil type analysis on model grid. -!! @param[out] alfanl Fraction for strongly and weakly zenith -!! angle dependent albedo analysis on model grid. -!! @param[out] sihanl Sea ice depth analysis on model grid. -!! @param[out] sicanl Sea ice concentration analysis on model grid. -!! @param[out] vmnanl Minimum vegetation greenness analysis on model -!! grid. -!! @param[out] vmxanl Maximum vegetation greenness analysis on model -!! grid. -!! @param[out] slpanl Slope type analysis on model grid. -!! @param[out] absanl Maximum snow albedo analysis on model grid. -!! @param[in] tsfclm Climatological skin temperature/SST on model grid. -!! @param[in] tsfcl2 Climatological skin temperature/SST on model grid -!! at time minus deltsfc. -!! @param[in] wetclm Climatological soil wetness on model grid. -!! @param[in] snoclm Climatological liquid equivalent snow depth on model grid. -!! @param[in] zorclm Climatological roughness length on model grid. -!! @param[in] albclm Climatological snow-free albedo on model grid. -!! @param[in] aisclm Climatological sea ice mask on model grid. -!! @param[in] tg3clm Climatological soil substrate temperature on model -!! grid. -!! @param[in] cvclm Climatological convective cloud cover on model grid. -!! @param[in] cvbclm Climatological convective cloud base on model grid. -!! @param[in] cvtclm Climatological convective cloud top on model grid. -!! @param[in] cnpclm Climatological canopy water content on model grid. -!! @param[in] smcclm Climatological soil moisture on model grid. -!! @param[in] stcclm Climatologcial soil temperature on model grid. -!! @param[in] sliclm Climatological model land-sea-ice mask. -!! @param[in] scvclm Climatological snow cover on model grid. -!! @param[in] vegclm Climatological vegetation greenness on model grid. -!! @param[in] vetclm Climatological vegetation type on model grid. -!! @param[in] sotclm Climatological soil type on model grid. -!! @param[in] alfclm Climatological fraction for strongly and weakly -!! zenith angle dependent albedo on model grid. -!! @param[in] sihclm Climatological sea ice depth on the model grid. -!! @param[in] sicclm Climatological sea ice concentration on the model grid. -!! @param[in] vmnclm Climatological minimum vegetation greenness on -!! model grid. -!! @param[in] vmxclm Climatological maximum vegetation greenness on -!! model grid. -!! @param[in] slpclm Climatological slope type on model grid. -!! @param[in] absclm Climatological maximum snow albedo on model grid. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @author Shrinivas Moorthi - subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl, - & aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,scvanl,veganl, - & vetanl,sotanl,alfanl, - & sihanl,sicanl, - & vmnanl,vmxanl,slpanl,absanl, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm, - & aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm, - & vetclm,sotclm,alfclm, - & sihclm,sicclm, - & vmnclm,vmxclm,slpclm,absclm, - & len,lsoil) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,j,len,lsoil -! - real (kind=kind_io8) tsfanl(len),tsfan2(len),wetanl(len), - & snoanl(len), - & zoranl(len),albanl(len,4),aisanl(len), - & tg3anl(len), - & cvanl (len),cvbanl(len),cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len),scvanl(len),veganl(len), - & vetanl(len),sotanl(len),alfanl(len,2) -!cwu [+1l] add ()anl for sih, sic - &, sihanl(len),sicanl(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs - &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) - real (kind=kind_io8) tsfclm(len),tsfcl2(len),wetclm(len), - & snoclm(len), - & zorclm(len),albclm(len,4),aisclm(len), - & tg3clm(len), - & cvclm (len),cvbclm(len),cvtclm(len), - & cnpclm(len), - & smcclm(len,lsoil),stcclm(len,lsoil), - & sliclm(len),scvclm(len),vegclm(len), - & vetclm(len),sotclm(len),alfclm(len,2) -!cwu [+1l] add ()clm for sih, sic - &, sihclm(len),sicclm(len) -!clu [+1l] add ()clm for vmn, vmx, slp, abs - &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len) -! - do i=1,len - tsfanl(i) = tsfclm(i) ! tsf at t - tsfan2(i) = tsfcl2(i) ! tsf at t-deltsfc - wetanl(i) = wetclm(i) ! soil wetness - snoanl(i) = snoclm(i) ! snow - scvanl(i) = scvclm(i) ! snow cover - aisanl(i) = aisclm(i) ! seaice - slianl(i) = sliclm(i) ! land/sea/snow mask - zoranl(i) = zorclm(i) ! surface roughness -! plranl(i) = plrclm(i) ! maximum stomatal resistance - tg3anl(i) = tg3clm(i) ! deep soil temperature - cnpanl(i) = cnpclm(i) ! canopy water content - veganl(i) = vegclm(i) ! vegetation cover - vetanl(i) = vetclm(i) ! vegetation type - sotanl(i) = sotclm(i) ! soil type - cvanl(i) = cvclm(i) ! cv - cvbanl(i) = cvbclm(i) ! cvb - cvtanl(i) = cvtclm(i) ! cvt -!cwu [+4l] add sih, sic - sihanl(i) = sihclm(i) ! sea ice thickness - sicanl(i) = sicclm(i) ! sea ice concentration -!clu [+4l] add vmn, vmx, slp, abs - vmnanl(i) = vmnclm(i) ! min vegetation cover - vmxanl(i) = vmxclm(i) ! max vegetation cover - slpanl(i) = slpclm(i) ! slope type - absanl(i) = absclm(i) ! max snow albedo - enddo -! - do j=1,lsoil - do i=1,len - smcanl(i,j) = smcclm(i,j) ! layer soil wetness - stcanl(i,j) = stcclm(i,j) ! soil temperature - enddo - enddo - do j=1,4 - do i=1,len - albanl(i,j) = albclm(i,j) ! albedo - enddo - enddo - do j=1,2 - do i=1,len - alfanl(i,j) = alfclm(i,j) ! vegetation fraction for albedo - enddo - enddo -! - return - end - -!> Read analysis fields. -!! -!! @param[in] lugb Fortran unit number for analysis files. -!! @param[in] iy Cycle year. -!! @param[in] im Cycle month. -!! @param[in] id Cycle day. -!! @param[in] ih Cycle hour. -!! @param[in] fh Forecast hour. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[in] slmask Model land-sea mask. -!! @param[in] fntsfa SST analysis file. -!! @param[in] fnweta Soil wetness analysis file. -!! @param[in] fnsnoa Snow analysis file -!! @param[in] fnzora Roughness length analysis file. -!! @param[in] fnalba Snow-free albedo analysis file. -!! @param[in] fnaisa Sea ice mask analysis file. -!! @param[in] fntg3a Soil substrate analysis file. -!! @param[in] fnscva Snow cover analysis file. -!! @param[in] fnsmca Soil moisture analysis file. -!! @param[in] fnstca Soil temperature analysis file. -!! @param[in] fnacna Sea ice concentration analysis file. -!! @param[in] fnvega Vegetation greenness analysis file. -!! @param[in] fnveta Vegetation type analysis file. -!! @param[in] fnsota Soil type analysis file. -!! @param[in] fnvmna Minimum vegetation greenness analysis file. -!! @param[in] fnvmxa Maximum vegetation greenness analysis file. -!! @param[in] fnslpa Slope type analysis file. -!! @param[in] fnabsa Maximum snow albedo analysis file. -!! @param[out] tsfanl Skin temperature/SST analysis on model grid. -!! @param[out] wetanl Soil wetness analysis on model grid. -!! @param[out] snoanl Snow analysis on model grid. -!! @param[out] zoranl Roughness length analysis on model grid. -!! @param[out] albanl Snow-free albedo analysis on model grid. -!! @param[out] aisanl Sea ice mask analysis on model grid. -!! @param[out] tg3anl Soil substrate analysis on model grid. -!! @param[out] cvanl Convective cloud cover analysis on model grid. -!! @param[out] cvbanl Convective cloud base analysis on model grid. -!! @param[out] cvtanl Convective cloud top analysis on model grid. -!! @param[out] smcanl Soil moisture analysis on model grid. -!! @param[out] stcanl Soil temperature analysis on model grid. -!! @param[out] slianl Not used. -!! @param[out] scvanl Snow cover analysis on model grid. -!! @param[out] acnanl Sea ice concentration analysis on model grid. -!! @param[out] veganl Vegetation greenness analysis on model grid. -!! @param[out] vetanl Vegetation type analysis on model grid. -!! @param[out] sotanl Soil type analysis on model grid. -!! @param[out] alfanl Analysis of fraction for strongly and -!! weakly zenith angle dependent albedo on model grid. -!! @param[out] tsfan0 SST analysis at forecast hour 0 on model grid. -!! @param[out] vmnanl Minimum vegetation greenness analysis on model -!! grid. -!! @param[out] vmxanl Maximum vegetation greenness analysis on model -!! grid. -!! @param[out] slpanl Slope type analysis on model grid. -!! @param[out] absanl Maximum snow albedo analysis on model grid. -!! @param[in] kpdtsf Grib parameter number of skin temperature/SST. -!! @param[in] kpdwet Grib parameter number of soil wetness. -!! @param[in] kpdsno Grib parameter number of liquid equivalent snow -!! depth. -!! @param[in] kpdsnd Grib parameter number of physical snow depth. -!! @param[in] kpdzor Grib parameter number of roughness length. -!! @param[in] kpdalb Grib parameter number of snow-free albedo. -!! @param[in] kpdais Grib parameter number of sea ice mask. -!! @param[in] kpdtg3 Grib parameter number of soil substrate -!! temperature. -!! @param[in] kpdscv Grib parameter number of snow cover. -!! @param[in] kpdacn Grib parameter number of sea ice concentration. -!! @param[in] kpdsmc Grib parameter number of soil moisture. -!! @param[in] kpdstc Grib parameter number of soil temperature. -!! @param[in] kpdveg Grib parameter number of vegetation greenness. -!! @param[in] kprvet Grib parameter number of vegetation type. -!! @param[in] kpdsot Grib parameter number of soil type. -!! @param[in] kpdalf Grib parameter number for fraction for strongly -!! and weakly zenith angle dependent albedo. -!! @param[in] kpdvmn Grib parameter number of minimum vegetation -!! greenness. -!! @param[in] kpdvmx Grib parameter number of maximum vegetation -!! greenness. -!! @param[in] kpdslp Grib parameter number of slope type. -!! @param[in] kpdabs Grib parameter number of maximum snow albedo. -!! @param[out] irttsf Return code from read of skin temperature/SST -!! analysis file. -!! @param[out] irtwet Return code from read of soil wetness analysis -!! file. -!! @param[out] irtsno Return code from read of snow analysis file. -!! @param[out] irtzor Return code from read of roughness length file. -!! @param[out] irtalb Return code from read of snow-free albedo analysis file. -!! @param[out] irtais Return code from read of ice mask analysis file. -!! @param[out] irttg3 Return code from read of soil substrate -!! temperature analysis file. -!! @param[out] irtscv Return code from read of snow cover analysis file. -!! @param[out] irtacn Return code from read of sea ice concentration -!! analysis file. -!! @param[out] irtsmc Return code from read of soil moisture analysis -!! file. -!! @param[out] irtstc Return code from read of soil temperature analysis -!! file. -!! @param[out] irtveg Return code from read of vegetation greenness -!! analysis file. -!! @param[out] irtvet Return code from read of vegetation type analysis -!! file. -!! @param[out] irtsot Return code from read of soil type analysis file. -!! @param[out] irtalf Return code from read of file containing fraction -!! for strongly and weakly zenith angle dependent albedo. -!! @param[out] irtvmn Return code from read of minimum vegetation -!! greenness analysis file. -!! @param[out] irtvmx Return code from read of maximum vegetation -!! greenness analysis file. -!! @param[out] irtslp Return code from read of slope type analysis file. -!! @param[out] irtabs Return code from read of maximum snow albedo -!! analysis file. -!! @param[in] imsk 'i' dimension of the high-res mask used for -!! analysis data without a bitmap. -!! @param[in] jmsk 'j' dimension of the high-res mask used for -!! analysis data without a bitmap. -!! @param[in] slmskh The high-resolution mask used for -!! analysis data without a bitmap. -!! @param[in] outlat Model latitudes -!! @param[in] outlon Model longitudes -!! @param[in] gaus When true, the high-res mask is on a gaussian grid. -!! @param[in] blno Corner point longitude of the high-res mask. -!! @param[in] blto Corner point latitude of the high-res mask. -!! @param[in] me MPI task number. -!! @param[in] lanom When true, do sst anomaly interpolation. -!! @author Shrinivas Moorthi - subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, - & slmask,fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, - & fnveta,fnsota, - & fnvmna,fnvmxa,fnslpa,fnabsa, - & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & smcanl,stcanl,slianl,scvanl,acnanl,veganl, - & vetanl,sotanl,alfanl,tsfan0, - & vmnanl,vmxanl,slpanl,absanl, - & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais, - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kprvet,kpdsot,kpdalf, - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvet,irtsot,irtalf - &, irtvmn,irtvmx,irtslp,irtabs - &, imsk, jmsk, slmskh, outlat, outlon - &, gaus, blno, blto, me, lanom) - use machine , only : kind_io8,kind_io4 - implicit none - logical lanom - integer irtsmc,irtacn,irtstc,irtvet,irtveg,irtscv,irtzor,irtsno, - & irtalb,irttg3,irtais,iret,me,kk,kpdvet,i,irtalf,irtsot, -!cggg snow mods start & imsk,jmsk,irtwet,lsoil,len, kpdtsf,kpdsno,kpdwet,iy, - & imsk,jmsk,irtwet,lsoil,len,kpdtsf,kpdsno,kpdsnd,kpdwet,iy, -!cggg snow mods end - & lugb,im,ih,id,kpdveg,kpdstc,kprvet,irttsf,kpdsot,kpdsmc, - & kpdais,kpdzor,kpdtg3,kpdacn,kpdscv,j -!clu [+1l] add kpd() and irt() for vmn, vmx, slp, abs - &, kpdvmn,kpdvmx,kpdslp,kpdabs,irtvmn,irtvmx,irtslp,irtabs - real (kind=kind_io8) blto,blno,fh -! - real (kind=kind_io8) slmask(len) - real (kind=kind_io8) slmskh(imsk,jmsk) - real (kind=kind_io8) outlat(len), outlon(len) - integer kpdalb(4), kpdalf(2) -!cggg snow mods start - integer kpds(1000),kgds(1000),jpds(1000),jgds(1000) - integer lugi, lskip, lgrib, ndata -!cggg snow mods end -! - character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, - & fnveta,fnsota -!clu [+1l] add fn()a for vmn, vmx, slp, abs - &, fnvmna,fnvmxa,fnslpa,fnabsa - - real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & tg3anl(len), acnanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & slianl(len), scvanl(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2), - & smcanl(len,lsoil), stcanl(len,lsoil), - & tsfan0(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs - &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) -! - logical gaus -! -! tsf -! - irttsf = 1 - if(fntsfa(1:8).ne.' ') then - call fixrda(lugb,fntsfa,kpdtsf,slmask, - & iy,im,id,ih,fh,tsfanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irttsf = iret - if(iret == 1) then - write(6,*) 'FATAL ERROR: t surface analysis read error.' - call abort - elseif(iret == -1) then - if (me == 0) then - print *,'old t surface analysis provided, indicating proper' - &, ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me == 0) print *,'t surface analysis provided.' - endif - else - if (me == 0) then -! print *,'************************************************' - print *,'no tsf analysis available. climatology used' - endif - endif -! -! tsf0 -! - if(fntsfa(1:8).ne.' ' .and. lanom) then - call fixrda(lugb,fntsfa,kpdtsf,slmask, - & iy,im,id,ih,0.,tsfan0,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - if(iret == 1) then - write(6,*) 'FATAL ERROR: t surface at ft=0 analysis' - write(6,*) 'read error.' - call abort - elseif(iret == -1) then - if (me == 0) then - write(6,*) 'FATAL ERROR: Could not find t surface' - write(6,*) 'analysis at ft=0.' - endif - call abort - else - print *,'t surface analysis at ft=0 found.' - endif - else - do i=1,len - tsfan0(i)=-999.9 - enddo - endif -! -! albedo -! - irtalb=0 - if(fnalba(1:8).ne.' ') then - do kk = 1, 4 - call fixrda(lugb,fnalba,kpdalb(kk),slmask, - & iy,im,id,ih,fh,albanl(1,kk),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtalb=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: Albedo analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old albedo analysis provided, indicating proper', - & ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0 .and. kk .eq. 4) - & print *,'albedo analysis provided.' - endif - enddo - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no albedo analysis available. climatology used' - endif - endif -! -! vegetation fraction for albedo -! - irtalf=0 - if(fnalba(1:8).ne.' ') then - do kk = 1, 2 - call fixrda(lugb,fnalba,kpdalf(kk),slmask, - & iy,im,id,ih,fh,alfanl(1,kk),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtalf=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: Albedo analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old albedo analysis provided, indicating proper', - & ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0 .and. kk .eq. 4) - & print *,'albedo analysis provided.' - endif - enddo - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no vegfalbedo analysis available. climatology used' - endif - endif -! -! soil wetness -! - irtwet=0 - irtsmc=0 - if(fnweta(1:8).ne.' ') then - call fixrda(lugb,fnweta,kpdwet,slmask, - & iy,im,id,ih,fh,wetanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtwet=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: Bucket wetness analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old wetness analysis provided, indicating proper', - & ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'bucket wetness analysis provided.' - endif - elseif(fnsmca(1:8).ne.' ') then - call fixrda(lugb,fnsmca,kpdsmc,slmask, - & iy,im,id,ih,fh,smcanl(1,1),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - call fixrda(lugb,fnsmca,kpdsmc,slmask, - & iy,im,id,ih,fh,smcanl(1,2),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtsmc=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: Layer soil wetness analysis' - write(6,*) 'read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old layer soil wetness analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'layer soil wetness analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no soil wetness analysis available. climatology used' - endif - endif -! -! read in snow depth/snow cover -! - irtscv=0 - if(fnsnoa(1:8).ne.' ') then - do i=1,len - scvanl(i)=0. - enddo -!cggg snow mods start -!cggg need to determine if the snow data is on the gaussian grid -!cggg or not. if gaussian, then data is a depth, not liq equiv -!cggg depth. if not gaussian, then data is from hua-lu's -!cggg program and is a liquid equiv. need to communicate -!cggg this to routine fixrda via the 3rd argument which is -!cggg the grib parameter id number. - call baopenr(lugb,fnsnoa,iret) - if (iret .ne. 0) then - write(6,*) 'FATAL ERROR: in opening file ',trim(fnsnoa) - print *,'FATAL ERROR: in opening file ',trim(fnsnoa) - call abort - endif - lugi=0 - lskip=-1 - jpds=-1 - jgds=-1 - kpds=jpds - call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, - & lskip,kpds,kgds,iret) - close(lugb) - if (iret .ne. 0) then - write(6,*) ' FATAL ERROR: Reading header' - write(6,*) ' of file: ',trim(fnsnoa) - print *,'FATAL ERROR: Reading header of file: ',trim(fnsnoa) - call abort - endif - if (kgds(1) == 4) then ! gaussian data is depth - call fixrda(lugb,fnsnoa,kpdsnd,slmask, - & iy,im,id,ih,fh,snoanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - snoanl=snoanl*100. ! convert from meters to liq. eq. - ! depth in mm using 10:1 ratio - else ! lat/lon data is liq equv. depth - call fixrda(lugb,fnsnoa,kpdsno,slmask, - & iy,im,id,ih,fh,snoanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - endif -!cggg snow mods end - irtscv=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: snow depth analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old snow depth analysis provided, indicating proper', - & ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'snow depth analysis provided.' - endif - irtsno=0 - elseif(fnscva(1:8).ne.' ') then - do i=1,len - snoanl(i)=0. - enddo - call fixrda(lugb,fnscva,kpdscv,slmask, - & iy,im,id,ih,fh,scvanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtsno=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: snow cover analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old snow cover analysis provided, indicating proper', - & ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'snow cover analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no snow/snocov analysis available. climatology used' - endif - endif -! -! sea ice mask -! - irtacn=0 - irtais=0 - if(fnacna(1:8).ne.' ') then - call fixrda(lugb,fnacna,kpdacn,slmask, - & iy,im,id,ih,fh,acnanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtacn=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: ice concentration' - write(6,*) 'analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old ice concentration analysis provided', - & ' indicating proper file name is given' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'ice concentration analysis provided.' - endif - elseif(fnaisa(1:8).ne.' ') then - call fixrda(lugb,fnaisa,kpdais,slmask, - & iy,im,id,ih,fh,aisanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtais=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: ice mask analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old ice-mask analysis provided, indicating proper', - & ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'ice mask analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no sea-ice analysis available. climatology used' - endif - endif -! -! surface roughness -! - irtzor=0 - if(fnzora(1:8).ne.' ') then - call fixrda(lugb,fnzora,kpdzor,slmask, - & iy,im,id,ih,fh,zoranl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtzor=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: roughness analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old roughness analysis provided, indicating proper', - & ' file name is given. no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'roughness analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no srfc roughness analysis available. climatology used' - endif - endif -! -! deep soil temperature -! - irttg3=0 - irtstc=0 - if(fntg3a(1:8).ne.' ') then - call fixrda(lugb,fntg3a,kpdtg3,slmask, - & iy,im,id,ih,fh,tg3anl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irttg3=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: deep soil tmp analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old deep soil temp analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'deep soil tmp analysis provided.' - endif - elseif(fnstca(1:8).ne.' ') then - call fixrda(lugb,fnstca,kpdstc,slmask, - & iy,im,id,ih,fh,stcanl(1,1),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - call fixrda(lugb,fnstca,kpdstc,slmask, - & iy,im,id,ih,fh,stcanl(1,2),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtstc=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: layer soil tmp analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old deep soil temp analysis provided', - & 'iindicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'layer soil tmp analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no deep soil temp analy available. climatology used' - endif - endif -! -! vegetation cover -! - irtveg=0 - if(fnvega(1:8).ne.' ') then - call fixrda(lugb,fnvega,kpdveg,slmask, - & iy,im,id,ih,fh,veganl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtveg=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: vegetation cover analysis' - write(6,*) 'read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old vegetation cover analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'vegetation cover analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no vegetation cover anly available. climatology used' - endif - endif -! -! vegetation type -! - irtvet=0 - if(fnveta(1:8).ne.' ') then - call fixrda(lugb,fnveta,kpdvet,slmask, - & iy,im,id,ih,fh,vetanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtvet=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: vegetation type analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old vegetation type analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'vegetation type analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no vegetation type anly available. climatology used' - endif - endif -! -! soil type -! - irtsot=0 - if(fnsota(1:8).ne.' ') then - call fixrda(lugb,fnsota,kpdsot,slmask, - & iy,im,id,ih,fh,sotanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtsot=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: soil type analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old soil type analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'soil type analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no soil type anly available. climatology used' - endif - endif - -!clu [+120l]-------------------------------------------------------------- -! -! min vegetation cover -! - irtvmn=0 - if(fnvmna(1:8).ne.' ') then - call fixrda(lugb,fnvmna,kpdvmn,slmask, - & iy,im,id,ih,fh,vmnanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtvmn=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: shdmin analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old shdmin analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'shdmin analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no shdmin anly available. climatology used' - endif - endif - -! -! max vegetation cover -! - irtvmx=0 - if(fnvmxa(1:8).ne.' ') then - call fixrda(lugb,fnvmxa,kpdvmx,slmask, - & iy,im,id,ih,fh,vmxanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtvmx=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: shdmax analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old shdmax analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'shdmax analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no shdmax anly available. climatology used' - endif - endif - -! -! slope type -! - irtslp=0 - if(fnslpa(1:8).ne.' ') then - call fixrda(lugb,fnslpa,kpdslp,slmask, - & iy,im,id,ih,fh,slpanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtslp=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: slope type analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old slope type analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'slope type analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no slope type anly available. climatology used' - endif - endif - -! -! max snow albedo -! - irtabs=0 - if(fnabsa(1:8).ne.' ') then - call fixrda(lugb,fnabsa,kpdabs,slmask, - & iy,im,id,ih,fh,absanl,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - irtabs=iret - if(iret.eq.1) then - write(6,*) 'FATAL ERROR: snoalb analysis read error.' - call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then - print *,'old snoalb analysis provided', - & ' indicating proper file name is given.' - print *,' no error suspected.' - write(6,*) 'forecast guess will be used' - endif - else - if (me .eq. 0) print *,'snoalb analysis provided.' - endif - else - if (me .eq. 0) then -! print *,'************************************************' - print *,'no snoalb anly available. climatology used' - endif - endif - -!clu ---------------------------------------------------------------------- -! - return - end - -!> Fill in model grid guess arrays with analysis values if this is a dead start. -!! All fields are on the model grid. -!! -!! @param[out] tsffcs First guess skin temperature/SST analysis. -!! @param[out] wetfcs First guess soil wetness. -!! @param[out] snofcs First guess liquid equivalent snow depth. -!! @param[out] zorfcs First guess roughness length. -!! @param[out] albfcs First guess snow-free albedo. -!! @param[out] tg3fcs First guess soil substrate temperature. -!! @param[out] cvfcs First guess cloud cover. -!! @param[out] cvbfcs First guess convective cloud bottom. -!! @param[out] cvtfcs First guess convective cloud top. -!! @param[out] cnpfcs First guess canopy water content. -!! @param[out] smcfcs First guess soil moisture. -!! @param[out] stcfcs First guess soil temperature. -!! @param[out] slifcs First guess land-sea-ice mask. -!! @param[out] aisfcs First guess sea ice mask. -!! @param[out] vegfcs First guess vegetation greenness. -!! @param[out] vetfcs First guess vegetation type. -!! @param[out] sotfcs First guess soil type. -!! @param[out] alffcs First guess of fraction for strongly and -!! weakly zenith angle dependent albedo. -!! @param[out] sihfcs First guess sea ice depth. -!! @param[out] sicfcs First guess sea ice concentration. -!! @param[out] vmnfcs First guess minimum greenness fraction. -!! @param[out] vmxfcs First guess maximum greenness fraction. -!! @param[out] slpfcs First guess slope type. -!! @param[out] absfcs First guess maximum snow albedo analysis. -!! @param[in] tsfanl Skin temperature/SST analysis. -!! @param[in] wetanl Soil wetness analysis. -!! @param[in] snoanl Liquid equivalent snow depth analysis. -!! @param[in] zoranl Roughness length analysis. -!! @param[in] albanl Snow-free albedo analysis. -!! @param[in] tg3anl Soil substrate temperature analysis. -!! @param[in] cvanl Convective cloud cover analysis. -!! @param[in] cvbanl Convective cloud base analysis. -!! @param[in] cvtanl Convective cloud top analysis. -!! @param[in] cnpanl Canopy water content analysis. -!! @param[in] smcanl Soil moisture analysis. -!! @param[in] stcanl Soil temperature analysis. -!! @param[in] slianl Land-sea-ice mask analysis. -!! @param[in] aisanl Sea ice mask analysis. -!! @param[in] veganl Vegetation greenness analysis. -!! @param[in] vetanl Vegetation type analysis. -!! @param[in] sotanl Soil type analysis. -!! @param[in] alfanl Analysis of fraction for strongly and weakly -!! zenith angle dependent albedo. -!! @param[in] sihanl Sea ice depth analysis. -!! @param[in] sicanl Sea ice concentration analysis. -!! @param[in] vmnanl Minimum greenness fraction analysis. -!! @param[in] vmxanl Maximum greenness fraction analysis. -!! @param[in] slpanl Slope type analysis. -!! @param[in] absanl Maximum snow albedo analysis. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @author Shrinivas Moorthi - subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, - & tg3fcs,cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, - & vegfcs, vetfcs, sotfcs, alffcs, - & sihfcs,sicfcs, - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsfanl,wetanl,snoanl,zoranl,albanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,aisanl, - & veganl, vetanl, sotanl, alfanl, - & sihanl,sicanl, - & vmnanl,vmxanl,slpanl,absanl, - & len,lsoil) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,j,len,lsoil - real (kind=kind_io8) tsffcs(len),wetfcs(len),snofcs(len), - & zorfcs(len),albfcs(len,4),aisfcs(len), - & tg3fcs(len), - & cvfcs (len),cvbfcs(len),cvtfcs(len), - & cnpfcs(len), - & smcfcs(len,lsoil),stcfcs(len,lsoil), - & slifcs(len),vegfcs(len), - & vetfcs(len),sotfcs(len),alffcs(len,2) -!cwu [+1l] add ()fcs for sih, sic - &, sihfcs(len),sicfcs(len) -!clu [+1l] add ()fcs for vmn, vmx, slp, abs - &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len) - real (kind=kind_io8) tsfanl(len),wetanl(len),snoanl(len), - & zoranl(len),albanl(len,4),aisanl(len), - & tg3anl(len), - & cvanl (len),cvbanl(len),cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len),veganl(len), - & vetanl(len),sotanl(len),alfanl(len,2) -!cwu [+1l] add ()anl for sih, sic - &, sihanl(len),sicanl(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs - &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) -! - write(6,*) ' this is a dead start run, tsfc over land is', - & ' set as lowest sigma level temperture if given.' - write(6,*) ' if not, set to climatological tsf over land is used' -! -! - do i=1,len - tsffcs(i) = tsfanl(i) ! tsf - albfcs(i,1) = albanl(i,1) ! albedo - albfcs(i,2) = albanl(i,2) ! albedo - albfcs(i,3) = albanl(i,3) ! albedo - albfcs(i,4) = albanl(i,4) ! albedo - wetfcs(i) = wetanl(i) ! soil wetness - snofcs(i) = snoanl(i) ! snow - aisfcs(i) = aisanl(i) ! seaice - slifcs(i) = slianl(i) ! land/sea/snow mask - zorfcs(i) = zoranl(i) ! surface roughness -! plrfcs(i) = plranl(i) ! maximum stomatal resistance - tg3fcs(i) = tg3anl(i) ! deep soil temperature - cnpfcs(i) = cnpanl(i) ! canopy water content - cvfcs(i) = cvanl(i) ! cv - cvbfcs(i) = cvbanl(i) ! cvb - cvtfcs(i) = cvtanl(i) ! cvt - vegfcs(i) = veganl(i) ! vegetation cover - vetfcs(i) = vetanl(i) ! vegetation type - sotfcs(i) = sotanl(i) ! soil type - alffcs(i,1) = alfanl(i,1) ! vegetation fraction for albedo - alffcs(i,2) = alfanl(i,2) ! vegetation fraction for albedo -!cwu [+2l] add sih, sic - sihfcs(i) = sihanl(i) ! sea ice thickness - sicfcs(i) = sicanl(i) ! sea ice concentration -!clu [+4l] add vmn, vmx, slp, abs - vmnfcs(i) = vmnanl(i) ! min vegetation cover - vmxfcs(i) = vmxanl(i) ! max vegetation cover - slpfcs(i) = slpanl(i) ! slope type - absfcs(i) = absanl(i) ! max snow albedo - enddo -! - do j=1,lsoil - do i=1,len - smcfcs(i,j) = smcanl(i,j) ! layer soil wetness - stcfcs(i,j) = stcanl(i,j) ! soil temperature - enddo - enddo -! - return - end - -!> Round a field up to one or down to zero. -!! -!! @param[inout] aisfld The field to adjust. -!! @param[in] len Number of model points to process. -!! @param[in] op Operation on field. -!! @param[in] crit Critical value above/below the -!! field is rounded. -!! @author Shrinivas Moorthi - subroutine rof01(aisfld,len,op,crit) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) aisfld(len),crit - character*2 op -! - if(op.eq.'ge') then - do i=1,len - if(aisfld(i).ge.crit) then - aisfld(i)=1. - else - aisfld(i)=0. - endif - enddo - elseif(op.eq.'gt') then - do i=1,len - if(aisfld(i).gt.crit) then - aisfld(i)=1. - else - aisfld(i)=0. - endif - enddo - elseif(op.eq.'le') then - do i=1,len - if(aisfld(i).le.crit) then - aisfld(i)=1. - else - aisfld(i)=0. - endif - enddo - elseif(op.eq.'lt') then - do i=1,len - if(aisfld(i).lt.crit) then - aisfld(i)=1. - else - aisfld(i)=0. - endif - enddo - else - write(6,*) 'FATAL ERROR: Illegal operator' - write(6,*) 'in rof01. op=',op - call abort - endif -! - return - end - -!> Adjust skin temperature or SST for terrain. -!! -!! @param[inout] tsfc Skin temperature/SST -!! @param[in] orog Orography height. -!! @param[in] slmask Model land-sea mask. -!! @param[in] umask When '0' adjust SST, when '1' adjust skin -!! temperature. -!! @param[in] len Number of model points to process. -!! @param[in] rlapse Standard atmospheric lapse rate. -!! @author Shrinivas Moorthi - subroutine tsfcor(tsfc,orog,slmask,umask,len,rlapse) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) rlapse,umask - real (kind=kind_io8) tsfc(len), orog(len), slmask(len) -! - do i=1,len - if(slmask(i).eq.umask) then - tsfc(i) = tsfc(i) - orog(i)*rlapse - endif - enddo - return - end - -!> Estimate snow depth at glacial, land and sea ice points. -!! -!! @param[in] scvanl Snow cover. -!! @param[in] slianl Land-sea-ice mask. -!! @param[in] tsfanl Skin temperature. -!! @param[in] snoclm Climatological snow depth. -!! @param[in] glacir Permanent glacial point when '1'. -!! @param[in] snwmax Maximum snow depth. -!! @param[in] snwmin Minimum snow depth. -!! @param[in] landice When true, point is permanent land ice. -!! @param[in] len Number of model points to process. -!! @param[out] snoanl Snow depth. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine snodpth(scvanl,slianl,tsfanl,snoclm, - & glacir,snwmax,snwmin,landice,len,snoanl, me) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,me,len - logical, intent(in) :: landice - real (kind=kind_io8) sno,snwmax,snwmin -! - real (kind=kind_io8) scvanl(len), slianl(len), tsfanl(len), - & snoclm(len), snoanl(len), glacir(len) -! - if (me .eq. 0) write(6,*) 'snodpth' -! -! use surface temperature to get snow depth estimate -! - do i=1,len - sno = 0.0 -! -! over land -! - if(slianl(i).eq.1.) then - if(scvanl(i).eq.1.0) then - if(tsfanl(i).lt.243.0) then - sno = snwmax - elseif(tsfanl(i).lt.273.0) then - sno = snwmin+(snwmax-snwmin)*(273.0-tsfanl(i))/30.0 - else - sno = snwmin - endif - endif -! -! if glacial points has snow in climatology, set sno to snomax -! - if (.not.landice) then - if(glacir(i).eq.1.0) then - sno = snoclm(i) - if(sno.eq.0.) sno=snwmax - endif - endif - endif -! -! over sea ice -! -! snow over sea ice is cycled as of 01/01/94.....hua-lu pan -! - if(slianl(i).eq.2.0) then - sno=snoclm(i) - if(sno.eq.0.) sno=snwmax - endif -! - snoanl(i) = sno - enddo - return - end subroutine snodpth - -!> Blend the model forecast (or first guess) fields with the -!! analysis/climatology. The forecast/first guess variables -!! are named with "fcs". The analysis/climatology variables -!! are named with "anl". On output, the blended fields are -!! stored in the "anl" variables. -!! -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[in] iy Cycle year. -!! @param[in] im Cycle month. -!! @param[in] id Cycle day. -!! @param[in] ih Cycle hour. -!! @param[in] fh Forecast hour. -!! @param[in] deltsfc Cycling frequency in hours. -!! @param[in] sihfcs First guess sea ice depth. -!! @param[in] sicfcs First guess sea ice concentration. -!! @param[in] vmnfcs First guess minimum vegetation greenness. -!! @param[in] vmxfcs First guess maximum vegetation greenness. -!! @param[in] slpfcs First guess slope type. -!! @param[in] absfcs First guess maximum snow albedo. -!! @param[in] tsffcs First guess skin temperature/SST. -!! @param[in] wetfcs First guess soil wetness. -!! @param[in] snofcs First guess liquid equivalent snow depth. -!! @param[in] zorfcs First guess roughness length. -!! @param[in] albfcs First guess snow free albedo. -!! @param[in] aisfcs First guess ice. -!! @param[in] cvfcs First guess convective cloud cover. -!! @param[in] cvbfcs First guess convective cloud bottom. -!! @param[in] cvtfcs First guess convective cloud top. -!! @param[in] cnpfcs First guess canopy water content. -!! @param[in] smcfcs First guess soil moisture. -!! @param[in] stcfcs First guess soil/ice temperature. -!! @param[in] slifcs First guess land-sea-ice mask. -!! @param[in] vegfcs First guess vegetation greenness. -!! @param[in] vetfcs First guess vegetation type. -!! @param[in] sotfcs First guess soil type. -!! @param[in] alffcs First guess strong/weak zenith angle -!! dependent albedo. -!! @param[inout] sihanl Blended sea ice depth. -!! @param[inout] sicanl Blended sea ice concentration. -!! @param[inout] vmnanl Blended minimum vegetation greenness. -!! @param[inout] vmxanl Blended maximum vegetation greenness. -!! @param[inout] slpanl Blended slope type. -!! @param[inout] absanl Blended maximum snow albedo. -!! @param[inout] tsfanl Blended skin temperature/SST. -!! @param[inout] tsfan2 Not used. -!! @param[inout] wetanl Blended soil wetness. -!! @param[inout] snoanl Blended liquid equivalent snow depth. -!! @param[inout] zoranl Blended roughness length. -!! @param[inout] albanl Blended snow-free albedo. -!! @param[inout] aisanl Blended ice. -!! @param[inout] cvanl Blended convective cloud cover. -!! @param[inout] cvbanl Blended convective cloud base. -!! @param[inout] cvtanl Blended convective cloud top. -!! @param[inout] cnpanl Blended canopy moisture content. -!! @param[inout] smcanl Blended soil moisture. -!! @param[inout] stcanl Blended soil/ice temperature. -!! @param[inout] slianl Blended land-sea-ice mask. -!! @param[inout] veganl Blended vegetation greenness. -!! @param[inout] vetanl Blended vegetation type. -!! @param[inout] sotanl Blended soil type. -!! @param[inout] alfanl Blended strong/weak zenith angle -!! dependent albedo. -!! @param[in] ctsfl Merging coefficient for skin temperature. -!! @param[in] calbl Merging coefficient for snow-free albedo at land -!! points. -!! @param[in] caisl Merging coefficient for sea ice at land points. -!! @param[in] csnol Merging coefficient for snow at land points. -!! @param[in] csmcl Merging coefficient for soil moisture at land -!! points. -!! @param[in] czorl Merging coefficient for roughness length at land -!! points. -!! @param[in] cstcl Merging coefficient for soil temperature at land -!! points. -!! @param[in] cvegl Merging coefficient for vegetation greenness at land -!! points. -!! @param[in] ctsfs Merging coefficient for SST. -!! @param[in] calbs Merging coefficient for snow-free albedo at water -!! points. -!! @param[in] caiss Merging coefficient for sea ice at water points. -!! @param[in] csnos Merging coefficient for snow at water points. -!! @param[in] csmcs Merging coefficient for soil moisture at water -!! points. -!! @param[in] czors Merging coefficient for roughness length at water -!! points. -!! @param[in] cstcs Merging coefficient for sea ice temperature at water -!! points. -!! @param[in] cvegs Merging coefficient for vegetation greenness at -!! water points. -!! @param[in] ccv Merging coefficient for convective cloud cover. -!! @param[in] ccvb Merging coefficient for covective cloud bottom. -!! @param[in] ccvt Merging coefficient for covective cloud top. -!! @param[in] ccnp Merging coefficient for canopy moisture. -!! @param[in] cvetl Merging coefficient for vegetation type at land -!! points. -!! @param[in] cvets Merging coefficient for vegetation type at water -!! points. -!! @param[in] csotl Merging coefficient for soil type at land points. -!! @param[in] csots Merging coefficient for soil type at water points. -!! @param[in] calfl Merging coefficient for strong/weak zenith -!! angle dependent albedo at land points. -!! @param[in] calfs Merging coefficient for strong/weak zenith -!! angle dependent albedo at water points. -!! @param[in] csihl Merging coefficient for sea ice depth at land -!! points. -!! @param[in] csihs Merging coefficient for sea ice depth at water -!! points. -!! @param[in] csicl Merging coefficient for sea ice concentration at -!! land points. -!! @param[in] csics Merging coefficient for sea ice concentration at -!! water points. -!! @param[in] cvmnl Merging coefficient for minimum vegetation greenness -!! at land points. -!! @param[in] cvmns Merging coefficient for minimum vegetation greenness -!! at water points. -!! @param[in] cvmxl Merging coefficient for maximum vegetation greenness -!! at land points. -!! @param[in] cvmxs Merging coefficient for maximum vegetation greenness -!! at water points. -!! @param[in] cslpl Merging coefficient for slope type at land points. -!! @param[in] cslps Merging coefficient for slope type at water points. -!! @param[in] cabsl Merging coefficient for maximum snow albedo at land -!! points. -!! @param[in] cabss Merging coefficient for maximum snow albedo at -!! water points. -!! @param[in] irttsf Return code from read of skin temperature/SST -!! analysis file. -!! @param[in] irtwet Return code from read of soil wetness analysis -!! file. -!! @param[in] irtsno Return code from read of snow analysis file. -!! @param[in] irtzor Return code from read of roughness length file. -!! @param[in] irtalb Return code from read of snow-free albedo analysis file. -!! @param[in] irtais Return code from read of ice mask analysis file. -!! @param[in] irttg3 Return code from read of soil substrate -!! temperature analysis file. -!! @param[in] irtscv Return code from read of snow cover analysis file. -!! @param[in] irtacn Return code from read of sea ice concentration -!! analysis file. -!! @param[in] irtsmc Return code from read of soil moisture analysis -!! file. -!! @param[in] irtstc Return code from read of soil temperature analysis -!! file. -!! @param[in] irtveg Return code from read of vegetation greenness -!! analysis file. -!! @param[in] irtvmn Return code from read of minimum vegetation -!! greenness analysis file. -!! @param[in] irtvmx Return code from read of maximum vegetation -!! greenness analysis file. -!! @param[in] irtslp Return code from read of slope type analysis file. -!! @param[in] irtabs Return code from read of maximum snow albedo -!! analysis file. -!! @param[in] irtvet Return code from read of vegetation type analysis -!! file. -!! @param[in] irtsot Return code from read of soil type analysis file. -!! @param[in] irtalf Return code from read of file containing fraction -!! for strongly and weakly zenith angle dependent albedo. -!! @param[in] landice Permanent land ice flag. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, - & sihfcs,sicfcs, - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs, - & cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs, - & vetfcs,sotfcs,alffcs, - & sihanl,sicanl, - & vmnanl,vmxanl,slpanl,absanl, - & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl, - & cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,veganl, - & vetanl,sotanl,alfanl, - & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl, - & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs, - & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots, - & calfl,calfs, - & csihl,csihs,csicl,csics, - & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvmn,irtvmx,irtslp,irtabs, - & irtvet,irtsot,irtalf, landice, me) - use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : veg_type_landice, soil_type_landice - implicit none - integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, - & irttg3,irtstc,irtalf,me,irtsot,irtveg,irtvet, irtzor, - & irtalb,irtsno,irttsf,irtwet,j - &, irtvmn,irtvmx,irtslp,irtabs - logical, intent(in) :: landice - real (kind=kind_io8) rvegs,rvets,rzors,raiss,rsnos,rsots,rcnp, - & rcvt,rcv,rcvb,rsnol,rzorl,raisl,ralbl, - & ralfl,rvegl,ralbs,ralfs,rtsfs,rvetl,rsotl, - & qzors,qvegs,qsnos,qalfs,qaiss,qvets,qcvt, - & qcnp,qcvb,qsots,qcv,qaisl,qsnol,qalfl, - & qtsfl,qalbl,qzorl,qtsfs,qalbs,qsotl,qvegl, - & qvetl,rtsfl,calbs,caiss,ctsfs,czorl,cvegl, - & csnos,ccvb,ccvt,ccv,czors,cvegs,caisl,csnol, - & calbl,fh,ctsfl,ccnp,csots,calfl,csotl,cvetl, - & cvets,calfs,deltsfc, - & csihl,csihs,csicl,csics, - & rsihl,rsihs,rsicl,rsics, - & qsihl,qsihs,qsicl,qsics - &, cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps - &, cabsl,cabss,rvmnl,rvmns,rvmxl,rvmxs - &, rslpl,rslps,rabsl,rabss,qvmnl,qvmns - &, qvmxl,qvmxs,qslpl,qslps,qabsl,qabss -! - real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), - & zorfcs(len), albfcs(len,4), aisfcs(len), - & cvfcs (len), cvbfcs(len), cvtfcs(len), - & cnpfcs(len), - & smcfcs(len,lsoil),stcfcs(len,lsoil), - & slifcs(len), vegfcs(len), - & vetfcs(len), sotfcs(len), alffcs(len,2) - &, sihfcs(len), sicfcs(len) - &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len) - real (kind=kind_io8) tsfanl(len),tsfan2(len), - & wetanl(len),snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2) - &, sihanl(len),sicanl(len) - &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) -! - real (kind=kind_io8) csmcl(lsoil), csmcs(lsoil), - & cstcl(lsoil), cstcs(lsoil) - real (kind=kind_io8) rsmcl(lsoil), rsmcs(lsoil), - & rstcl(lsoil), rstcs(lsoil) - real (kind=kind_io8) qsmcl(lsoil), qsmcs(lsoil), - & qstcl(lsoil), qstcs(lsoil) - logical first - integer num_threads - data first /.true./ - save num_threads, first -! - integer len_thread_m, i1_t, i2_t, it - integer num_parthds -! - if (first) then - num_threads = num_parthds() - first = .false. - endif -! -! coeeficients of blending forecast and interpolated clim -! (or analyzed) fields over sea or land(l) (not for clouds) -! 1.0 = use of forecast -! 0.0 = replace with interpolated analysis -! -! merging coefficients are defined by parameter statement in calling program -! and therefore they should not be modified in this program. -! - rtsfl = ctsfl - ralbl = calbl - ralfl = calfl - raisl = caisl - rsnol = csnol -!clu rsmcl = csmcl - rzorl = czorl - rvegl = cvegl - rvetl = cvetl - rsotl = csotl - rsihl = csihl - rsicl = csicl - rvmnl = cvmnl - rvmxl = cvmxl - rslpl = cslpl - rabsl = cabsl -! - rtsfs = ctsfs - ralbs = calbs - ralfs = calfs - raiss = caiss - rsnos = csnos -! rsmcs = csmcs - rzors = czors - rvegs = cvegs - rvets = cvets - rsots = csots - rsihs = csihs - rsics = csics - rvmns = cvmns - rvmxs = cvmxs - rslps = cslps - rabss = cabss -! - rcv = ccv - rcvb = ccvb - rcvt = ccvt - rcnp = ccnp -! - do k=1,lsoil - rsmcl(k) = csmcl(k) - rsmcs(k) = csmcs(k) - rstcl(k) = cstcl(k) - rstcs(k) = cstcs(k) - enddo - if (fh-deltsfc < -0.001 .and. irttsf == 1) then - rtsfs = 1.0 - rtsfl = 1.0 -! do k=1,lsoil -! rsmcl(k) = 1.0 -! rsmcs(k) = 1.0 -! rstcl(k) = 1.0 -! rstcs(k) = 1.0 -! enddo - endif -! -! if analysis file name is given but no matching analysis date found, -! use guess (these are flagged by irt???=1). -! - if(irttsf == -1) then - rtsfl = 1. - rtsfs = 1. - endif - if(irtalb == -1) then - ralbl = 1. - ralbs = 1. - ralfl = 1. - ralfs = 1. - endif - if(irtais == -1) then - raisl = 1. - raiss = 1. - endif - if(irtsno == -1 .or. irtscv == -1) then - rsnol = 1. - rsnos = 1. - endif - if(irtsmc == -1 .or. irtwet == -1) then -! rsmcl = 1. -! rsmcs = 1. - do k=1,lsoil - rsmcl(k) = 1. - rsmcs(k) = 1. - enddo - endif - if(irtstc.eq.-1) then - do k=1,lsoil - rstcl(k) = 1. - rstcs(k) = 1. - enddo - endif - if(irtzor == -1) then - rzorl = 1. - rzors = 1. - endif - if(irtveg == -1) then - rvegl = 1. - rvegs = 1. - endif - if(irtvet.eq.-1) then - rvetl = 1. - rvets = 1. - endif - if(irtsot == -1) then - rsotl = 1. - rsots = 1. - endif - - if(irtacn == -1) then - rsicl = 1. - rsics = 1. - endif - if(irtvmn == -1) then - rvmnl = 1. - rvmns = 1. - endif - if(irtvmx == -1) then - rvmxl = 1. - rvmxs = 1. - endif - if(irtslp == -1) then - rslpl = 1. - rslps = 1. - endif - if(irtabs == -1) then - rabsl = 1. - rabss = 1. - endif -! - if(raiss == 1. .or. irtacn == -1) then - if (me == 0) print *,'use forecast land-sea-ice mask' - do i = 1, len - aisanl(i) = aisfcs(i) - slianl(i) = slifcs(i) - enddo - endif -! - if (me == 0) then - write(6,100) rtsfl,ralbl,raisl,rsnol,rsmcl,rzorl,rvegl - 100 format('rtsfl,ralbl,raisl,rsnol,rsmcl,rzorl,rvegl=',10f7.3) - write(6,101) rtsfs,ralbs,raiss,rsnos,rsmcs,rzors,rvegs - 101 format('rtsfs,ralbs,raiss,rsnos,rsmcs,rzors,rvegs=',10f7.3) -! print *,' ralfl=',ralfl,' ralfs=',ralfs,' rsotl=',rsotl -! *,' rsots=',rsots,' rvetl=',rvetl,' rvets=',rvets - endif -! - qtsfl = 1. - rtsfl - qalbl = 1. - ralbl - qalfl = 1. - ralfl - qaisl = 1. - raisl - qsnol = 1. - rsnol -! qsmcl = 1. - rsmcl - qzorl = 1. - rzorl - qvegl = 1. - rvegl - qvetl = 1. - rvetl - qsotl = 1. - rsotl - qsihl = 1. - rsihl - qsicl = 1. - rsicl - qvmnl = 1. - rvmnl - qvmxl = 1. - rvmxl - qslpl = 1. - rslpl - qabsl = 1. - rabsl -! - qtsfs = 1. - rtsfs - qalbs = 1. - ralbs - qalfs = 1. - ralfs - qaiss = 1. - raiss - qsnos = 1. - rsnos -! qsmcs = 1. - rsmcs - qzors = 1. - rzors - qvegs = 1. - rvegs - qvets = 1. - rvets - qsots = 1. - rsots - qsihs = 1. - rsihs - qsics = 1. - rsics - qvmns = 1. - rvmns - qvmxs = 1. - rvmxs - qslps = 1. - rslps - qabss = 1. - rabss -! - qcv = 1. - rcv - qcvb = 1. - rcvb - qcvt = 1. - rcvt - qcnp = 1. - rcnp -! - do k=1,lsoil - qsmcl(k) = 1. - rsmcl(k) - qsmcs(k) = 1. - rsmcs(k) - qstcl(k) = 1. - rstcl(k) - qstcs(k) = 1. - rstcs(k) - enddo -! -! merging -! - if(me .eq. 0) then - print *, 'dbgx-- csmcl:', (csmcl(k),k=1,lsoil) - print *, 'dbgx-- rsmcl:', (rsmcl(k),k=1,lsoil) - print *, 'dbgx-- csnol, csnos:',csnol,csnos - print *, 'dbgx-- rsnol, rsnos:',rsnol,rsnos - endif - -! print *, rtsfs, qtsfs, raiss , qaiss -! *, rsnos , qsnos, rzors , qzors, rvegs , qvegs -! *, rvets , qvets, rsots , qsots -! *, rcv, rcvb, rcvt, qcv, qcvb, qcvt -! *, ralbs, qalbs, ralfs, qalfs -! print *, rtsfl, qtsfl, raisl , qaisl -! *, rsnol , qsnol, rzorl , qzorl, rvegl , qvegl -! *, rvetl , qvetl, rsotl , qsotl -! *, ralbl, qalbl, ralfl, qalfl -! -! - len_thread_m = (len+num_threads-1) / num_threads - -!$omp parallel do private(i1_t,i2_t,it,i) - do it=1,num_threads ! start of threaded loop ................... - i1_t = (it-1)*len_thread_m+1 - i2_t = min(i1_t+len_thread_m-1,len) - do i=i1_t,i2_t - if(slianl(i).eq.0.) then - vetanl(i) = vetfcs(i)*rvets + vetanl(i)*qvets - sotanl(i) = sotfcs(i)*rsots + sotanl(i)*qsots - else - vetanl(i) = vetfcs(i)*rvetl + vetanl(i)*qvetl - sotanl(i) = sotfcs(i)*rsotl + sotanl(i)*qsotl - endif - enddo - enddo -!$omp end parallel do -! -!$omp parallel do private(i1_t,i2_t,it,i,k) -! - do it=1,num_threads ! start of threaded loop ................... - i1_t = (it-1)*len_thread_m+1 - i2_t = min(i1_t+len_thread_m-1,len) -! - do i=i1_t,i2_t - if(slianl(i).eq.0.) then -!.... tsffc2 is the previous anomaly + today's climatology -! tsffc2 = (tsffcs(i)-tsfan2(i))+tsfanl(i) -! tsfanl(i) = tsffc2 *rtsfs+tsfanl(i)*qtsfs -! - tsfanl(i) = tsffcs(i)*rtsfs + tsfanl(i)*qtsfs -! albanl(i) = albfcs(i)*ralbs + albanl(i)*qalbs - aisanl(i) = aisfcs(i)*raiss + aisanl(i)*qaiss - snoanl(i) = snofcs(i)*rsnos + snoanl(i)*qsnos - - zoranl(i) = zorfcs(i)*rzors + zoranl(i)*qzors - veganl(i) = vegfcs(i)*rvegs + veganl(i)*qvegs - sihanl(i) = sihfcs(i)*rsihs + sihanl(i)*qsihs - sicanl(i) = sicfcs(i)*rsics + sicanl(i)*qsics - vmnanl(i) = vmnfcs(i)*rvmns + vmnanl(i)*qvmns - vmxanl(i) = vmxfcs(i)*rvmxs + vmxanl(i)*qvmxs - slpanl(i) = slpfcs(i)*rslps + slpanl(i)*qslps - absanl(i) = absfcs(i)*rabss + absanl(i)*qabss - else - tsfanl(i) = tsffcs(i)*rtsfl + tsfanl(i)*qtsfl -! albanl(i) = albfcs(i)*ralbl + albanl(i)*qalbl - aisanl(i) = aisfcs(i)*raisl + aisanl(i)*qaisl - if(rsnol.ge.0)then - snoanl(i) = snofcs(i)*rsnol + snoanl(i)*qsnol - else ! envelope method - if(snoanl(i).ne.0)then - snoanl(i) = max(-snoanl(i)/rsnol, - & min(-snoanl(i)*rsnol, snofcs(i))) - endif - endif - zoranl(i) = zorfcs(i)*rzorl + zoranl(i)*qzorl - veganl(i) = vegfcs(i)*rvegl + veganl(i)*qvegl - vmnanl(i) = vmnfcs(i)*rvmnl + vmnanl(i)*qvmnl - vmxanl(i) = vmxfcs(i)*rvmxl + vmxanl(i)*qvmxl - slpanl(i) = slpfcs(i)*rslpl + slpanl(i)*qslpl - absanl(i) = absfcs(i)*rabsl + absanl(i)*qabsl - sihanl(i) = sihfcs(i)*rsihl + sihanl(i)*qsihl - sicanl(i) = sicfcs(i)*rsicl + sicanl(i)*qsicl - endif - - cnpanl(i) = cnpfcs(i)*rcnp + cnpanl(i)*qcnp -! -! snow over sea ice is cycled -! - if(slianl(i).eq.2.) then - snoanl(i) = snofcs(i) - endif -! - enddo - -! at landice points, set the soil type, slope type and -! greenness fields to flag values. - - if (landice) then - do i=i1_t,i2_t - if (nint(slianl(i)) == 1) then - if (nint(vetanl(i)) == veg_type_landice) then - sotanl(i) = soil_type_landice - veganl(i) = 0.0 - slpanl(i) = 9.0 - vmnanl(i) = 0.0 - vmxanl(i) = 0.0 - endif - end if ! if land - enddo - endif - - do i=i1_t,i2_t - cvanl(i) = cvfcs(i)*rcv + cvanl(i)*qcv - cvbanl(i) = cvbfcs(i)*rcvb + cvbanl(i)*qcvb - cvtanl(i) = cvtfcs(i)*rcvt + cvtanl(i)*qcvt - enddo -! - do k = 1, 4 - do i=i1_t,i2_t - if(slianl(i).eq.0.) then - albanl(i,k) = albfcs(i,k)*ralbs + albanl(i,k)*qalbs - else - albanl(i,k) = albfcs(i,k)*ralbl + albanl(i,k)*qalbl - endif - enddo - enddo -! - do k = 1, 2 - do i=i1_t,i2_t - if(slianl(i).eq.0.) then - alfanl(i,k) = alffcs(i,k)*ralfs + alfanl(i,k)*qalfs - else - alfanl(i,k) = alffcs(i,k)*ralfl + alfanl(i,k)*qalfl - endif - enddo - enddo -! - do k = 1, lsoil - do i=i1_t,i2_t - if(slianl(i).eq.0.) then - smcanl(i,k) = smcfcs(i,k)*rsmcs(k) + smcanl(i,k)*qsmcs(k) - stcanl(i,k) = stcfcs(i,k)*rstcs(k) + stcanl(i,k)*qstcs(k) - else -! soil moisture not used at landice points, so -! don't bother merging it. also, for now don't allow nudging -! to raise subsurface temperature above freezing. - stcanl(i,k) = stcfcs(i,k)*rstcl(k) + stcanl(i,k)*qstcl(k) - if (landice .and. slianl(i) == 1.0 .and. - & nint(vetanl(i)) == veg_type_landice) then - smcanl(i,k) = 1.0 ! use value as flag - stcanl(i,k) = min(stcanl(i,k), 273.15) - else - smcanl(i,k) = smcfcs(i,k)*rsmcl(k) + smcanl(i,k)*qsmcl(k) - end if - endif - enddo - enddo -! - enddo ! end of threaded loop ................... -!$omp end parallel do - return - end subroutine merge - -!> Adjust surface fields when ice melts or forms. -!! -!! @param[in] slianl Land-sea-ice mask. -!! @param[in] slifcs First guess land-sea-ice mask. -!! @param[out] tsfanl Skin temperature/SST. -!! @param[in] tsffcs First guess skin temperature/SST. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[in] sihnew Sea ice depth for new ice. -!! @param[in] sicnew Sea ice concentration for new ice. -!! @param[out] sihanl Sea ice depth. -!! @param[out] sicanl Sea ice concentration. -!! @param[out] albanl Snow-free albedo. -!! @param[out] snoanl Liquid equivalent snow depth. -!! @param[out] zoranl Roughness length. -!! @param[out] smcanl Soil moisture -!! @param[out] stcanl Soil temperature -!! @param[in] albsea Albedo at open water. -!! @param[in] snosea Snow at open water. -!! @param[in] zorsea Roughness length at open water. -!! @param[in] smcsea Soil moisture at open water. -!! @param[in] smcice Soil moisture at ice. -!! @param[in] tsfmin SST at open water. -!! @param[in] tsfice Skin temperature at ice. -!! @param[in] albice Ice albedo. -!! @param[in] zorice Roughness length of ice. -!! @param[in] tgice Freezing point of salt water. -!! @param[in] rla Model latitudes. -!! @param[in] rlo Model longitudes. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi -!! @author Xingen Wu - subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, - & sihnew,sicnew,sihanl,sicanl, - & albanl,snoanl,zoranl,smcanl,stcanl, - & albsea,snosea,zorsea,smcsea,smcice, - & tsfmin,tsfice,albice,zorice,tgice, - & rla,rlo,me) -! - use machine , only : kind_io8,kind_io4 - implicit none - real (kind=kind_io8), parameter :: one=1.0 - real (kind=kind_io8) tgice,albice,zorice,tsfice,albsea,snosea, - & smcice,tsfmin,zorsea,smcsea -!cwu [+1l] add sicnew,sihnew - &, sicnew,sihnew - integer i,me,kount1,kount2,k,len,lsoil - real (kind=kind_io8) slianl(len), slifcs(len), - & tsffcs(len),tsfanl(len) - real (kind=kind_io8) albanl(len,4), snoanl(len), zoranl(len) - real (kind=kind_io8) smcanl(len,lsoil), stcanl(len,lsoil) -!cwu [+1l] add sihanl & sicanl - real (kind=kind_io8) sihanl(len), sicanl(len) -! - real (kind=kind_io8) rla(len), rlo(len) -! - if (me .eq. 0) write(6,*) 'newice' -! - kount1 = 0 - kount2 = 0 - do i=1,len - if(slifcs(i).ne.slianl(i)) then - if(slifcs(i).eq.1..or.slianl(i).eq.1.) then - print *,'FATAL ERROR: Inconsistency in slifcs or slianl' - print 910,rla(i),rlo(i),slifcs(i),slianl(i), - & tsffcs(i),tsfanl(i) - 910 format(2x,'at lat=',f5.1,' lon=',f5.1,' slifcs=',f4.1, - & ' slimsk=',f4.1,' tsffcs=',f5.1,' set to tsfanl=',f5.1) - call abort - endif -! -! interpolated climatology indicates melted sea ice -! - if(slianl(i).eq.0..and.slifcs(i).eq.2.) then - tsfanl(i) = tsfmin - albanl(i,1) = albsea - albanl(i,2) = albsea - albanl(i,3) = albsea - albanl(i,4) = albsea - snoanl(i) = snosea - zoranl(i) = zorsea - do k = 1, lsoil - smcanl(i,k) = smcsea -!cwu [+1l] set stcanl to tgice (over sea-ice) - stcanl(i,k) = tgice - enddo -!cwu [+2l] set siganl and sicanl - sihanl(i) = 0. - sicanl(i) = 0. - kount1 = kount1 + 1 - endif -! -! interplated climatoloyg/analysis indicates new sea ice -! - if(slianl(i).eq.2..and.slifcs(i).eq.0.) then - tsfanl(i) = tsfice - albanl(i,1) = albice - albanl(i,2) = albice - albanl(i,3) = albice - albanl(i,4) = albice - snoanl(i) = 0. - zoranl(i) = zorice - do k = 1, lsoil - smcanl(i,k) = smcice - stcanl(i,k) = tgice - enddo -!cwu [+2l] add sihanl & sicanl - sihanl(i) = sihnew - sicanl(i) = min(one, max(sicnew,sicanl(i))) - kount2 = kount2 + 1 - endif - endif - enddo -! - if (me .eq. 0) then - if(kount1.gt.0) then - write(6,*) 'sea ice melted. tsf,alb,zor are filled', - & ' at ',kount1,' points' - endif - if(kount2.gt.0) then - write(6,*) 'sea ice formed. tsf,alb,zor are filled', - & ' at ',kount2,' points' - endif - endif -! - return - end - -!> Quality control snow at the model points. -!! -!! @param[out] snoanl Model snow to be qc'd. -!! @param[in] slmask Land-sea-ice mask. -!! @param[in] aisanl Ice mask. -!! @param[in] glacir Permanent glacial point when '1'. -!! @param[in] len Number of model points to process. -!! @param[in] snoval Minimum snow depth at glacial points. -!! @param[in] landice Is the point permanent land ice? -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval, - & landice,me) - use machine , only : kind_io8,kind_io4 - implicit none - integer kount,i,len,me - logical, intent(in) :: landice - real (kind=kind_io8) per,snoval - real (kind=kind_io8) snoanl(len),slmask(len), - & aisanl(len),glacir(len) - if (me .eq. 0) then - write(6,*) ' ' - write(6,*) 'qc of snow' - endif - if (.not.landice) then - kount=0 - do i=1,len - if(glacir(i).ne.0..and.snoanl(i).eq.0.) then -! if(glacir(i).ne.0..and.snoanl(i).lt.snoval*0.5) then - snoanl(i) = snoval - kount = kount + 1 - endif - enddo - per = float(kount) / float(len)*100. - if(kount.gt.0) then - if (me .eq. 0) then - print *,'snow filled over glacier points at ',kount, - & ' points (',per,'percent)' - endif - endif - endif ! landice check - kount = 0 - do i=1,len - if(slmask(i).eq.0.and.aisanl(i).eq.0) then - snoanl(i) = 0. - kount = kount + 1 - endif - enddo - per = float(kount) / float(len)*100. - if(kount.gt.0) then - if (me .eq. 0) then - print *,'snow set to zero over open sea at ',kount, - & ' points (',per,'percent)' - endif - endif - return - end subroutine qcsnow - -!> Check the sea ice cover mask against the land-sea mask. -!! -!! @param[out] ais Sea ice cover mask. -!! @param[in] glacir Glacial flag -!! @param[in] amxice Maximum ice extent. -!! @param[in] aicice Ice indicator. -!! @param[in] aicsea Open water indicator. -!! @param[in] sllnd Land indicator. -!! @param[in] slmask Land-sea-ice mask. -!! @param[in] rla Model latitudes -!! @param[in] rlo Model longitudes -!! @param[in] len Number of model points to process. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask, - & rla,rlo,len,me) - use machine , only : kind_io8,kind_io4 - implicit none - integer kount1,kount,i,me,len - real (kind=kind_io8) per,aicsea,aicice,sllnd -! - real (kind=kind_io8) ais(len), glacir(len), - & amxice(len), slmask(len) - real (kind=kind_io8) rla(len), rlo(len) -! -! check sea-ice cover mask against land-sea mask -! - if (me .eq. 0) write(6,*) 'qc of sea ice' - kount = 0 - kount1 = 0 - do i=1,len - if(ais(i).ne.aicice.and.ais(i).ne.aicsea) then - print *,'FATAL ERROR: sea ice' - print *,'mask not ',aicice,' or ',aicsea - print *,'ais(i),aicice,aicsea,rla(i),rlo(i,=', - & ais(i),aicice,aicsea,rla(i),rlo(i) - call abort - endif - if(slmask(i).eq.0..and.glacir(i).eq.1..and. -! if(slmask(i).eq.0..and.glacir(i).eq.2..and. - & ais(i).ne.1.) then - kount1 = kount1 + 1 - ais(i) = 1. - endif - if(slmask(i).eq.sllnd.and.ais(i).eq.aicice) then - kount = kount + 1 - ais(i) = aicsea - endif - enddo -! enddo - per = float(kount) / float(len)*100. - if(kount.gt.0) then - if(me .eq. 0) then - print *,' sea ice over land mask at ',kount,' points (',per, - & 'percent)' - endif - endif - per = float(kount1) / float(len)*100. - if(kount1.gt.0) then - if(me .eq. 0) then - print *,' sea ice set over glacier points over ocean at ', - & kount1,' points (',per,'percent)' - endif - endif -! kount=0 -! do j=1,jdim -! do i=1,idim -! if(amxice(i,j).ne.0..and.ais(i,j).eq.0.) then -! ais(i,j)=0. -! kount=kount+1 -! endif -! enddo -! enddo -! per=float(kount)/float(idim*jdim)*100. -! if(kount.gt.0) then -! print *,' sea ice exceeds maxice at ',kount,' points (',per, -! & 'percent)' -! endif -! -! remove isolated open ocean surrounded by sea ice and/or land -! -! remove isolated open ocean surrounded by sea ice and/or land -! -! ij = 0 -! do j=1,jdim -! do i=1,idim -! ij = ij + 1 -! ip = i + 1 -! im = i - 1 -! jp = j + 1 -! jm = j - 1 -! if(jp.gt.jdim) jp = jdim - 1 -! if(jm.lt.1) jm = 2 -! if(ip.gt.idim) ip = 1 -! if(im.lt.1) im = idim -! if(slmask(i,j).eq.0..and.ais(i,j).eq.0.) then -! if((slmask(ip,jp).eq.1..or.ais(ip,jp).eq.1.).and. -! & (slmask(i ,jp).eq.1..or.ais(i ,jp).eq.1.).and. -! & (slmask(im,jp).eq.1..or.ais(im,jp).eq.1.).and. -! & (slmask(ip,j ).eq.1..or.ais(ip,j ).eq.1.).and. -! & (slmask(im,j ).eq.1..or.ais(im,j ).eq.1.).and. -! & (slmask(ip,jm).eq.1..or.ais(ip,jm).eq.1.).and. -! & (slmask(i ,jm).eq.1..or.ais(i ,jm).eq.1.).and. -! & (slmask(im,jm).eq.1..or.ais(im,jm).eq.1.)) then -! ais(i,j) = 1. -! write(6,*) ' isolated open sea point surrounded by', -! & ' sea ice or land modified to sea ice', -! & ' at lat=',rla(i,j),' lon=',rlo(i,j) -! endif -! endif -! enddo -! enddo - return - end - -!> Set land-sea-ice mask at sea ice. -!! -!! @param[in] slmask The model mask on input. -!! @param[in] aisfld The ice mask on the model grid. -!! @param[in] len Number of model points to process. -!! @param[in] aicice Ice concentration theshold for an ice point. -!! @param[out] slifld The model mask with sea ice added. -!! @author Shrinivas Moorthi - subroutine setlsi(slmask,aisfld,len,aicice,slifld) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) aicice - real (kind=kind_io8) slmask(len), slifld(len), aisfld(len) -! -! set surface condition indicator slimsk -! - do i=1,len - slifld(i) = slmask(i) -! if(aisfld(i).eq.aicice) slifld(i) = 2.0 - if(aisfld(i).eq.aicice .and. slmask(i) .eq. 0.0) - & slifld(i) = 2.0 - enddo - return - end - -!> Multiply a field by a scaling factor. -!! -!! @param[inout] fld The field to scale. -!! @param[in] len Number of model points to process. -!! @param[in] scl Scaling factor. -!! @author Shrinivas Moorthi - subroutine scale(fld,len,scl) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) fld(len),scl - do i=1,len - fld(i) = fld(i) * scl - enddo - return - end - -!> Range check a field. The check is a function of whether the -!! point is land, water or ice. -!! -!! @param[in] ttl Name of field. -!! @param[inout] fld The field array to be ranged checked. -!! @param[in] slimsk The land-sea-ice mask. -!! @param[in] sno Snow. -!! @param[in] iceflg When true, check ice points. -!! @param[in] fldlmx Maximum allowable value at snow-free land. -!! @param[in] fldlmn Minimum allowable value at snow-free land. -!! @param[in] fldomx Maximum allowable value at open water. -!! @param[in] fldomn Minimum allowable value at open water. -!! @param[in] fldimx Maximum allowable value at snow-free ice. -!! @param[in] fldimn Minimum allowable value at snow-free ice. -!! @param[in] fldjmx Maximum allowable value at snow covered ice. -!! @param[in] fldjmn Minimum allowable value at snow covered ice. -!! @param[in] fldsmx Maximum allowable value at snow covered land. -!! @param[in] fldsmn Minimum allowable value at snow covered land. -!! @param[in] epsfld Difference from the max/min allowable -!! value at which the field is updated. -!! @param[in] rla Latitude of the points to process. -!! @param[in] rlo Longitude of the points to process. -!! @param[in] len Number of points to process. -!! @param[in] mode When '1', update the field. When not '1', run -!! routine in diagnostic mode. -!! @param[in] percrit Critical percentage of 'bad' points required -!! for abort. -!! @param[in] lgchek When true, abort when a critical percentage of points -!! are outside acceptable range. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, - & fldlmx,fldlmn,fldomx,fldomn,fldimx,fldimn, - & fldjmx,fldjmn,fldsmx,fldsmn,epsfld, - & rla,rlo,len,mode,percrit,lgchek,me) -! - use machine , only : kind_io8,kind_io4 - implicit none - real (kind=kind_io8) permax,per,fldimx,fldimn,fldjmx,fldomn, - & fldlmx,fldlmn,fldomx,fldjmn,percrit, - & fldsmx,fldsmn,epsfld - integer kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,mmprt,kminj, - & ij,nprt,kmaxs,kmins,i,me,len,mode - parameter(mmprt=2) -! - character*8 ttl - logical iceflg(len) - real (kind=kind_io8) fld(len),slimsk(len),sno(len), - & rla(len), rlo(len) - integer iwk(len) - logical lgchek -! - logical first - integer num_threads - data first /.true./ - save num_threads, first -! - integer len_thread_m, i1_t, i2_t, it - integer num_parthds -! - if (first) then - num_threads = num_parthds() - first = .false. - endif -! -! check against land-sea mask and ice cover mask -! - if(me .eq. 0) then -! print *,' ' - print *,'performing qc of ',ttl,' mode=',mode, - & '(0=count only, 1=replace)' - endif -! - len_thread_m = (len+num_threads-1) / num_threads - kmaxl = 0 - kminl = 0 - kmaxo = 0 - kmino = 0 - kmaxi = 0 - kmini = 0 - kmaxj = 0 - kminj = 0 - kmaxs = 0 - kmins = 0 -!$omp parallel do private(i1_t,i2_t,it,i) -!$omp+private(nprt,ij,iwk) -!$omp+reduction(+:kmaxs,kmins,kmaxl,kminl,kmaxo) -!$omp+reduction(+:kmino,kmaxi,kmini,kmaxj,kminj) -!$omp+shared(mode,epsfld) -!$omp+shared(fldlmx,fldlmn,fldomx,fldjmn,fldsmx,fldsmn) -!$omp+shared(fld,slimsk,sno,rla,rlo) - do it=1,num_threads ! start of threaded loop - i1_t = (it-1)*len_thread_m+1 - i2_t = min(i1_t+len_thread_m-1,len) -! -! -! -! lower bound check over bare land -! - if (fldlmn .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).le.0..and. - & fld(i).lt.fldlmn-epsfld) then - kminl=kminl+1 - iwk(kminl) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kminl) - do i=1,nprt - ij = iwk(i) - print 8001,rla(ij),rlo(ij),fld(ij),fldlmn - 8001 format(' bare land min. check. lat=',f5.1, - & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6) - enddo - endif - if (mode .eq. 1) then - do i=1,kminl - fld(iwk(i)) = fldlmn - enddo - endif - endif -! -! upper bound check over bare land -! - if (fldlmx .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).le.0..and. - & fld(i).gt.fldlmx+epsfld) then - kmaxl=kmaxl+1 - iwk(kmaxl) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmaxl) - do i=1,nprt - ij = iwk(i) - print 8002,rla(ij),rlo(ij),fld(ij),fldlmx - 8002 format(' bare land max. check. lat=',f5.1, - & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6) - enddo - endif - if (mode .eq. 1) then - do i=1,kmaxl - fld(iwk(i)) = fldlmx - enddo - endif - endif -! -! lower bound check over snow covered land -! - if (fldsmn .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).gt.0..and. - & fld(i).lt.fldsmn-epsfld) then - kmins=kmins+1 - iwk(kmins) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmins) - do i=1,nprt - ij = iwk(i) - print 8003,rla(ij),rlo(ij),fld(ij),fldsmn - 8003 format(' sno covrd land min. check. lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kmins - fld(iwk(i)) = fldsmn - enddo - endif - endif -! -! upper bound check over snow covered land -! - if (fldsmx .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).gt.0..and. - & fld(i).gt.fldsmx+epsfld) then - kmaxs=kmaxs+1 - iwk(kmaxs) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmaxs) - do i=1,nprt - ij = iwk(i) - print 8004,rla(ij),rlo(ij),fld(ij),fldsmx - 8004 format(' snow land max. check. lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kmaxs - fld(iwk(i)) = fldsmx - enddo - endif - endif -! -! lower bound check over open ocean -! - if (fldomn .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.0..and. - & fld(i).lt.fldomn-epsfld) then - kmino=kmino+1 - iwk(kmino) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmino) - do i=1,nprt - ij = iwk(i) - print 8005,rla(ij),rlo(ij),fld(ij),fldomn - 8005 format(' open ocean min. check. lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4,' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kmino - fld(iwk(i)) = fldomn - enddo - endif - endif -! -! upper bound check over open ocean -! - if (fldomx .ne. 999.0) then - do i=i1_t,i2_t - if(fldomx.ne.999..and.slimsk(i).eq.0..and. - & fld(i).gt.fldomx+epsfld) then - kmaxo=kmaxo+1 - iwk(kmaxo) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmaxo) - do i=1,nprt - ij = iwk(i) - print 8006,rla(ij),rlo(ij),fld(ij),fldomx - 8006 format(' open ocean max. check. lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kmaxo - fld(iwk(i)) = fldomx - enddo - endif - endif -! -! lower bound check over sea ice without snow -! - if (fldimn .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).le.0..and. - & fld(i).lt.fldimn-epsfld) then - kmini=kmini+1 - iwk(kmini) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmini) - do i=1,nprt - ij = iwk(i) - print 8007,rla(ij),rlo(ij),fld(ij),fldimn - 8007 format(' seaice no snow min. check lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kmini - fld(iwk(i)) = fldimn - enddo - endif - endif -! -! upper bound check over sea ice without snow -! - if (fldimx .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).le.0..and. - & fld(i).gt.fldimx+epsfld .and. iceflg(i)) then -! & fld(i).gt.fldimx+epsfld) then - kmaxi=kmaxi+1 - iwk(kmaxi) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmaxi) - do i=1,nprt - ij = iwk(i) - print 8008,rla(ij),rlo(ij),fld(ij),fldimx - 8008 format(' seaice no snow max. check lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kmaxi - fld(iwk(i)) = fldimx - enddo - endif - endif -! -! lower bound check over sea ice with snow -! - if (fldjmn .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).gt.0..and. - & fld(i).lt.fldjmn-epsfld) then - kminj=kminj+1 - iwk(kminj) = i - endif - enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kminj) - do i=1,nprt - ij = iwk(i) - print 8009,rla(ij),rlo(ij),fld(ij),fldjmn - 8009 format(' sea ice snow min. check lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kminj - fld(iwk(i)) = fldjmn - enddo - endif - endif -! -! upper bound check over sea ice with snow -! - if (fldjmx .ne. 999.0) then - do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).gt.0..and. - & fld(i).gt.fldjmx+epsfld .and. iceflg(i)) then -! & fld(i).gt.fldjmx+epsfld) then - kmaxj=kmaxj+1 - iwk(kmaxj) = i - endif - enddo - if(me == 0 .and. it == 1 .and. num_threads == 1) then - nprt = min(mmprt,kmaxj) - do i=1,nprt - ij = iwk(i) - print 8010,rla(ij),rlo(ij),fld(ij),fldjmx - 8010 format(' seaice snow max check lat=',f5.1, - & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) - enddo - endif - if (mode .eq. 1) then - do i=1,kmaxj - fld(iwk(i)) = fldjmx - enddo - endif - endif - enddo ! end of threaded loop -!$omp end parallel do -! -! print results -! - if(me .eq. 0) then -! write(6,*) 'summary of qc' - permax=0. - if(kminl.gt.0) then - per=float(kminl)/float(len)*100. - print 9001,fldlmn,kminl,per - 9001 format(' bare land min check. modified to ',f8.1, - & ' at ',i5,' points ',f8.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmaxl.gt.0) then - per=float(kmaxl)/float(len)*100. - print 9002,fldlmx,kmaxl,per - 9002 format(' bare land max check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmino.gt.0) then - per=float(kmino)/float(len)*100. - print 9003,fldomn,kmino,per - 9003 format(' open ocean min check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmaxo.gt.0) then - per=float(kmaxo)/float(len)*100. - print 9004,fldomx,kmaxo,per - 9004 format(' open sea max check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmins.gt.0) then - per=float(kmins)/float(len)*100. - print 9009,fldsmn,kmins,per - 9009 format(' snow covered land min check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmaxs.gt.0) then - per=float(kmaxs)/float(len)*100. - print 9010,fldsmx,kmaxs,per - 9010 format(' snow covered land max check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmini.gt.0) then - per=float(kmini)/float(len)*100. - print 9005,fldimn,kmini,per - 9005 format(' bare ice min check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmaxi.gt.0) then - per=float(kmaxi)/float(len)*100. - print 9006,fldimx,kmaxi,per - 9006 format(' bare ice max check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kminj.gt.0) then - per=float(kminj)/float(len)*100. - print 9007,fldjmn,kminj,per - 9007 format(' snow covered ice min check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif - if(kmaxj.gt.0) then - per=float(kmaxj)/float(len)*100. - print 9008,fldjmx,kmaxj,per - 9008 format(' snow covered ice max check. modified to ',f8.1, - & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per - endif -! commented on 06/30/99 -- moorthi -! if(lgchek) then -! if(permax.gt.percrit) then -! write(6,*) ' too many bad points. aborting ....' -! call abort -! endif -! endif -! - endif -! - return - end - -!> Set a field to zero if it is less than a threshold. -!! -!! @param[inout] fld Field to set. -!! @param[in] eps Threshold. -!! @param[in] len Number of model points to process. -!! @author Shrinivas Moorthi - subroutine setzro(fld,eps,len) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) fld(len),eps - do i=1,len - if(abs(fld(i)).lt.eps) fld(i) = 0. - enddo - return - end - -!> Set snow cover flag based on snow depth. -!! -!! @param[in] snofld Snow depth. -!! @param[out] scvfld Snow cover. -!! @param[in] len Number of model points to process. -!! @author Shrinivas Moorthi - subroutine getscv(snofld,scvfld,len) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) snofld(len),scvfld(len) -! - do i=1,len - scvfld(i) = 0. - if(snofld(i).gt.0.) scvfld(i) = 1. - enddo - return - end - -!> Set soil temperature and sea ice column temperature. -!! -!! @param[in] tsffld Skin temperature/SST. -!! @param[in] tg3fld Soil substrate temperature. -!! @param[in] slifld Land-sea-ice mask. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[out] stcfld Soil/sea ice column temperature. -!! @param[in] tsfimx Freezing point of sea water. -!! @author Shrinivas Moorthi - subroutine getstc(tsffld,tg3fld,slifld,len,lsoil,stcfld,tsfimx) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer k,i,len,lsoil - real (kind=kind_io8) factor,tsfimx - real (kind=kind_io8) tsffld(len), tg3fld(len), slifld(len) - real (kind=kind_io8) stcfld(len,lsoil) -! -! layer soil temperature -! - do k = 1, lsoil - do i = 1, len - if(slifld(i).eq.1.0) then - factor = ((k-1) * 2 + 1) / (2. * lsoil) - stcfld(i,k) = factor*tg3fld(i)+(1.-factor)*tsffld(i) - elseif(slifld(i).eq.2.0) then - factor = ((k-1) * 2 + 1) / (2. * lsoil) - stcfld(i,k) = factor*tsfimx+(1.-factor)*tsffld(i) - else - stcfld(i,k) = tg3fld(i) - endif - enddo - enddo - if(lsoil.gt.2) then - do k = 3, lsoil - do i = 1, len - stcfld(i,k) = stcfld(i,2) - enddo - enddo - endif - return - end - -!> Set soil moisture from soil wetness. -!! -!! @param[in] wetfld Soil wetness -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[out] smcfld Soil moisture. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine getsmc(wetfld,len,lsoil,smcfld,me) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer k,i,len,lsoil,me - real (kind=kind_io8) wetfld(len), smcfld(len,lsoil) -! - if (me .eq. 0) write(6,*) 'getsmc' -! -! layer soil wetness -! - do k = 1, lsoil - do i = 1, len - smcfld(i,k) = (wetfld(i)*1000./150.)*.37 + .1 - enddo - enddo - return - end - -!> Set soil temperature and sea ice column temperature for -!! a dead start. -!! -!! @param[in] sig1t Sigma level 1 temperature for dead start. -!! @param[in] slianl Land-sea-ice mask. -!! @param[in] tg3anl Soil substrate temperature. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[out] tsfanl Skin temperature. -!! @param[out] stcanl Soil/sea ice column temperature. -!! @param[in] tsfimx Freezing point of sea water. -!! @author Shrinivas Moorthi - subroutine usesgt(sig1t,slianl,tg3anl,len,lsoil,tsfanl,stcanl, - & tsfimx) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len,lsoil - real (kind=kind_io8) tsfimx - real (kind=kind_io8) sig1t(len), slianl(len), tg3anl(len) - real (kind=kind_io8) tsfanl(len), stcanl(len,lsoil) -! -! soil temperature -! - if(sig1t(1).gt.0.) then - do i=1,len - if(slianl(i).ne.0.) then - tsfanl(i) = sig1t(i) - endif - enddo - endif - call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) -! - return - end - -!> Check skin temperature at points with snow. If it is -!! above a threshold, reset it to that value. -!! -!! @param[in] snoanl Snow. -!! @param[inout] tsfanl Skin temperature at the model points. -!! @param[in] tsfsmx Maximum allowable skin temperature at snow points. -!! @param[in] len Number of model points to process. -!! @param[in] me MPI rank -!! @author Shrinivas Moorthi NOAA/EMC - subroutine snosfc(snoanl,tsfanl,tsfsmx,len,me) - use machine , only : kind_io8,kind_io4 - implicit none - integer kount,i,len,me - real (kind=kind_io8) per,tsfsmx - real (kind=kind_io8) snoanl(len), tsfanl(len) -! - if (me .eq. 0) write(6,*) 'set snow temp to tsfsmx if greater' - kount=0 - do i=1,len - if(snoanl(i).gt.0.) then - if(tsfanl(i).gt.tsfsmx) tsfanl(i)=tsfsmx - kount = kount + 1 - endif - enddo - if(kount.gt.0) then - if(me .eq. 0) then - per=float(kount)/float(len)*100. - write(6,*) 'snow sfc. tsf set to ',tsfsmx,' at ', - & kount, ' points ',per,'percent' - endif - endif - return - end - -!> Set the albedo at open water points. -!! -!! @param[inout] albclm Albedo. -!! @param[in] slmask The land-sea-ice mask. -!! @param[in] albomx The albedo at open water. -!! @param[in] len Number of model points to process. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine albocn(albclm,slmask,albomx,len) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) albomx - real (kind=kind_io8) albclm(len,4), slmask(len) - do i=1,len - if(slmask(i).eq.0) then - albclm(i,1) = albomx - albclm(i,2) = albomx - albclm(i,3) = albomx - albclm(i,4) = albomx - endif - enddo - return - end - -!> Quality control maximum ice extent. -!! -!! @param[in] glacir Glacial flag -!! @param[out] amxice Maximum ice extent. -!! @param[in] len Number of model points to process. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine qcmxice(glacir,amxice,len,me) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,kount,len,me - real (kind=kind_io8) glacir(len),amxice(len),per - if (me .eq. 0) write(6,*) 'qc of maximum ice extent' - kount=0 - do i=1,len - if(glacir(i).eq.1..and.amxice(i).eq.0.) then - amxice(i) = 0. - kount = kount + 1 - endif - enddo - if(kount.gt.0) then - per = float(kount) / float(len)*100. - if(me .eq. 0) write(6,*) ' max ice limit less than glacier' - &, ' coverage at ', kount, ' points ',per,'percent' - endif - return - end - -!> Check consistency between the forecast and analysis -!! land-sea-ice mask. -!! -!! @param[in] slianl Analysis mask. -!! @param[inout] slifcs Forecast mask. -!! @param[in] len Number of model points to process. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine qcsli(slianl,slifcs,len,me) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,kount,len,me - real (kind=kind_io8) slianl(len), slifcs(len),per - if (me .eq. 0) then - write(6,*) ' ' - write(6,*) 'qcsli' - endif - kount=0 - do i=1,len - if(slianl(i).eq.1..and.slifcs(i).eq.0.) then - kount = kount + 1 - slifcs(i) = 1. - endif - if(slianl(i).eq.0..and.slifcs(i).eq.1.) then - kount = kount + 1 - slifcs(i) = 0. - endif - if(slianl(i).eq.2..and.slifcs(i).eq.1.) then - kount = kount + 1 - slifcs(i) = 0. - endif - if(slianl(i).eq.1..and.slifcs(i).eq.2.) then - kount = kount + 1 - slifcs(i) = 1. - endif - enddo - if(kount.gt.0) then - per=float(kount)/float(len)*100. - if(me .eq. 0) then - write(6,*) ' inconsistency of slmask between forecast and', - & ' analysis corrected at ',kount, ' points ',per, - & 'percent' - endif - endif - return - end - -! subroutine nntprt(data,imax,fact) -! real (kind=kind_io8) data(imax) -! ilast=0 -! i1=1 -! i2=80 -!1112 continue -! if(i2.ge.imax) then -! ilast=1 -! i2=imax -! endif -! write(6,*) ' ' -! do j=1,jmax -! write(6,1111) (nint(data(imax*(j-1)+i)*fact),i=i1,i2) -! enddo -! if(ilast.eq.1) return -! i1=i1+80 -! i2=i1+79 -! if(i2.ge.imax) then -! ilast=1 -! i2=imax -! endif -! go to 1112 -!1111 format(80i1) -! return -! end - -!> Quality control analysis fields using the first guess. -!! -!! @param[in] tsffcs First guess skin temperature/SST. -!! @param[in] snofcs First guess snow. -!! @param[in] qctsfs Surface temperature above which no snow -!! allowed. -!! @param[in] qcsnos Snow depth above which snow must exits. -!! @param[in] qctsfi SST above which sea ice is not allowed. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[out] snoanl Snow analysis. -!! @param[in] aisanl Ice mask. -!! @param[in] slianl Land-sea-ice mask. -!! @param[out] tsfanl Skin temperature/SST analysis. -!! @param[in] albanl Snow-free albedo analysis. -!! @param[in] zoranl Roughness length analysis. -!! @param[in] smcanl Soil moisture analysis. -!! @param[in] smcclm Soil moisture climatology. -!! @param[in] tsfsmx Not used. -!! @param[in] albomx Snow-free albedo at open water. -!! @param[in] zoromx Roughness length at open water. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi - subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, - & len,lsoil,snoanl,aisanl,slianl,tsfanl,albanl, - & zoranl,smcanl, - & smcclm,tsfsmx,albomx,zoromx, me) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer kount,me,k,i,lsoil,len - real (kind=kind_io8) zoromx,per,albomx,qctsfi,qcsnos,qctsfs,tsfsmx - real (kind=kind_io8) tsffcs(len), snofcs(len) - real (kind=kind_io8) snoanl(len), aisanl(len), - & slianl(len), zoranl(len), - & tsfanl(len), albanl(len,4), - & smcanl(len,lsoil) - real (kind=kind_io8) smcclm(len,lsoil) -! - if (me .eq. 0) write(6,*) 'qc of snow and sea-ice analysis' -! -! qc of snow analysis -! -! questionable snow cover -! - kount = 0 - do i=1,len - if(slianl(i).gt.0..and. - & tsffcs(i).gt.qctsfs.and.snoanl(i).gt.0.) then - kount = kount + 1 - snoanl(i) = 0. - tsfanl(i) = tsffcs(i) - endif - enddo - if(kount.gt.0) then - per=float(kount)/float(len)*100. - if (me .eq. 0) then - write(6,*) ' guess surface temp .gt. ',qctsfs, - & ' but snow analysis indicates snow cover' - write(6,*) ' snow analysis set to zero', - & ' at ',kount, ' points ',per,'percent' - endif - endif -! -! questionable no snow cover -! - kount = 0 - do i=1,len - if(slianl(i).gt.0..and. - & snofcs(i).gt.qcsnos.and.snoanl(i).lt.0.) then - kount = kount + 1 - snoanl(i) = snofcs(i) - tsfanl(i) = tsffcs(i) - endif - enddo - if(kount.gt.0) then - per=float(kount)/float(len)*100. - if (me .eq. 0) then - write(6,*) ' guess snow depth .gt. ',qcsnos, - & ' but snow analysis indicates no snow cover' - write(6,*) ' snow analysis set to guess value', - & ' at ',kount, ' points ',per,'percent' - endif - endif -! -! questionable sea ice cover ! this qc is disable to correct error in -! surface temparature over observed sea ice points -! -! kount = 0 -! do i=1,len -! if(slianl(i).eq.2..and. -! & tsffcs(i).gt.qctsfi.and.aisanl(i).eq.1.) then -! kount = kount + 1 -! aisanl(i) = 0. -! slianl(i) = 0. -! tsfanl(i) = tsffcs(i) -! snoanl(i) = 0. -! zoranl(i) = zoromx -! albanl(i,1) = albomx -! albanl(i,2) = albomx -! albanl(i,3) = albomx -! albanl(i,4) = albomx -! do k=1,lsoil -! smcanl(i,k) = smcclm(i,k) -! enddo -! endif -! enddo -! if(kount.gt.0) then -! per=float(kount)/float(len)*100. -! if (me .eq. 0) then -! write(6,*) ' guess surface temp .gt. ',qctsfi, -! & ' but sea-ice analysis indicates sea-ice' -! write(6,*) ' sea-ice analysis set to zero', -! & ' at ',kount, ' points ',per,'percent' -! endif -! endif -! - return - end - -!> Set the mask for the input data. (Not the model mask). -!! The mask is determined from the input data bitmap or by -!! interpolating a high-resolution mask to the input -!! data grid. Note: not all data has a mask. -!! -!! @param[in] kpds5 Grib parameter number. -!! @param[in] slmask High-resolution mask. -!! @param[in] igaul "i" dimension of the high-res mask. -!! @param[in] jgaul "j" dimension of the high-res mask. -!! @param[in] wlon Longitude of 'west' boundary of input data. -!! @param[in] rnlat Latitude of north row of input data. -!! @param[in] data The input data. -!! @param[in] imax "i" dimension of input grid. -!! @param[in] jmax "j" dimension of input grid. -!! @param[out] rlnout Longitudes on input data grid. -!! @param[out] rltout Latitudes on input data grid. -!! @param[out] lmask True, when input data has a mask. -!! @param[out] rslmsk The mask of the input data grid. -!! @param[in] gaus Is high-resolution mask on a gaussian grid. -!! @param[in] blno Corner point longitude of the high-res mask. -!! @param[in] blto Corner point longitude of the high-res mask. -!! @param[in] kgds1 Grib indicator for grid type. -!! @param[in] kpds4 Grib indicator for bitmap. -!! @param[in] lbms Bitmap of input data. -!! @author Shrinivas Moorthi - subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, - & data,imax,jmax,rlnout,rltout,lmask,rslmsk - &, gaus,blno, blto, kgds1, kpds4, lbms) - use machine , only : kind_io8,kind_io4 - use sfccyc_module - implicit none - real (kind=kind_io8) blno,blto,wlon,rnlat,crit,data_max - integer i,j,ijmax,jgaul,igaul,kpds5,jmax,imax, kgds1, kspla - integer, intent(in) :: kpds4 - logical*1, intent(in) :: lbms(imax,jmax) - real*4 :: dummy(imax,jmax) - - real (kind=kind_io8) slmask(igaul,jgaul) - real (kind=kind_io8) data(imax,jmax),rslmsk(imax,jmax) - &, rlnout(imax), rltout(jmax) - real (kind=kind_io8) a(jmax), w(jmax), radi, dlat, dlon - logical lmask, gaus -! -! set the longitude and latitudes for the grib file -! - if (kgds1 .eq. 4) then ! grib file on gaussian grid - kspla=4 - call splat(kspla, jmax, a, w) -! - radi = 180.0 / (4.*atan(1.)) - do j=1,jmax - rltout(j) = acos(a(j)) * radi - enddo -! - if (rnlat .gt. 0.0) then - do j=1,jmax - rltout(j) = 90. - rltout(j) - enddo - else - do j=1,jmax - rltout(j) = -90. + rltout(j) - enddo - endif - elseif (kgds1 .eq. 0) then ! grib file on lat/lon grid - dlat = -(rnlat+rnlat) / float(jmax-1) - do j=1,jmax - rltout(j) = rnlat + (j-1) * dlat - enddo - else ! grib file on some other grid - write(6,*) ' FATAL ERROR: Mask data on' - write(6,*) ' unsupported grid.' - call abort - endif - dlon = 360.0 / imax - do i=1,imax - rlnout(i) = wlon + (i-1)*dlon - enddo -! -! - ijmax = imax*jmax - rslmsk = 0. -! TG3 MODS BEGIN - if(kpds5 == kpdtsf .and. imax == 138 .and. jmax == 116 - & .and. kpds4 == 128) then -! print*,'turn off setrmsk for tg3' - lmask = .false. - - elseif(kpds5 == kpdtsf) then -! TG3 MODS END -! -! surface temperature -! - lmask = .false. - call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat - &, rlnout, rltout, gaus, blno, blto) -! &, dlon, dlat, gaus, blno, blto) - crit = 0.5 - call rof01(rslmsk,ijmax,'ge',crit) - lmask = .true. -! -! bucket soil wetness -! - elseif(kpds5.eq.kpdwet) then - call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat - &, rlnout, rltout, gaus, blno, blto) -! &, dlon, dlat, gaus, blno, blto) - crit = 0.5 - call rof01(rslmsk,ijmax,'ge',crit) - lmask = .true. -! write(6,*) 'wet rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! snow depth -! - elseif(kpds5 == kpdsnd) then - if(kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo - lmask=.true. - else - lmask=.false. - end if -! -! snow liq equivalent depth -! - elseif(kpds5.eq.kpdsno) then - call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat - &, rlnout, rltout, gaus, blno, blto) -! &, dlon, dlat, gaus, blno, blto) - crit=0.5 - call rof01(rslmsk,ijmax,'ge',crit) - lmask=.true. -! write(6,*) 'sno rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! soil moisture -! - elseif(kpds5.eq.kpdsmc) then - if(kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo - lmask=.true. - else - call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat - &, rlnout, rltout, gaus, blno, blto) - crit=0.5 - call rof01(rslmsk,ijmax,'ge',crit) - lmask=.true. - endif -! -! surface roughness -! - elseif(kpds5.eq.kpdzor) then - do j=1,jmax - do i=1,imax - rslmsk(i,j)=data(i,j) - enddo - enddo - crit=9.9 - call rof01(rslmsk,ijmax,'lt',crit) - lmask=.true. -! write(6,*) 'zor rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! albedo -! -! elseif(kpds5.eq.kpdalb) then -! do j=1,jmax -! do i=1,imax -! rslmsk(i,j)=data(i,j) -! enddo -! enddo -! crit=99. -! call rof01(rslmsk,ijmax,'lt',crit) -! lmask=.true. -! write(6,*) 'alb rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! albedo -! -!cbosu new snowfree albedo database has bitmap, use it. - elseif(kpds5.eq.kpdalb(1)) then - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo - lmask = .true. - else ! no bitmap. old database has no water flag. - lmask=.false. - end if - elseif(kpds5.eq.kpdalb(2)) then -!cbosu - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo - lmask = .true. - else ! no bitmap. old database has no water flag. - lmask=.false. - end if - elseif(kpds5.eq.kpdalb(3)) then -!cbosu - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo - lmask = .true. - else ! no bitmap. old database has no water flag. - lmask=.false. - end if - elseif(kpds5.eq.kpdalb(4)) then -!cbosu - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo - lmask = .true. - else ! no bitmap. old database has no water flag. - lmask=.false. - end if -! -! vegetation fraction for albedo -! - elseif(kpds5.eq.kpdalf(1)) then -! rslmsk=data -! crit=0. -! call rof01(rslmsk,ijmax,'gt',crit) -! lmask=.true. - lmask=.false. - elseif(kpds5.eq.kpdalf(2)) then -! rslmsk=data -! crit=0. -! call rof01(rslmsk,ijmax,'gt',crit) -! lmask=.true. - lmask=.false. -! -! sea ice -! - elseif(kpds5.eq.kpdais) then - lmask=.false. -! call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat -! &, dlon, dlat, gaus, blno, blto) -! crit=0.5 -! call rof01(rslmsk,ijmax,'ge',crit) -! - data_max = 0.0 - do j=1,jmax - do i=1,imax - rslmsk(i,j) = data(i,j) - data_max= max(data_max,data(i,j)) - enddo - enddo - crit=1.0 - if (data_max .gt. crit) then - call rof01(rslmsk,ijmax,'gt',crit) - lmask=.true. - else - lmask=.false. - endif -! write(6,*) 'acn rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! deep soil temperature -! - elseif(kpds5.eq.kpdtg3) then - lmask=.false. -! call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat -! &, rlnout, rltout, gaus, blno, blto) -! &, dlon, dlat, gaus, blno, blto) -! crit=0.5 -! call rof01(rslmsk,ijmax,'ge',crit) -! lmask=.true. -! -! plant resistance -! -! elseif(kpds5.eq.kpdplr) then -! call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat -! &, rlnout, rltout, gaus, blno, blto) -! &, dlon, dlat, gaus, blno, blto) -! crit=0.5 -! call rof01(rslmsk,ijmax,'ge',crit) -! lmask=.true. -! -! write(6,*) 'plr rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! glacier points -! - elseif(kpds5.eq.kpdgla) then - lmask=.false. -! -! max ice extent -! - elseif(kpds5.eq.kpdmxi) then - lmask=.false. -! -! snow cover -! - elseif(kpds5.eq.kpdscv) then - call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat - &, rlnout, rltout, gaus, blno, blto) -! &, dlon, dlat, gaus, blno, blto) - crit=0.5 - call rof01(rslmsk,ijmax,'ge',crit) - lmask=.true. -! write(6,*) 'scv rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! sea ice concentration -! - elseif(kpds5.eq.kpdacn) then - lmask=.false. - call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat - &, rlnout, rltout, gaus, blno, blto) -! &, dlon, dlat, gaus, blno, blto) - crit=0.5 - call rof01(rslmsk,ijmax,'ge',crit) - lmask=.true. -! write(6,*) 'acn rslmsk' -! znnt=1. -! call nntprt(rslmsk,ijmax,znnt) -! -! vegetation cover -! - elseif(kpds5.eq.kpdveg) then -!cggg - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,jmax-j+1) = 1. ! need to flip grid in n/s direction - end if - enddo - enddo - lmask = .true. - else ! no bitmap, set mask the old way. - - call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat - &, rlnout, rltout, gaus, blno, blto) - crit=0.5 - call rof01(rslmsk,ijmax,'ge',crit) - lmask=.true. - - end if -! -! soil type -! - elseif(kpds5.eq.kpdsot) then - - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo -! soil type is zero over water, use this to get a bitmap. - else - do j = 1, jmax - do i = 1, imax - rslmsk(i,j) = data(i,j) - enddo - enddo - crit=0.1 - call rof01(rslmsk,ijmax,'gt',crit) - endif - lmask=.true. -! -! vegetation type -! - elseif(kpds5.eq.kpdvet) then - - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo -! veg type is zero over water, use this to get a bitmap. - else - do j = 1, jmax - do i = 1, imax - rslmsk(i,j) = data(i,j) - enddo - enddo - crit=0.1 - call rof01(rslmsk,ijmax,'gt',crit) - endif - lmask=.true. -! -! these are for four new data type added by clu -- not sure its correct! -! - elseif(kpds5.eq.kpdvmn) then -! -!cggg greenness is zero over water, use this to get a bitmap. -! - do j = 1, jmax - do i = 1, imax - rslmsk(i,j) = data(i,j) - enddo - enddo -! - crit=0.1 - call rof01(rslmsk,ijmax,'gt',crit) - lmask=.true. -!cggg lmask=.false. -! - elseif(kpds5.eq.kpdvmx) then -! -!cggg greenness is zero over water, use this to get a bitmap. -! - do j = 1, jmax - do i = 1, imax - rslmsk(i,j) = data(i,j) - enddo - enddo -! - crit=0.1 - call rof01(rslmsk,ijmax,'gt',crit) - lmask=.true. -!cggg lmask=.false. -! - elseif(kpds5.eq.kpdslp) then -! -!cggg slope type is zero over water, use this to get a bitmap. -! - do j = 1, jmax - do i = 1, imax - rslmsk(i,j) = data(i,j) - enddo - enddo -! - crit=0.1 - call rof01(rslmsk,ijmax,'gt',crit) - lmask=.true. -!cggg lmask=.false. -! -!cbosu new maximum snow albedo database has bitmap - elseif(kpds5.eq.kpdabs) then - if (kpds4 == 192) then ! use the bitmap - rslmsk = 0. - do j = 1, jmax - do i = 1, imax - if (lbms(i,j)) then - rslmsk(i,j) = 1. - end if - enddo - enddo - lmask = .true. - else ! no bitmap. old database has zero over water - do j = 1, jmax - do i = 1, imax - rslmsk(i,j) = data(i,j) - enddo - enddo - crit=0.1 - call rof01(rslmsk,ijmax,'gt',crit) - lmask=.true. - end if - endif -! - return - end - -!> Interpolation from lat/lon or gaussian grid to a lat/lon grid. -!! -!! @param[in] gauin Input data. -!! @param[in] imxin 'i' dimension of input data. -!! @param[in] jmxin 'j' dimension of input data. -!! @param[out] regout Output data. -!! @param[in] imxout 'i' dimension of output data. -!! @param[in] jmxout 'j' dimension of output data. -!! @param[in] wlon Longitude of west boundary of input data. -!! @param[in] rnlat Latitude of north row of input data. -!! @param[in] rlnout Longitudes on output data grid. -!! @param[in] rltout Latitudes on output data grid. -!! @param[in] gaus Is input data on gaussian grid? -!! @param[in] blno Corner point longitude of input data. -!! @param[in] blto Corner point latitude of input data. -!! @author Shrinivas Moorthi - subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, - & wlon,rnlat,rlnout,rltout,gaus,blno, blto) - use machine , only : kind_io8,kind_io4 - implicit none - integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, - & j,iret - real (kind=kind_io8) alamd,dxin,aphi,x,sum1,sum2,y,dlati,wlon, - & rnlat,dxout,dphi,dlat,facns,tem,blno, - & blto -! -! interpolation from lat/lon grid to other lat/lon grid -! - real (kind=kind_io8) gauin (imxin,jmxin), regout(imxout,jmxout) - &, rlnout(imxout), rltout(jmxout) - logical gaus -! - real, allocatable :: gaul(:) - real (kind=kind_io8) ddx(imxout),ddy(jmxout) - integer iindx1(imxout), iindx2(imxout), - & jindx1(jmxout), jindx2(jmxout) - integer jmxsav,n,kspla - data jmxsav/0/ - save jmxsav, gaul, dlati - real (kind=kind_io8) radi - real (kind=kind_io8) a(jmxin), w(jmxin) -! -! - logical first - integer num_threads - data first /.true./ - save num_threads, first -! - integer len_thread_m, j1_t, j2_t, it - integer num_parthds -! - if (first) then - num_threads = num_parthds() - first = .false. - endif -! - if (jmxin .ne. jmxsav) then - if (jmxsav .gt. 0) deallocate (gaul, stat=iret) - allocate (gaul(jmxin)) - jmxsav = jmxin - if (gaus) then -cjfe call gaulat(gaul,jmxin) -cjfe -! - kspla=4 - call splat(kspla, jmxin, a, w) -! - radi = 180.0 / (4.*atan(1.)) - do n=1,jmxin - gaul(n) = acos(a(n)) * radi - enddo -cjfe - do j=1,jmxin - gaul(j) = 90. - gaul(j) - enddo - else - dlat = -2*blto / float(jmxin-1) - dlati = 1 / dlat - do j=1,jmxin - gaul(j) = blto + (j-1) * dlat - enddo - endif - endif -! -! - dxin = 360. / float(imxin ) -! - do i=1,imxout - alamd = rlnout(i) - i1 = floor((alamd-blno)/dxin) + 1 - ddx(i) = (alamd-blno)/dxin-(i1-1) - iindx1(i) = modulo(i1-1,imxin) + 1 - iindx2(i) = modulo(i1 ,imxin) + 1 - enddo -! -! - len_thread_m = (jmxout+num_threads-1) / num_threads -! - if (gaus) then -! -!$omp parallel do private(j1_t,j2_t,it,j1,j2,jj) -!$omp+private(aphi) -!$omp+shared(num_threads,len_thread_m) -!$omp+shared(jmxin,jmxout,gaul,rltout,jindx1,ddy) -! - do it=1,num_threads ! start of threaded loop ................... - j1_t = (it-1)*len_thread_m+1 - j2_t = min(j1_t+len_thread_m-1,jmxout) -! - j2=1 - do 40 j=j1_t,j2_t - aphi=rltout(j) - do 50 jj=1,jmxin - if(aphi.lt.gaul(jj)) go to 50 - j2=jj - go to 42 - 50 continue - 42 continue - if(j2.gt.2) go to 43 - j1=1 - j2=2 - go to 44 - 43 continue - if(j2.le.jmxin) go to 45 - j1=jmxin-1 - j2=jmxin - go to 44 - 45 continue - j1=j2-1 - 44 continue - jindx1(j)=j1 - jindx2(j)=j2 - ddy(j)=(aphi-gaul(j1))/(gaul(j2)-gaul(j1)) - 40 continue - enddo ! end of threaded loop ................... -!$omp end parallel do -! - else -!$omp parallel do private(j1_t,j2_t,it,j1,j2,jtem) -!$omp+private(aphi) -!$omp+shared(num_threads,len_thread_m) -!$omp+shared(jmxin,jmxout,gaul,rltout,jindx1,ddy,dlati,blto) -! - do it=1,num_threads ! start of threaded loop ................... - j1_t = (it-1)*len_thread_m+1 - j2_t = min(j1_t+len_thread_m-1,jmxout) -! - j2=1 - do 400 j=j1_t,j2_t - aphi=rltout(j) - jtem = (aphi - blto) * dlati + 1 - if (jtem .ge. 1 .and. jtem .lt. jmxin) then - j1 = jtem - j2 = j1 + 1 - ddy(j)=(aphi-gaul(j1))/(gaul(j2)-gaul(j1)) - elseif (jtem .eq. jmxin) then - j1 = jmxin - j2 = jmxin - ddy(j)=1.0 - else - j1 = 1 - j2 = 1 - ddy(j)=1.0 - endif -! - jindx1(j) = j1 - jindx2(j) = j2 - 400 continue - enddo ! end of threaded loop ................... -!$omp end parallel do - endif -! -! write(6,*) 'ga2la' -! write(6,*) 'iindx1' -! write(6,*) (iindx1(n),n=1,imxout) -! write(6,*) 'iindx2' -! write(6,*) (iindx2(n),n=1,imxout) -! write(6,*) 'jindx1' -! write(6,*) (jindx1(n),n=1,jmxout) -! write(6,*) 'jindx2' -! write(6,*) (jindx2(n),n=1,jmxout) -! write(6,*) 'ddy' -! write(6,*) (ddy(n),n=1,jmxout) -! write(6,*) 'ddx' -! write(6,*) (ddx(n),n=1,jmxout) -! -! -!$omp parallel do private(j1_t,j2_t,it,i,i1,i2) -!$omp+private(j,j1,j2,x,y) -!$omp+shared(num_threads,len_thread_m) -!$omp+shared(imxout,iindx1,jindx1,ddx,ddy,gauin,regout) -! - do it=1,num_threads ! start of threaded loop ................... - j1_t = (it-1)*len_thread_m+1 - j2_t = min(j1_t+len_thread_m-1,jmxout) -! - do j=j1_t,j2_t - y = ddy(j) - j1 = jindx1(j) - j2 = jindx2(j) - do i=1,imxout - x = ddx(i) - i1 = iindx1(i) - i2 = iindx2(i) - regout(i,j) = (1.-x)*((1.-y)*gauin(i1,j1) + y*gauin(i1,j2)) - & + x *((1.-y)*gauin(i2,j1) + y*gauin(i2,j2)) - enddo - enddo - enddo ! end of threaded loop ................... -!$omp end parallel do -! - sum1 = 0. - sum2 = 0. - do i=1,imxin - sum1 = sum1 + gauin(i,1) - sum2 = sum2 + gauin(i,jmxin) - enddo - sum1 = sum1 / float(imxin) - sum2 = sum2 / float(imxin) -! - if (gaus) then - if (rnlat .gt. 0.0) then - do i=1,imxout - regout(i, 1) = sum1 - regout(i,jmxout) = sum2 - enddo - else - do i=1,imxout - regout(i, 1) = sum2 - regout(i,jmxout) = sum1 - enddo - endif - else - if (blto .lt. 0.0) then - if (rnlat .gt. 0.0) then - do i=1,imxout - regout(i, 1) = sum2 - regout(i,jmxout) = sum1 - enddo - else - do i=1,imxout - regout(i, 1) = sum1 - regout(i,jmxout) = sum2 - enddo - endif - else - if (rnlat .lt. 0.0) then - do i=1,imxout - regout(i, 1) = sum2 - regout(i,jmxout) = sum1 - enddo - else - do i=1,imxout - regout(i, 1) = sum1 - regout(i,jmxout) = sum2 - enddo - endif - endif - endif -! - return - end - -!> Set vegetation, soil and slope type at undefined model points. -!! -!! @param[inout] vegtype Vegetation type -!! @param[inout] soiltype Soil type -!! @param[inout] slptype Slope type -!! @param[in] slmask Land-sea-ice mask. -!! @param[in] len Number of model points to process. -!! @author Shrinivas Moorthi - subroutine landtyp(vegtype,soiltype,slptype,slmask,len) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) vegtype(len),soiltype(len),slmask(len) - +, slptype(len) -! -! make sure that the soil type and veg type are non-zero over land -! - do i = 1, len - if (slmask(i) .eq. 1) then - if (vegtype(i) .eq. 0.) vegtype(i) = 7 - if (soiltype(i) .eq. 0.) soiltype(i) = 2 - if (slptype(i) .eq. 0.) slptype(i) = 1 - endif - enddo - return - end subroutine landtyp - -!> Calculate gaussian latitudes. -!! -!! @param[out] gaul Gaussian latitudes -!! @param[in] k Number of latitudes -!! @author Shrinivas Moorthi - subroutine gaulat(gaul,k) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer n,k - real (kind=kind_io8) radi - real (kind=kind_io8) a(k), w(k), gaul(k) -! - call splat(4, k, a, w) -! - radi = 180.0 / (4.*atan(1.)) - do n=1,k - gaul(n) = acos(a(n)) * radi - enddo -! -! print *,'gaussian lat (deg) for jmax=',k -! print *,(gaul(n),n=1,k) -! - return - 70 write(6,6000) - 6000 format(//5x,'error in gauaw'//) - stop - end - -!> Add initial SST anomaly to date interpolated climatology -!! -!! @param[in] tsfan0 Skin temperature/SST analysis at initial time. -!! @param[in] tsfclm Skin temperature/SST climatology. -!! @param[in] tsfcl0 Skin temperature/SST climatology at initial time. -!! @param[out] tsfanl Updated skin temperature/SST. -!! @param[in] len Number of model points to process. -!! @author Shrinivas Moorthi - subroutine anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len) -! - use machine , only : kind_io8,kind_io4 - implicit none - integer i,len - real (kind=kind_io8) tsfanl(len), tsfan0(len), - & tsfclm(len), tsfcl0(len) -! -! time interpolation of anomalies -! add initial anomaly to date interpolated climatology -! - write(6,*) 'anomint' - do i=1,len - tsfanl(i) = tsfan0(i) - tsfcl0(i) + tsfclm(i) - enddo - return - end - -!> Driver routine that reads in climatological data for a given time, -!! and, if necessary, interpolates it to the model grid. -!! -!! @param[in] lugb Fortran unit number of GRIB1 climatological data. -!! @param[in] iy Cycle year. -!! @param[in] im Cycle month. -!! @param[in] id Cycle day. -!! @param[in] ih Cycle hour. -!! @param[in] fh Forecast hour. -!! @param[in] len Number of model points to process. -!! @param[in] lsoil Number of soil layers. -!! @param[in] slmask Model land-sea-ice mask. -!! @param[in] fntsfc Climatological SST file. -!! @param[in] fnwetc Climatological soil wetness file. -!! @param[in] fnsnoc Climatological snow depth file. -!! @param[in] fnzorc Climatological roughness length file. Or 'igbp' -!! to use igbp vegetation type lookup table. Or 'sib' to use sib -!! vegeation type lookup table. -!! @param[in] fnalbc Climatological snow-free albedo file. -!! @param[in] fnaisc Climatological sea ice mask file. -!! @param[in] fntg3c Climatological soil substrate temperature file. -!! @param[in] fnscvc Climatological snow cover file. -!! @param[in] fnsmcc Climatological soil moisture file. -!! @param[in] fnstcc Climatological soil temperature file. -!! @param[in] fnacnc Climatological sea ice concentration file. -!! @param[in] fnvegc Climatological vegetation greenness file. -!! @param[in] fnvetc Climatological vegetation type file. -!! @param[in] fnsotc Climatological soil type file. -!! @param[in] fnvmnc Climatological minimum vegetation greenness file. -!! @param[in] fnvmxc Climatological maximum vegetation greenness file. -!! @param[in] fnslpc Climatological slope type file. -!! @param[in] fnabsc Climatological maximum snow albedo file. -!! @param[out] tsfclm Climatological skin temperature/SST on model grid. -!! @param[out] tsfcl2 Climatological skin temperature/SST on model grid -!! at time minus deltsfc. -!! @param[out] wetclm Climatological soil wetness on model grid. -!! @param[out] snoclm Climatological liquid equivalent snow depth on model grid. -!! @param[out] zorclm Climatological roughness length on model grid. -!! @param[out] albclm Climatological snow-free albedo on model grid. -!! @param[out] aisclm Climatological sea ice mask on model grid. -!! @param[out] tg3clm Climatological soil substrate temperature on model -!! grid. -!! @param[out] cvclm Climatological convective cloud cover on model grid. -!! @param[out] cvbclm Climatological convective cloud base on model grid. -!! @param[out] cvtclm Climatological convective cloud top on model grid. -!! @param[out] cnpclm Climatological canopy water content on model grid. -!! @param[out] smcclm Climatological soil moisture on model grid. -!! @param[out] stcclm Climatologcial soil temperature on model grid. -!! @param[out] sliclm Climatological model land-sea-ice mask. -!! @param[out] scvclm Climatological snow cover on model grid. -!! @param[out] acnclm Climatological sea ice concentration on model grid. -!! @param[out] vegclm Climatological vegetation greenness on model grid. -!! @param[out] vetclm Climatological vegetation type on model grid. -!! @param[out] sotclm Climatological soil type on model grid. -!! @param[out] alfclm Climatological fraction for strongly and weakly -!! zenith angle dependent albedo on model grid. -!! @param[out] vmnclm Climatological minimum vegetation greenness on -!! model grid. -!! @param[out] vmxclm Climatological maximum vegetation greenness on -!! model grid. -!! @param[out] slpclm Climatological slope type on model grid. -!! @param[out] absclm Climatological maximum snow albedo on model grid. -!! @param[in] kpdtsf Grib parameter number of skin temperature/SST. -!! @param[in] kpdwet Grib parameter number of soil wetness. -!! @param[in] kpdsno Grib parameter number of liquid equivalent snow -!! depth. -!! @param[in] kpdzor Grib parameter number of roughness length. -!! @param[in] kpdalb Grib parameter number of snow-free albedo. -!! @param[in] kpdais Grib parameter number of sea ice mask. -!! @param[in] kpdtg3 Grib parameter number of soil substrate -!! temperature. -!! @param[in] kpdscv Grib parameter number of snow cover. -!! @param[in] kpdacn Grib parameter number of sea ice concentration. -!! @param[in] kpdsmc Grib parameter number of soil moisture. -!! @param[in] kpdstc Grib parameter number of soil temperature. -!! @param[in] kpdveg Grib parameter number of vegetation greenness. -!! @param[in] kpdvet Grib parameter number of vegetation type. -!! @param[in] kpdsot Grib parameter number of soil type. -!! @param[in] kpdalf Grib parameter number for fraction for strongly -!! and weakly zenith angle dependent albedo. -!! @param[in] tsfcl0 Climatological SST at forecast -!! hour 0. -!! @param[in] kpdvmn Grib parameter number of minimum vegetation -!! greenness. -!! @param[in] kpdvmx Grib parameter number of maximum vegetation -!! greenness. -!! @param[in] kpdslp Grib parameter number of slope type. -!! @param[in] kpdabs Grib parameter number of maximum snow albedo. -!! @param[in] deltsfc Cycling frequency in hours. -!! @param[in] lanom When true, do sst anomaly interpolation. -!! @param[in] imsk 'i' dimension of the high-res mask used for -!! climatological data without a bitmap. -!! @param[in] jmsk 'j' dimension of the high-res mask used for -!! climatological data without a bitmap. -!! @param[in] slmskh The high-resolution mask used for -!! climatological data without a bitmap. -!! @param[in] outlat Model latitudes -!! @param[in] outlon Model longitudes -!! @param[in] gaus When true, the high-res mask is on a gaussian grid. -!! @param[in] blno Corner point longitude of the high-res mask. -!! @param[in] blto Corner point latitude of the high-res mask. -!! @param[in] me MPI task number. -!! @param[in] lprnt Turn of diagnostic print. -!! @param[in] iprnt Index of diagnotic print point. -!! @param[in] fnalbc2 File containing climatological fraction for -!! strongly and weakly zenith angle dependent albedo. -!! @param[in] ialb Use modis albedo when '1'. Use brigleb when '0'. -!! @param[in] tile_num_ch Model tile number to process. -!! @param[in] i_index The 'i' indices of the model grid to process. -!! @param[in] j_index The 'j' indices of the model grid to process. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, - & slmask,fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fnvetc,fnsotc, - & fnvmnc,fnvmxc,fnslpc,fnabsc, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm, - & vetclm,sotclm,alfclm, - & vmnclm,vmxclm,slpclm,absclm, - & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kpdvet,kpdsot,kpdalf,tsfcl0, - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & deltsfc, lanom - &, imsk, jmsk, slmskh, outlat, outlon - &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb - &, tile_num_ch, i_index, j_index) -! - use machine , only : kind_io8,kind_io4 - implicit none - character(len=*), intent(in) :: tile_num_ch - integer, intent(in) :: i_index(len), j_index(len) - real (kind=kind_io8) rjday,wei1x,wei2x,rjdayh,wei2m,wei1m,wei1s, - & wei2s,fh,stcmon1s,blto,blno,deltsfc,rjdayh2 - real (kind=kind_io8) wei1y,wei2y - integer jdoy,jday,jh,jdow,mmm,mmp,mm,iret,monend,i,k,jm,jd,iy4, - & jy,mon1,is2,isx,kpd9,is1,l,nn,mon2,mon,is,kpdsno, - & kpdzor,kpdtsf,kpdwet,kpdscv,kpdacn,kpdais,kpdtg3,im,id, - & lugb,iy,len,lsoil,ih,kpdsmc,iprnt,me,m1,m2,k1,k2, - & kpdvet,kpdsot,kpdstc,kpdveg,jmsk,imsk,j,ialb - &, kpdvmn,kpdvmx,kpdslp,kpdabs,landice_cat - integer kpdalb(4), kpdalf(2) -! - character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fnvetc,fnsotc,fnalbc2 - &, fnvmnc,fnvmxc,fnslpc,fnabsc - real (kind=kind_io8) tsfclm(len),tsfcl2(len), - & wetclm(len),snoclm(len), - & zorclm(len),albclm(len,4),aisclm(len), - & tg3clm(len),acnclm(len), - & cvclm (len),cvbclm(len),cvtclm(len), - & cnpclm(len), - & smcclm(len,lsoil),stcclm(len,lsoil), - & sliclm(len),scvclm(len),vegclm(len), - & vetclm(len),sotclm(len),alfclm(len,2) - &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len) - real (kind=kind_io8) slmskh(imsk,jmsk) - real (kind=kind_io8) outlat(len), outlon(len) -! - real (kind=kind_io8) slmask(len), tsfcl0(len) - real (kind=kind_io8), allocatable :: slmask_noice(:) -! - logical lanom, gaus, first -! -! set z0 based on sib vegetation type - real (kind=kind_io8) z0_sib(13) - data z0_sib /2.653, 0.826, 0.563, 1.089, 0.854, 0.856, - & 0.035, 0.238, 0.065, 0.076, 0.011, 0.125, - & 0.011 / -! set z0 based on igbp vegetation type - real (kind=kind_io8) z0_igbp_min(20), z0_igbp_max(20) - real (kind=kind_io8) z0_season(12) - data z0_igbp_min /1.089, 2.653, 0.854, 0.826, 0.800, 0.050, - & 0.030, 0.856, 0.856, 0.150, 0.040, 0.130, - & 1.000, 0.250, 0.011, 0.011, 0.001, 0.076, - & 0.050, 0.030/ - data z0_igbp_max /1.089, 2.653, 0.854, 0.826, 0.800, 0.050, - & 0.030, 0.856, 0.856, 0.150, 0.040, 0.130, - & 1.000, 0.250, 0.011, 0.011, 0.001, 0.076, - & 0.050, 0.030/ -! -! dayhf : julian day of the middle of each month -! - real (kind=kind_io8) dayhf(13) - data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0, - & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/ -! - real (kind=kind_io8) fha(5) - real(4) fha4(5) - integer w3kindreal,w3kindint - integer ida(8),jda(8),ivtyp, kpd7 -! - real (kind=kind_io8), allocatable :: tsf(:,:),sno(:,:), - & zor(:,:),wet(:,:), - & ais(:,:), acn(:,:), scv(:,:), smc(:,:,:), - & tg3(:), alb(:,:,:), alf(:,:), - & vet(:), sot(:), tsf2(:), - & veg(:,:), stc(:,:,:) - &, vmn(:), vmx(:), slp(:), absm(:) -! - integer mon1s, mon2s, sea1s, sea2s, sea1, sea2, hyr1, hyr2 - data first/.true./ - data mon1s/0/, mon2s/0/, sea1s/0/, sea2s/0/ -! - save first, tsf, sno, zor, wet, ais, acn, scv, smc, tg3, - & alb, alf, vet, sot, tsf2, veg, stc, - & vmn, vmx, slp, absm, - & mon1s, mon2s, sea1s, sea2s, dayhf, k1, k2, m1, m2, - & landice_cat -! - logical lprnt -! - do i=1,len - tsfclm(i) = 0.0 - tsfcl2(i) = 0.0 - snoclm(i) = 0.0 - wetclm(i) = 0.0 - zorclm(i) = 0.0 - aisclm(i) = 0.0 - tg3clm(i) = 0.0 - acnclm(i) = 0.0 - cvclm(i) = 0.0 - cvbclm(i) = 0.0 - cvtclm(i) = 0.0 - cnpclm(i) = 0.0 - sliclm(i) = 0.0 - scvclm(i) = 0.0 - vmnclm(i) = 0.0 - vmxclm(i) = 0.0 - slpclm(i) = 0.0 - absclm(i) = 0.0 - enddo - do k=1,lsoil - do i=1,len - smcclm(i,k) = 0.0 - stcclm(i,k) = 0.0 - enddo - enddo - do k=1,4 - do i=1,len - albclm(i,k) = 0.0 - enddo - enddo - do k=1,2 - do i=1,len - alfclm(i,k) = 0.0 - enddo - enddo -! - iret = 0 - monend = 9999 -! - if (first) then -! -! allocate variables to be saved -! - allocate (tsf(len,2), sno(len,2), zor(len,2), - & wet(len,2), ais(len,2), acn(len,2), - & scv(len,2), smc(len,lsoil,2), - & tg3(len), alb(len,4,2), alf(len,2), - & vet(len), sot(len), tsf2(len), -!clu [+1l] add vmn, vmx, slp, abs - & vmn(len), vmx(len), slp(len), absm(len), - & veg(len,2), stc(len,lsoil,2)) -! -! get tsf climatology for the begining of the forecast -! - if (fh > 0.0) then -!cbosu - if (me == 0) print*,'bosu fh gt 0' - - iy4 = iy - if (iy < 101) iy4 = 1900 + iy4 - fha = 0 - ida = 0 - jda = 0 -! fha(2) = nint(fh) - ida(1) = iy - ida(2) = im - ida(3) = id - ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif - jy = jda(1) - jm = jda(2) - jd = jda(3) - jh = jda(5) - if (me == 0) write(6,*) ' forecast jy,jm,jd,jh', - & jy,jm,jd,jh - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jda,jdow,jdoy,jday) - rjday = jdoy + jda(5) / 24. - if(rjday < dayhf(1)) rjday = rjday + 365. -! - if (me == 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh -! -! for monthly mean climatology -! - monend = 12 - do mm=1,monend - mmm = mm - mmp = mm + 1 - if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then - mon1 = mmm - mon2 = mmp - go to 10 - endif - enddo - print *,'FATAL ERROR: Wrong rjday',rjday - call abort - 10 continue - wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) - wei2m = 1.0 - wei1m -! wei2m = (rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1)) - if (mon2 == 13) mon2 = 1 - if (me == 0) print *,'rjday,mon1,mon2,wei1m,wei2m=', - & rjday,mon1,mon2,wei1m,wei2m -! -! read monthly mean climatology of tsf -! - kpd7 = -1 - do nn=1,2 - mon = mon1 - if (nn == 2) mon = mon2 - call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask, - & tsf(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - enddo -! -! tsf at the begining of forecast i.e. fh=0 -! - do i=1,len - tsfcl0(i) = wei1m * tsf(i,1) + wei2m * tsf(i,2) - enddo - endif - endif -! -! compute current jy,jm,jd,jh of forecast and the day of the year -! - iy4 = iy - if (iy < 101) iy4=1900+iy4 - fha = 0 - ida = 0 - jda = 0 - fha(2) = nint(fh) - ida(1) = iy - ida(2) = im - ida(3) = id - ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif - jy = jda(1) - jm = jda(2) - jd = jda(3) - jh = jda(5) -! if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=', -! & jy,jm,jd,jh,rjday - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jda,jdow,jdoy,jday) - rjday = jdoy + jda(5) / 24. - if(rjday < dayhf(1)) rjday = rjday + 365. - - if (me == 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=', - & jy,jm,jd,jh,rjday -! - if (me == 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh -! -! for monthly mean climatology -! - monend = 12 - do mm=1,monend - mmm = mm - mmp = mm + 1 - if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then - mon1 = mmm - mon2 = mmp - go to 20 - endif - enddo - print *,'FATAL ERROR: Wrong rjday',rjday - call abort - 20 continue - wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) - wei2m = 1.0 - wei1m -! wei2m = (rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1)) - if (mon2 == 13) mon2 = 1 - if (me == 0) print *,'rjday,mon1,mon2,wei1m,wei2m=', - & rjday,mon1,mon2,wei1m,wei2m -! -! for seasonal mean climatology -! - monend = 4 - is = im/3 + 1 - if (is == 5) is = 1 - do mm=1,monend - mmm = mm*3 - 2 - mmp = (mm+1)*3 - 2 - if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then - sea1 = mmm - sea2 = mmp - go to 30 - endif - enddo - print *,'FATAL ERROR: Wrong rjday',rjday - call abort - 30 continue - wei1s = (dayhf(sea2)-rjday)/(dayhf(sea2)-dayhf(sea1)) - wei2s = 1.0 - wei1s -! wei2s = (rjday-dayhf(sea1))/(dayhf(sea2)-dayhf(sea1)) - if (sea2 == 13) sea2 = 1 - if (me == 0) print *,'rjday,sea1,sea2,wei1s,wei2s=', - & rjday,sea1,sea2,wei1s,wei2s -! -! for summer and winter values (maximum and minimum). -! - monend = 2 - is = im/6 + 1 - if (is == 3) is = 1 - do mm=1,monend - mmm = mm*6 - 5 - mmp = (mm+1)*6 - 5 - if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then - hyr1 = mmm - hyr2 = mmp - go to 31 - endif - enddo - print *,'FATAL ERROR: Wrong rjday',rjday - call abort - 31 continue - wei1y = (dayhf(hyr2)-rjday)/(dayhf(hyr2)-dayhf(hyr1)) - wei2y = 1.0 - wei1y -! wei2y = (rjday-dayhf(hyr1))/(dayhf(hyr2)-dayhf(hyr1)) - if (hyr2 == 13) hyr2 = 1 - if (me == 0) print *,'rjday,hyr1,hyr2,wei1y,wei2y=', - & rjday,hyr1,hyr2,wei1y,wei2y -! -! start reading in climatology and interpolate to the date -! - first_time : if (first) then -!cbosu - if (me == 0) print*,'bosu first time thru' -! -! annual mean climatology -! -! fraction of vegetation field for albedo -- there are two -! fraction fields in this version: strong zenith angle dependent -! and weak zenith angle dependent -! - kpd9 = -1 -cjfe - alf=0. -cjfe - - kpd7=-1 - if (ialb == 1) then -!cbosu still need facsf and facwf. read them from the production -!cbosu file - if ( index(fnalbc2, "tileX.nc") == 0) then ! grib file - call fixrdc(lugb,fnalbc2,kpdalf(1),kpd7,kpd9,slmask - &, alf,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnalbc2, tile_num_ch, i_index, j_index, - & kpdalf(1), alf(:,1), 1, len, me) - endif - else - call fixrdc(lugb,fnalbc,kpdalf(1),kpd7,kpd9,slmask - &, alf,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - endif - do i = 1, len - if(slmask(i).eq.1.) then - alf(i,2) = 100. - alf(i,1) - endif - enddo -! -! deep soil temperature -! - if(fntg3c(1:8).ne.' ') then - if ( index(fntg3c, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fntg3c,kpdtg3,kpd7,kpd9,slmask, - & tg3,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fntg3c, tile_num_ch, i_index, j_index, - & kpdtg3, tg3, 1, len, me) - endif - endif -! -! vegetation type -! -! when using the new gldas soil moisture climatology, a veg type -! dataset must be selected. -! - if(fnvetc(1:8).ne.' ') then - if ( index(fnvetc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnvetc,kpdvet,kpd7,kpd9,slmask, - & vet,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - landice_cat=13 - if (maxval(vet)> 13.0) landice_cat=15 - else - call fixrdc_tile(fnvetc, tile_num_ch, i_index, j_index, - & kpdvet, vet, 1, len, me) - landice_cat=15 - endif - if (me .eq. 0) write(6,*) 'climatological vegetation', - & ' type read in.' - elseif(index(fnsmcc,'soilmgldas') /= 0) then ! new soil moisture climo - if (me .eq. 0) write(6,*) 'FATAL ERROR: must choose' - if (me .eq. 0) write(6,*) 'climatological veg type when' - if (me .eq. 0) write(6,*) 'using new gldas soil moisture.' - call abort - endif -! -! soil type -! - if(fnsotc(1:8).ne.' ') then - if ( index(fnsotc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnsotc,kpdsot,kpd7,kpd9,slmask, - & sot,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnsotc, tile_num_ch, i_index, j_index, - & kpdsot, sot, 1, len, me) - endif - if (me .eq. 0) write(6,*) 'climatological soil type read in.' - endif - -! -! min vegetation cover -! - if(fnvmnc(1:8).ne.' ') then - if ( index(fnvmnc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnvmnc,kpdvmn,kpd7,kpd9,slmask, - & vmn,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnvmnc, tile_num_ch, i_index, j_index, - & 257, vmn, 99, len, me) - - endif - if (me .eq. 0) write(6,*) 'climatological shdmin read in.' - endif -! -! max vegetation cover -! - if(fnvmxc(1:8).ne.' ') then - if ( index(fnvmxc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnvmxc,kpdvmx,kpd7,kpd9,slmask, - & vmx,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnvmxc, tile_num_ch, i_index, j_index, - & 256, vmx, 99, len, me) - endif - if (me .eq. 0) write(6,*) 'climatological shdmax read in.' - endif -! -! slope type -! - if(fnslpc(1:8).ne.' ') then - if ( index(fnslpc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnslpc,kpdslp,kpd7,kpd9,slmask, - & slp,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnslpc, tile_num_ch, i_index, j_index, - & kpdslp, slp, 1, len, me) - endif - if (me .eq. 0) write(6,*) 'climatological slope read in.' - endif -! -! max snow albeod -! - if(fnabsc(1:8).ne.' ') then - if ( index(fnabsc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnabsc,kpdabs,kpd7,kpd9,slmask, - & absm,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnabsc, tile_num_ch, i_index, j_index, - & kpdabs, absm, 1, len, me) - endif - if (me .eq. 0) write(6,*) 'climatological snoalb read in.' - endif -!clu ---------------------------------------------------------------------- -! - is1 = sea1/3 + 1 - is2 = sea2/3 + 1 - if (is1 .eq. 5) is1 = 1 - if (is2 .eq. 5) is2 = 1 - do nn=1,2 -! -! seasonal mean climatology - if(nn.eq.1) then - isx=is1 - else - isx=is2 - endif - if(isx.eq.1) kpd9 = 12 - if(isx.eq.2) kpd9 = 3 - if(isx.eq.3) kpd9 = 6 - if(isx.eq.4) kpd9 = 9 -! -! seasonal mean climatology -! -! albedo -! there are four albedo fields in this version: -! two for strong zeneith angle dependent (visible and near ir) -! and two for weak zeneith angle dependent (vis ans nir) -! - if (ialb == 0) then - kpd7=-1 - do k = 1, 4 - call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,kpd9,slmask, - & alb(1,k,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - enddo - endif -! -! monthly mean climatology -! - mon = mon1 - if (nn .eq. 2) mon = mon2 -!cbosu -!cbosu new snowfree albedo database is monthly. - if (ialb == 1) then - if ( index(fnalbc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - do k = 1, 4 - call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,mon,slmask, - & alb(1,k,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - enddo - else - do k = 1, 4 - call fixrdc_tile(fnalbc, tile_num_ch, i_index, j_index, - & kpdalb(k), alb(:,k,nn), mon, len, me) - enddo - endif - endif - -! if(lprnt) print *,' mon1=',mon1,' mon2=',mon2 -! -! tsf at the current time t -! - kpd7=-1 - call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask, - & tsf(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) -! if(lprnt) print *,' tsf=',tsf(iprnt,nn),' nn=',nn -! -! tsf...at time t-deltsfc -! -! fh2 = fh - deltsfc -! if (fh2 .gt. 0.0) then -! call fixrd(lugb,fntsfc,kpdtsf,lclim,slmask, -! & iy,im,id,ih,fh2,tsfcl2,len,iret -! &, imsk, jmsk, slmskh, gaus,blno, blto -! &, outlat, outlon, me) -! else -! do i=1,len -! tsfcl2(i) = tsfclm(i) -! enddo -! endif -! -! soil wetness -! - if(fnwetc(1:8).ne.' ') then - kpd7=-1 - call fixrdc(lugb,fnwetc,kpdwet,kpd7,mon,slmask, - & wet(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - elseif(fnsmcc(1:8).ne.' ') then - if (index(fnsmcc,'global_soilmcpc.1x1.grb') /= 0) then ! the old climo data - kpd7=-1 - call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask, - & smc(1,lsoil,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - do l=1,lsoil-1 - do i = 1, len - smc(i,l,nn) = smc(i,lsoil,nn) - enddo - enddo - else ! the new gldas data. it does not have data defined at landice - ! points. so for efficiency, don't have fixrdc try to - ! find a value at landice points as defined by the vet type (vet). - allocate(slmask_noice(len)) - slmask_noice=1.0 - do i = 1, len - if (nint(vet(i)) < 1 .or. - & nint(vet(i)) == landice_cat) then - slmask_noice(i) = 0.0 - endif - enddo - do k = 1, lsoil - if (k==1) kpd7=10 ! 0_10 cm (pds octs 11 and 12) - if (k==2) kpd7=2600 ! 10_40 cm - if (k==3) kpd7=10340 ! 40_100 cm - if (k==4) kpd7=25800 ! 100_200 cm - call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask_noice, - & smc(1,k,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - enddo - deallocate(slmask_noice) - endif - else - write(6,*) 'FATAL ERROR: climatological soil' - write(6,*) 'wetness file not given.' - call abort - endif -! -! soil temperature -! - if(fnstcc(1:8).ne.' ') then - kpd7=-1 - call fixrdc(lugb,fnstcc,kpdstc,kpd7,mon,slmask, - & stc(1,lsoil,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - do l=1,lsoil-1 - do i = 1, len - stc(i,l,nn) = stc(i,lsoil,nn) - enddo - enddo - endif -! -! sea ice -! - kpd7=-1 - if(fnacnc(1:8).ne.' ') then - call fixrdc(lugb,fnacnc,kpdacn,kpd7,mon,slmask, - & acn(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - elseif(fnaisc(1:8).ne.' ') then - call fixrdc(lugb,fnaisc,kpdais,kpd7,mon,slmask, - & ais(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - write(6,*) 'FATAL ERROR: climatological ice' - write(6,*) 'cover file not given.' - call abort - endif -! -! snow depth -! - kpd7=-1 - call fixrdc(lugb,fnsnoc,kpdsno,kpd7,mon,slmask, - & sno(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) -! -! snow cover -! - if(fnscvc(1:8).ne.' ') then - kpd7=-1 - call fixrdc(lugb,fnscvc,kpdscv,kpd7,mon,slmask, - & scv(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - write(6,*) 'climatological snow cover read in.' - endif -! -! surface roughness -! - if(fnzorc(1:3) == 'sib') then - if (me == 0) then - write(6,*) 'roughness length to be set from sib veg type' - endif - elseif(fnzorc(1:4) == 'igbp') then - if (me == 0) then - write(6,*) 'roughness length to be set from igbp veg type' - endif - else - kpd7=-1 - call fixrdc(lugb,fnzorc,kpdzor,kpd7,mon,slmask, - & zor(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - endif -! - do i = 1, len -! set clouds climatology to zero - cvclm (i) = 0. - cvbclm(i) = 0. - cvtclm(i) = 0. -! - cnpclm(i) = 0. !set canopy water content climatology to zero - enddo -! -! vegetation cover -! - if(fnvegc(1:8).ne.' ') then - if ( index(fnvegc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnvegc,kpdveg,kpd7,mon,slmask, - & veg(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnvegc, tile_num_ch, i_index, j_index, - & kpdveg, veg(:,nn), mon, len, me) - endif - if (me .eq. 0) write(6,*) 'climatological vegetation', - & ' cover read in for mon=',mon - endif - - enddo -! - mon1s = mon1 ; mon2s = mon2 ; sea1s = sea1 ; sea2s = sea2 -! - if (me == 0) print *,' mon1s=',mon1s,' mon2s=',mon2s - &,' sea1s=',sea1s,' sea2s=',sea2s -! - k1 = 1 ; k2 = 2 - m1 = 1 ; m2 = 2 -! - first = .false. - endif first_time -! -! to get tsf climatology at the previous call to sfccycle -! -! if (fh-deltsfc >= 0.0) then - rjdayh = rjday - deltsfc/24.0 -! else -! rjdayh = rjday -! endif -! if(lprnt) print *,' rjdayh=',rjdayh,' mon1=',mon1,' mon2=' -! &,mon2,' mon1s=',mon1s,' mon2s=',mon2s,' k1=',k1,' k2=',k2 - if (rjdayh .ge. dayhf(mon1)) then - if (mon2 .eq. 1) mon2 = 13 - wei1x = (dayhf(mon2)-rjdayh)/(dayhf(mon2)-dayhf(mon1)) - wei2x = 1.0 - wei1x - if (mon2 .eq. 13) mon2 = 1 - else - rjdayh2 = rjdayh - if (rjdayh .lt. dayhf(1)) rjdayh2 = rjdayh2 + 365.0 - if (mon1s .eq. mon1) then - mon1s = mon1 - 1 - if (mon1s .eq. 0) mon1s = 12 - k2 = k1 - k1 = mod(k2,2) + 1 - mon = mon1s - kpd7=-1 - call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask, - & tsf(1,k1),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - endif - mon2s = mon1s + 1 -! if (mon2s .eq. 1) mon2s = 13 - wei1x = (dayhf(mon2s)-rjdayh2)/(dayhf(mon2s)-dayhf(mon1s)) - wei2x = 1.0 - wei1x - if (mon2s .eq. 13) mon2s = 1 - do i=1,len - tsf2(i) = wei1x * tsf(i,k1) + wei2x * tsf(i,k2) - enddo - endif -! -!cbosu new albedo is monthly - if (sea1 .ne. sea1s) then - sea1s = sea1 - sea2s = sea2 - m1 = mod(m1,2) + 1 - m2 = mod(m1,2) + 1 -! -! seasonal mean climatology -! - isx = sea2/3 + 1 - if (isx == 5) isx = 1 - if (isx == 1) kpd9 = 12 - if (isx == 2) kpd9 = 3 - if (isx == 3) kpd9 = 6 - if (isx == 4) kpd9 = 9 -! -! albedo -! there are four albedo fields in this version: -! two for strong zeneith angle dependent (visible and near ir) -! and two for weak zeneith angle dependent (vis ans nir) -! -!cbosu - if (ialb == 0) then - kpd7=-1 - do k = 1, 4 - call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,kpd9,slmask - &, alb(1,k,m2),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - enddo - endif - - endif - - if (mon1 .ne. mon1s) then - - mon1s = mon1 - mon2s = mon2 - k1 = mod(k1,2) + 1 - k2 = mod(k1,2) + 1 -! -! monthly mean climatology -! - mon = mon2 - nn = k2 -!cbosu - if (ialb == 1) then - if (me == 0) print*,'bosu 2nd time in clima for month ', - & mon, k1,k2 - if ( index(fnalbc, "tileX.nc") == 0) then ! grib file - kpd7 = -1 - do k = 1, 4 - call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,mon,slmask, - & alb(1,k,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - enddo - else - do k = 1, 4 - call fixrdc_tile(fnalbc, tile_num_ch, i_index, j_index, - & kpdalb(k), alb(:,k,nn), mon, len, me) - enddo - endif - endif -! -! tsf at the current time t -! - kpd7 = -1 - call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask, - & tsf(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) -! -! soil wetness -! - if (fnwetc(1:8).ne.' ') then - kpd7=-1 - call fixrdc(lugb,fnwetc,kpdwet,kpd7,mon,slmask, - & wet(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - elseif (fnsmcc(1:8).ne.' ') then - if (index(fnsmcc,'global_soilmcpc.1x1.grb') /= 0) then ! the old climo data - kpd7=-1 - call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask, - & smc(1,lsoil,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - do l=1,lsoil-1 - do i = 1, len - smc(i,l,nn) = smc(i,lsoil,nn) - enddo - enddo - else ! the new gldas data. it does not have data defined at landice - ! points. so for efficiency, don't have fixrdc try to - ! find a value at landice points as defined by the vet type (vet). - allocate(slmask_noice(len)) - slmask_noice=1.0 - do i = 1, len - if (nint(vet(i)) < 1 .or. - & nint(vet(i)) == landice_cat) then - slmask_noice(i) = 0.0 - endif - enddo - do k = 1, lsoil - if (k==1) kpd7=10 ! 0_10 cm (pds octs 11 and 12) - if (k==2) kpd7=2600 ! 10_40 cm - if (k==3) kpd7=10340 ! 40_100 cm - if (k==4) kpd7=25800 ! 100_200 cm - call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask_noice, - & smc(1,k,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - enddo - deallocate(slmask_noice) - endif - else - write(6,*) 'FATAL ERROR: climatological soil' - write(6,*) 'wetness file not given.' - call abort - endif -! -! sea ice -! - kpd7 = -1 - if (fnacnc(1:8).ne.' ') then - call fixrdc(lugb,fnacnc,kpdacn,kpd7,mon,slmask, - & acn(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - elseif (fnaisc(1:8).ne.' ') then - call fixrdc(lugb,fnaisc,kpdais,kpd7,mon,slmask, - & ais(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - write(6,*) 'FATAL ERROR: climatological ice cover' - write(6,*) 'file not given.' - call abort - endif -! -! snow depth -! - kpd7=-1 - call fixrdc(lugb,fnsnoc,kpdsno,kpd7,mon,slmask, - & sno(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) -! -! snow cover -! - if (fnscvc(1:8).ne.' ') then - kpd7=-1 - call fixrdc(lugb,fnscvc,kpdscv,kpd7,mon,slmask, - & scv(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - write(6,*) 'climatological snow cover read in.' - endif -! -! surface roughness -! - if (fnzorc(1:3) == 'sib') then - if (me == 0) then - write(6,*) 'roughness length to be set from sib veg type' - endif - elseif(fnzorc(1:4) == 'igbp') then - if (me == 0) then - write(6,*) 'roughness length to be set from igbp veg type' - endif - else - kpd7=-1 - call fixrdc(lugb,fnzorc,kpdzor,kpd7,mon,slmask, - & zor(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - endif -! -! vegetation cover -! - if (fnvegc(1:8) .ne. ' ') then - if ( index(fnvegc, "tileX.nc") == 0) then ! grib file - kpd7=-1 - call fixrdc(lugb,fnvegc,kpdveg,kpd7,mon,slmask, - & veg(1,nn),len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - else - call fixrdc_tile(fnvegc, tile_num_ch, i_index, j_index, - & kpdveg, veg(:,nn), mon, len, me) - endif -! if (me .eq. 0) write(6,*) 'climatological vegetation', -! & ' cover read in for mon=',mon - endif -! - endif -! -! now perform the time interpolation -! -! when chosen, set the z0 based on the vegetation type. -! for this option to work, namelist variable fnvetc must be -! set to point at the proper vegetation type file. - if (fnzorc(1:3) == 'sib') then - if (fnvetc(1:4) == ' ') then - if (me==0) then - write(6,*) " FATAL ERROR: Must choose sib" - write(6,*) " veg type climo file." - endif - call abort - endif - zorclm = 0.0 - do i=1,len - ivtyp = nint(vet(i)) - if (ivtyp >= 1 .and. ivtyp <= 13) then - zorclm(i) = z0_sib(ivtyp) - endif - enddo - elseif(fnzorc(1:4) == 'igbp') then - if (fnvetc(1:4) == ' ') then - if (me == 0) then - write(6,*) " FATAL ERROR: Must choose igbp" - write(6,*) " veg type climo file." - endif - call abort - endif - zorclm = 0.0 - do i=1,len - ivtyp = nint(vet(i)) - if (ivtyp >= 1 .and. ivtyp <= 20) then - z0_season(1) = z0_igbp_min(ivtyp) - z0_season(7) = z0_igbp_max(ivtyp) - if (outlat(i) < 0.0) then - zorclm(i) = wei1y * z0_season(hyr2) + - & wei2y * z0_season(hyr1) - else - zorclm(i) = wei1y * z0_season(hyr1) + - & wei2y * z0_season(hyr2) - endif - endif - enddo - else - do i=1,len - zorclm(i) = wei1m * zor(i,k1) + wei2m * zor(i,k2) - enddo - endif -! - do i=1,len - tsfclm(i) = wei1m * tsf(i,k1) + wei2m * tsf(i,k2) - snoclm(i) = wei1m * sno(i,k1) + wei2m * sno(i,k2) - cvclm(i) = 0.0 - cvbclm(i) = 0.0 - cvtclm(i) = 0.0 - cnpclm(i) = 0.0 - tsfcl2(i) = tsf2(i) - enddo -! if(lprnt) print *,' tsfclm=',tsfclm(iprnt),' wei1m=',wei1m -! &,' wei2m=',wei2m,' tsfk12=',tsf(iprnt,k1),tsf(iprnt,k2) -! - if (fh .eq. 0.0) then - do i=1,len - tsfcl0(i) = tsfclm(i) - enddo - endif - if (rjdayh .ge. dayhf(mon1)) then - do i=1,len - tsf2(i) = wei1x * tsf(i,k1) + wei2x * tsf(i,k2) - tsfcl2(i) = tsf2(i) - enddo - endif -! if(lprnt) print *,' tsf2=',tsf2(iprnt),' wei1x=',wei1x -! &,' wei2x=',wei2x,' tsfk12=',tsf(iprnt,k1),tsf(iprnt,k2) -! &,' mon1s=',mon1s,' mon2s=',mon2s -! &,' slmask=',slmask(iprnt) -! - if(fnacnc(1:8).ne.' ') then - do i=1,len - acnclm(i) = wei1m * acn(i,k1) + wei2m * acn(i,k2) - enddo - elseif(fnaisc(1:8).ne.' ') then - do i=1,len - aisclm(i) = wei1m * ais(i,k1) + wei2m * ais(i,k2) - enddo - endif -! - if(fnwetc(1:8).ne.' ') then - do i=1,len - wetclm(i) = wei1m * wet(i,k1) + wei2m * wet(i,k2) - enddo - elseif(fnsmcc(1:8).ne.' ') then - do k=1,lsoil - do i=1,len - smcclm(i,k) = wei1m * smc(i,k,k1) + wei2m * smc(i,k,k2) - enddo - enddo - endif -! - if(fnscvc(1:8).ne.' ') then - do i=1,len - scvclm(i) = wei1m * scv(i,k1) + wei2m * scv(i,k2) - enddo - endif -! - if(fntg3c(1:8).ne.' ') then - do i=1,len - tg3clm(i) = tg3(i) - enddo - elseif(fnstcc(1:8).ne.' ') then - do k=1,lsoil - do i=1,len - stcclm(i,k) = wei1m * stc(i,k,k1) + wei2m * stc(i,k,k2) - enddo - enddo - endif -! - if(fnvegc(1:8).ne.' ') then - do i=1,len - vegclm(i) = wei1m * veg(i,k1) + wei2m * veg(i,k2) - enddo - endif -! - if(fnvetc(1:8).ne.' ') then - do i=1,len - vetclm(i) = vet(i) - enddo - endif -! - if(fnsotc(1:8).ne.' ') then - do i=1,len - sotclm(i) = sot(i) - enddo - endif - - -!clu ---------------------------------------------------------------------- -! - if(fnvmnc(1:8).ne.' ') then - do i=1,len - vmnclm(i) = vmn(i) - enddo - endif -! - if(fnvmxc(1:8).ne.' ') then - do i=1,len - vmxclm(i) = vmx(i) - enddo - endif -! - if(fnslpc(1:8).ne.' ') then - do i=1,len - slpclm(i) = slp(i) - enddo - endif -! - if(fnabsc(1:8).ne.' ') then - do i=1,len - absclm(i) = absm(i) - enddo - endif -!clu ---------------------------------------------------------------------- -! -!cbosu diagnostic print - if (me == 0) print*,'monthly albedo weights are ', - & wei1m,' for k', k1, wei2m, ' for k', k2 - - if (ialb == 1) then - do k=1,4 - do i=1,len - albclm(i,k) = wei1m * alb(i,k,k1) + wei2m * alb(i,k,k2) - enddo - enddo - else - do k=1,4 - do i=1,len - albclm(i,k) = wei1s * alb(i,k,m1) + wei2s * alb(i,k,m2) - enddo - enddo - endif -! - do k=1,2 - do i=1,len - alfclm(i,k) = alf(i,k) - enddo - enddo -! -! end of climatology reads -! - return - end subroutine clima - -!> Reads in climatological data on the model grid tile for -!! a given month. Unlike fixrdc, this routine assumes -!! the input data is already interpolated to the model tile. -!! The climatological data must be NetCDF. -!! -!! @param[in] filename_raw The name of the climatological file. -!! @param[in] tile_num_ch The tile number to be processed. -!! @param[in] i_index The 'i' indices of the model grid to process. -!! @param[in] j_index The 'j' indices of the model grid to process. -!! @param[in] kpds Parameter code for the data. -!! @param[out] var The climatological data on the model grid. -!! @param[in] mon Which month of data to read. -!! @param[in] npts Number of model points to process. -!! @param[in] me MPI task number. -!! @author George Gayno NOAA/EMC - subroutine fixrdc_tile(filename_raw, tile_num_ch, - & i_index, j_index, kpds, - & var, mon, npts, me) - use netcdf - use machine , only : kind_io8 - implicit none - character(len=*), intent(in) :: filename_raw - character(len=*), intent(in) :: tile_num_ch - integer, intent(in) :: npts, me, kpds, mon - integer, intent(in) :: i_index(npts) - integer, intent(in) :: j_index(npts) - real(kind_io8), intent(out) :: var(npts) - character(len=500) :: filename - character(len=80) :: errmsg - integer :: i, ii, ncid, t - integer :: error, id_dim - integer :: nx, ny, num_times - integer :: id_var - real(kind=4), allocatable :: dummy(:,:,:) - ii=index(filename_raw,"tileX") - - do i = 1, len(filename) - filename(i:i) = " " - enddo - - filename = filename_raw(1:ii-1) // tile_num_ch // ".nc" - - if (me == 0) print*, ' in fixrdc_tile for mon=',mon, - & ' filename=', trim(filename) - - error=nf90_open(trim(filename), nf90_nowrite, ncid) - if (error /= nf90_noerr) call netcdf_err(error) - - error=nf90_inq_dimid(ncid, 'nx', id_dim) - if (error /= nf90_noerr) call netcdf_err(error) - error=nf90_inquire_dimension(ncid,id_dim,len=nx) - if (error /= nf90_noerr) call netcdf_err(error) - - error=nf90_inq_dimid(ncid, 'ny', id_dim) - if (error /= nf90_noerr) call netcdf_err(error) - error=nf90_inquire_dimension(ncid,id_dim,len=ny) - if (error /= nf90_noerr) call netcdf_err(error) - - error=nf90_inq_dimid(ncid, 'time', id_dim) - if (error /= nf90_noerr) call netcdf_err(error) - error=nf90_inquire_dimension(ncid,id_dim,len=num_times) - if (error /= nf90_noerr) call netcdf_err(error) - - select case (kpds) - case(11) - error=nf90_inq_varid(ncid, 'substrate_temperature', id_var) - case(87) - error=nf90_inq_varid(ncid, 'vegetation_greenness', id_var) - case(159) - error=nf90_inq_varid(ncid, 'maximum_snow_albedo', id_var) - case(189) - error=nf90_inq_varid(ncid, 'visible_black_sky_albedo', id_var) - case(190) - error=nf90_inq_varid(ncid, 'visible_white_sky_albedo', id_var) - case(191) - error=nf90_inq_varid(ncid, 'near_IR_black_sky_albedo', id_var) - case(192) - error=nf90_inq_varid(ncid, 'near_IR_white_sky_albedo', id_var) - case(214) - error=nf90_inq_varid(ncid, 'facsf', id_var) - case(224) - error=nf90_inq_varid(ncid, 'soil_type', id_var) - case(225) - error=nf90_inq_varid(ncid, 'vegetation_type', id_var) - case(236) - error=nf90_inq_varid(ncid, 'slope_type', id_var) - case(256:257) - error=nf90_inq_varid(ncid, 'vegetation_greenness', id_var) - case default - print*,'FATAL ERROR in fixrdc_tile of sfcsub.F.' - print*,'unknown variable.' - call abort - end select - if (error /= nf90_noerr) call netcdf_err(error) - - allocate(dummy(nx,ny,1)) - - if (kpds == 256) then ! max veg greenness - - var = -9999. - do t = 1, num_times - error=nf90_get_var(ncid, id_var, dummy, start=(/1,1,t/), - & count=(/nx,ny,1/) ) - if (error /= nf90_noerr) call netcdf_err(error) - do ii = 1,npts - var(ii) = max(var(ii), dummy(i_index(ii),j_index(ii),1)) - enddo - enddo - - elseif (kpds == 257) then ! min veg greenness - - var = 9999. - do t = 1, num_times - error=nf90_get_var(ncid, id_var, dummy, start=(/1,1,t/), - & count=(/nx,ny,1/) ) - if (error /= nf90_noerr) call netcdf_err(error) - do ii = 1, npts - var(ii) = min(var(ii), dummy(i_index(ii),j_index(ii),1)) - enddo - enddo - - else - - error=nf90_get_var(ncid, id_var, dummy, start=(/1,1,mon/), - & count=(/nx,ny,1/) ) - if (error /= nf90_noerr) call netcdf_err(error) - - do ii = 1, npts - var(ii) = dummy(i_index(ii),j_index(ii),1) - enddo - - endif - - deallocate(dummy) - - error=nf90_close(ncid) - - select case (kpds) - case(159) ! max snow alb - var = var * 100.0 - case(214) ! facsf - where (var < 0.0) var = 0.0 - var = var * 100.0 - case(189:192) - var = var * 100.0 - case(256:257) - var = var * 100.0 - end select - - return - - end subroutine fixrdc_tile - -!> Print the error message for a given netCDF return code. -!! -!! @param[in] error -!! @author Xu Li NOAA/EMC - subroutine netcdf_err(error) - - use netcdf - implicit none - - integer,intent(in) :: error - character(len=256) :: errmsg - - errmsg = nf90_strerror(error) - print*,'FATAL ERROR in sfcsub.F: ', trim(errmsg) - call abort - - end subroutine netcdf_err - -!> Read in grib1 climatology data for a specific month and -!! and horizontally interpolate to the model grid. -!! -!! @param[in] lugb Fortran unit number of the grib1 climatology data file. -!! @param[in] fngrib The name of the grib1 climatology data file. -!! @param[in] kpds5 The grib1 parameter number of the requested data. -!! @param[in] kpds7 The grib1 level indicator of the requested data. -!! @param[in] mon The requested month. -!! @param[in] slmask Model land-sea-ice mask. -!! @param[out] gdata The climatology data interpolated to the model grid. -!! @param[in] len The number of model points to process. -!! @param[in] iret Return code. '0' is success. -!! @param[in] imsk 'i' dimension of the high-res mask used for input -!! data without a bitmap. -!! @param[in] jmsk 'j' dimension of the high-res mask used for input -!! data without a bitmap. -!! @param[in] slmskh The high-resolution mask used for input -!! data witouth a bitmap. -!! @param[in] gaus When true, the high-res mask is on a gaussian grid. -!! @param[in] blno Corner point longitude of the high-res mask. -!! @param[in] blto Corner point latitude of the high-res mask. -!! @param[in] outlat Model latitudes. -!! @param[in] outlon Model longitudes. -!! @param[in] me MPI task number -!! @author Shrinivas Moorthi NOAA/EMC - subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, - & gdata,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : mdata - implicit none - integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, - & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami - &, jj,w3kindreal,w3kindint - real (kind=kind_io8) wlon,elon,rnlat,dlat,dlon,rslat,blno,blto -! - character*500 fngrib -! character*80 fngrib, asgnstr -! - real (kind=kind_io8) slmskh(imsk,jmsk) -! - real (kind=kind_io8) gdata(len), slmask(len) - real (kind=kind_io8), allocatable :: data(:,:), rslmsk(:,:) - real (kind=kind_io8), allocatable :: data8(:) - real (kind=kind_io4), allocatable :: data4(:) - real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) -! - logical lmask, yr2kc, gaus, ijordr - logical*1, allocatable :: lbms(:) -! - integer, intent(in) :: kpds7 - integer kpds(1000),kgds(1000) - integer jpds(1000),jgds(1000), kpds0(1000) - real (kind=kind_io8) outlat(len), outlon(len) -! - allocate(data8(1:mdata)) - allocate(lbms(mdata)) -! -! integer imax_sv, jmax_sv, wlon_sv, rnlat_sv, kpds1_sv -! date imax_sv/0/, jmax_sv/0/, wlon_sv/999.0/, rnlat_sv/999.0/ -! &, kpds1_sv/-1/ -! save imax_sv, jmax_sv, wlon_sv, rnlat_sv, kpds1_sv -! &, rlngrb, rltgrb -! - iret = 0 -! - if (me .eq. 0) write(6,*) ' in fixrdc for mon=',mon - &,' fngrib=',trim(fngrib) -! - close(lugb) - call baopenr(lugb,fngrib,iret) - if (iret .ne. 0) then - write(6,*) ' FATAL ERROR: in opening file ',trim(fngrib) - print *,'FATAL ERROR: in opening file ',trim(fngrib) - call abort - endif - if (me .eq. 0) write(6,*) ' file ',trim(fngrib), - & ' opened. unit=',lugb -! - lugi = 0 -! - lskip = -1 - jpds = -1 - jgds = -1 - jpds(5) = kpds5 - jpds(7) = kpds7 - kpds = jpds - call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, - & lskip,kpds,kgds,iret) - if (me .eq. 0) then - write(6,*) ' first grib record.' - write(6,*) ' kpds( 1-10)=',(kpds(j),j= 1,10) - write(6,*) ' kpds(11-20)=',(kpds(j),j=11,20) - write(6,*) ' kpds(21- )=',(kpds(j),j=21,22) - endif - yr2kc = (kpds(8) / 100) .gt. 0 - kpds0 = jpds - kpds0(4) = -1 - kpds0(18) = -1 - if(iret.ne.0) then - write(6,*) ' FATAL ERROR: in getgbh. iret: ', iret - if (iret==99) write(6,*) ' field not found.' - call abort - endif -! -! handling climatology file -! - lskip = -1 - n = 0 - jpds = kpds0 - jpds(9) = mon - if(jpds(9).eq.13) jpds(9) = 1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal==8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - else if (w3kindreal==4) then - allocate(data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8 = real(data4, kind=kind_io8) - deallocate(data4) - endif - if (me .eq. 0) write(6,*) ' input grib file dates=', - & (kpds(i),i=8,11) - if(jret.eq.0) then - if(ndata.eq.0) then - write(6,*) ' FATAL ERROR: in getgb.' - write(6,*) ' kpds=',kpds - write(6,*) ' kgds=',kgds - call abort - endif - imax=kgds(2) - jmax=kgds(3) - ijmax=imax*jmax - allocate (data(imax,jmax)) - do j=1,jmax - jj = (j-1)*imax - do i=1,imax - data(i,j) = data8(jj+i) - enddo - enddo - if (me .eq. 0) write(6,*) 'imax,jmax,ijmax=',imax,jmax,ijmax - else - write(6,*) ' FATAL ERROR: in getgb - jret=', jret - call abort - endif -! -! if (me == 0) then -! write(6,*) ' maxmin of input as is' -! kmami=1 -! call maxmin(data(1,1),ijmax,kmami) -! endif -! - call getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me) - if (me == 0) then - write(6,*) 'imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat=' - write(6,*) imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat - endif - call subst(data,imax,jmax,dlon,dlat,ijordr) -! -! first get slmask over input grid -! - allocate (rlngrb(imax), rltgrb(jmax)) - allocate (rslmsk(imax,jmax)) - - call setrmsk(kpds5,slmskh,imsk,jmsk,wlon,rnlat, - & data,imax,jmax,rlngrb,rltgrb,lmask,rslmsk - &, gaus,blno, blto, kgds(1), kpds(4), lbms) -! write(6,*) ' kpds5=',kpds5,' lmask=',lmask -! - inttyp = 0 - if(kpds5.eq.225) inttyp = 1 - if(kpds5.eq.230) inttyp = 1 - if(kpds5.eq.236) inttyp = 1 - if(kpds5.eq.224) inttyp = 1 - if (me .eq. 0) then - if(inttyp.eq.1) print *, ' nearest grid point used' - &, ' kpds5=',kpds5, ' lmask = ',lmask - endif -! - call la2ga(data,imax,jmax,rlngrb,rltgrb,wlon,rnlat,inttyp, - & gdata,len,lmask,rslmsk,slmask - &, outlat, outlon,me) -! - deallocate (rlngrb, stat=iret) - deallocate (rltgrb, stat=iret) - deallocate (data, stat=iret) - deallocate (rslmsk, stat=iret) - call baclose(lugb,iret) -! - deallocate(data8) - deallocate(lbms) - return - end subroutine fixrdc - -!> Read in grib1 analysis data for the requested date and -!! horizontally interpolate to the model grid. If data not found -!! for the requested date, a backwards search is performed. -!! -!! @param[in] lugb Fortran unit number of the grib1 analysis data file. -!! @param[in] fngrib The name of the grib1 analysis data file. -!! @param[in] kpds5 The grib1 parameter number of the requested data. -!! @param[in] slmask Model land-sea-ice mask. -!! @param[in] iy Year. -!! @param[in] im Month. -!! @param[in] id Day. -!! @param[in] ih Hour. -!! @param[in] fh Forecast hour. -!! @param[out] gdata The analysis data interpolated to the model grid. -!! @param[in] len The number of model points to process. -!! @param[in] iret Return code. '0' is success. -!! @param[in] imsk 'i' dimension of the high-res mask used for input analysis -!! data without a bitmap. -!! @param[in] jmsk 'j' dimension of the high-res mask used for input analysis -!! data without a bitmap. -!! @param[in] slmskh The high-resolution mask used for input analysis -!! data witouth a bitmap. -!! @param[in] gaus When true, the high-res mask is on a gaussian grid. -!! @param[in] blno Corner point longitude of the high-res mask. -!! @param[in] blto Corner point latitude of the high-res mask. -!! @param[in] outlat Model latitudes. -!! @param[in] outlon Model longitudes. -!! @param[in] me MPI task number -!! @author Shrinivas Moorthi NOAA/EMC - subroutine fixrda(lugb,fngrib,kpds5,slmask, - & iy,im,id,ih,fh,gdata,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto - &, outlat, outlon, me) - use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : mdata - implicit none - integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, - & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, - & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, - & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint - real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, - & rjday,blto -! -! nrepmx: max number of days for going back date search -! nvalid: analysis later than (current date - nvalid) is regarded as -! valid for current analysis -! - parameter(nrepmx=15, nvalid=4) -! - character*500 fngrib -! character*80 fngrib, asgnstr -! - real (kind=kind_io8) slmskh(imsk,jmsk) -! - real (kind=kind_io8) gdata(len), slmask(len) - real (kind=kind_io8), allocatable :: data(:,:),rslmsk(:,:) - real (kind=kind_io8), allocatable :: data8(:) - real (kind=kind_io4), allocatable :: data4(:) - real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) -! - logical lmask, yr2kc, gaus, ijordr - logical*1 lbms(mdata) -! - integer kpds(1000),kgds(1000) - integer jpds(1000),jgds(1000), kpds0(1000) - real (kind=kind_io8) outlat(len), outlon(len) -! -! dayhf : julian day of the middle of each month -! - real (kind=kind_io8) dayhf(13) - data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0, - & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/ -! -! mjday : number of days in a month -! - integer mjday(12) - data mjday/31,28,31,30,31,30,31,31,30,31,30,31/ -! - real (kind=kind_io8) fha(5) - real(4) fha4(5) - integer ida(8),jda(8) -! - allocate(data8(1:mdata)) - iret = 0 - monend = 9999 -! -! compute jy,jm,jd,jh of forecast and the day of the year -! - iy4=iy - if(iy.lt.101) iy4=1900+iy4 - fha=0 - ida=0 - jda=0 - fha(2)=nint(fh) - ida(1)=iy - ida(2)=im - ida(3)=id - ida(5)=ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - fha4=fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif - jy=jda(1) - jm=jda(2) - jd=jda(3) - jh=jda(5) -! if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=', -! & jy,jm,jd,jh,rjday - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jda,jdow,jdoy,jday) - rjday=jdoy+jda(5)/24. - if(rjday.lt.dayhf(1)) rjday=rjday+365. - - if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=', - & jy,jm,jd,jh,rjday -! - if (me .eq. 0) then - write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh -! - write(6,*) ' ' - write(6,*) '************************************************' - endif -! - close(lugb) - call baopenr(lugb,fngrib,iret) - if (iret .ne. 0) then - write(6,*) ' FATAL ERROR: in opening file ',trim(fngrib) - print *,' FATAL ERROR: in opening file ',trim(fngrib) - call abort - endif - if (me .eq. 0) write(6,*) ' file ',trim(fngrib), - & ' opened. unit=',lugb -! - lugi = 0 -! - lskip=-1 - jpds=-1 - jgds=-1 - jpds(5)=kpds5 - kpds = jpds - call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, - & lskip,kpds,kgds,iret) - if (me .eq. 0) then - write(6,*) ' first grib record.' - write(6,*) ' kpds( 1-10)=',(kpds(j),j= 1,10) - write(6,*) ' kpds(11-20)=',(kpds(j),j=11,20) - write(6,*) ' kpds(21- )=',(kpds(j),j=21,22) - endif - yr2kc = (kpds(8) / 100) .gt. 0 - kpds0=jpds - kpds0(4)=-1 - kpds0(18)=-1 - if(iret.ne.0) then - write(6,*) ' FATAL ERROR: in getgbh. iret: ', iret - if(iret==99) write(6,*) ' field not found.' - call abort - endif -! -! handling analysis file -! -! find record for the given hour/day/month/year -! - nrept=0 - jpds=kpds0 - lskip = -1 - iyr=jy - if(iyr.le.100) iyr=2050-mod(2050-iyr,100) - imo=jm - idy=jd - ihr=jh -! year 2000 compatible data - if (yr2kc) then - jpds(8) = iyr - else - jpds(8) = mod(iyr,1900) - endif - 50 continue - jpds( 8)=mod(iyr-1,100)+1 - jpds( 9)=imo - jpds(10)=idy -! jpds(11)=ihr - jpds(21)=(iyr-1)/100+1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - elseif (w3kindreal == 4) then - allocate (data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8 = real(data4, kind=kind_io8) - deallocate(data4) - endif - if (me .eq. 0) write(6,*) ' input grib file dates=', - & (kpds(i),i=8,11) - if(jret.eq.0) then - if(ndata.eq.0) then - write(6,*) ' FATAL ERROR: in getgb.' - write(6,*) ' kpds=',kpds - write(6,*) ' kgds=',kgds - call abort - endif - imax=kgds(2) - jmax=kgds(3) - ijmax=imax*jmax - allocate (data(imax,jmax)) - do j=1,jmax - jj = (j-1)*imax - do i=1,imax - data(i,j) = data8(jj+i) - enddo - enddo - else - if(nrept.eq.0) then - if (me .eq. 0) then - write(6,*) ' no matching dates found. start searching', - & ' nearest matching dates (going back).' - endif - endif -! -! no matching ih found. search nearest hour -! - if(ihr.eq.6) then - ihr=0 - go to 50 - elseif(ihr.eq.12) then - ihr=0 - go to 50 - elseif(ihr.eq.18) then - ihr=12 - go to 50 - elseif(ihr.eq.0.or.ihr.eq.-1) then - idy=idy-1 - if(idy.eq.0) then - imo=imo-1 - if(imo.eq.0) then - iyr=iyr-1 - if(iyr.lt.0) iyr=99 - imo=12 - endif - idy=31 - if(imo.eq.4.or.imo.eq.6.or.imo.eq.9.or.imo.eq.11) idy=30 - if(imo.eq.2) then - if(mod(iyr,4).eq.0) then - idy=29 - else - idy=28 - endif - endif - endif - ihr=-1 - if (me .eq. 0) write(6,*) ' decremented dates=', - & iyr,imo,idy,ihr - nrept=nrept+1 - if(nrept.gt.nvalid) iret=-1 - if(nrept.gt.nrepmx) then - if (me .eq. 0) then - write(6,*) ' searching range exceeded.' - &, ' may be wrong grib file given' - write(6,*) ' fngrib=',trim(fngrib) - write(6,*) ' terminating search and', - & ' and setting gdata to -999' - write(6,*) ' range max=',nrepmx - endif -! imax=kgds(2) -! jmax=kgds(3) -! ijmax=imax*jmax -! do ij=1,ijmax -! data(ij)=0. -! enddo - go to 100 - endif - go to 50 - else - if (me .eq. 0) then - write(6,*) ' search of analysis for ihr=',ihr,' failed.' - write(6,*) ' kpds=',kpds - write(6,*) ' iyr,imo,idy,ihr=',iyr,imo,idy,ihr - endif - go to 100 - endif - endif -! - 80 continue -! if (me == 0) then -! write(6,*) ' maxmin of input as is' -! kmami=1 -! call maxmin(data(1,1),ijmax,kmami) -! endif -! - call getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me) - if (me == 0) then - write(6,*) 'imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat=' - write(6,*) imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat - endif - call subst(data,imax,jmax,dlon,dlat,ijordr) -! -! first get slmask over input grid -! - allocate (rlngrb(imax), rltgrb(jmax)) - allocate (rslmsk(imax,jmax)) - call setrmsk(kpds5,slmskh,imsk,jmsk,wlon,rnlat, - & data,imax,jmax,rlngrb,rltgrb,lmask,rslmsk -! & data,imax,jmax,abs(dlon),abs(dlat),lmask,rslmsk -!cggg &, gaus,blno, blto, kgds(1)) - &, gaus,blno, blto, kgds(1), kpds(4), lbms) - -! write(6,*) ' kpds5=',kpds5,' lmask=',lmask -! - inttyp = 0 - if(kpds5.eq.225) inttyp = 1 - if(kpds5.eq.230) inttyp = 1 - if(kpds5.eq.66) inttyp = 1 - if(inttyp.eq.1) print *, ' nearest grid point used' -! - call la2ga(data,imax,jmax,rlngrb,rltgrb,wlon,rnlat,inttyp, - & gdata,len,lmask,rslmsk,slmask - &, outlat, outlon, me) -! - deallocate (rlngrb, stat=iret) - deallocate (rltgrb, stat=iret) - deallocate (data, stat=iret) - deallocate (rslmsk, stat=iret) - call baclose(lugb,iret2) -! write(6,*) ' ' - deallocate(data8) - return -! - 100 continue - iret=1 - do i=1,len - gdata(i) = -999. - enddo -! - call baclose(lugb,iret2) -! - deallocate(data8) - return - end subroutine fixrda - -!> Ensure deep snow pack at permanent glacial points. -!! -!! @param[in] glacir Glacial flag -!! @param[in] snwmax Deep snow pack depth -!! @param[inout] snoanl Model snow -!! @param[in] len Number of model points to process. -!! @param[in] me MPI task number. -!! @author Shrinivas Moorthi NOAA/EMC - subroutine snodpth2(glacir,snwmax,snoanl, len, me) - use machine , only : kind_io8,kind_io4 - implicit none - integer i,me,len - real (kind=kind_io8) snwmax -! - real (kind=kind_io8) snoanl(len), glacir(len) -! - if (me .eq. 0) write(6,*) 'snodpth2' -! - do i=1,len -! -! if glacial points has snow in climatology, set sno to snomax -! - if(glacir(i).ne.0..and.snoanl(i).lt.snwmax*0.5) then - snoanl(i) = snwmax + snoanl(i) - endif -! - enddo - return - end From b5d097c6bb6876e601c2e9404c6c8b9e9a596881 Mon Sep 17 00:00:00 2001 From: David Huber <69919478+DavidHuber-NOAA@users.noreply.github.com> Date: Thu, 26 May 2022 11:17:15 -0400 Subject: [PATCH 035/109] Update support for S4 and enable regression testing (#654) Update build module to be 'lua' compliant. Update to the Intel 2022 version of the hpc-stack. Add regression test driver scripts. Fixes #653. --- modulefiles/build.s4.intel | 27 ---- modulefiles/build.s4.intel.lua | 59 ++++++++ reg_tests/chgres_cube/driver.s4.sh | 224 ++++++++++++++++++++++++++++ reg_tests/global_cycle/driver.s4.sh | 84 +++++++++++ reg_tests/grid_gen/driver.s4.sh | 109 ++++++++++++++ reg_tests/ice_blend/driver.s4.sh | 66 ++++++++ reg_tests/rt.sh | 2 +- reg_tests/snow2mdl/driver.s4.sh | 72 +++++++++ 8 files changed, 615 insertions(+), 28 deletions(-) delete mode 100644 modulefiles/build.s4.intel create mode 100644 modulefiles/build.s4.intel.lua create mode 100755 reg_tests/chgres_cube/driver.s4.sh create mode 100755 reg_tests/global_cycle/driver.s4.sh create mode 100755 reg_tests/grid_gen/driver.s4.sh create mode 100755 reg_tests/ice_blend/driver.s4.sh create mode 100755 reg_tests/snow2mdl/driver.s4.sh diff --git a/modulefiles/build.s4.intel b/modulefiles/build.s4.intel deleted file mode 100644 index 37cdf2a0c..000000000 --- a/modulefiles/build.s4.intel +++ /dev/null @@ -1,27 +0,0 @@ -#%Module##################################################### -## Build and run module for S4 -############################################################# - -module load license_intel/S4 -module use /data/prod/hpc-stack/modulefiles/stack -module load hpc/1.1.0 -module load hpc-intel/18.0.4 -module load hpc-impi/18.0.4 - -module load bacio/2.4.1 -module load g2/3.4.1 -module load ip/3.3.3 -module load nemsio/2.5.2 -module load sp/2.3.3 -module load w3nco/2.4.1 -module load sfcio/1.4.1 -module load sigio/2.3.2 - -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 nccmp/1.8.7.0 -module load esmf/8_1_0_beta_snapshot_27 diff --git a/modulefiles/build.s4.intel.lua b/modulefiles/build.s4.intel.lua new file mode 100644 index 000000000..c9418d420 --- /dev/null +++ b/modulefiles/build.s4.intel.lua @@ -0,0 +1,59 @@ +help([[ +Load environment to compile UFS_UTILS on S4 using Intel +]]) + +load(pathJoin("license_intel","S4")) +prepend_path("MODULEPATH", "/data/prod/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" +load(pathJoin("hpc-intel", hpc_intel_ver)) + +impi_ver=os.getenv("impi_ver") or "2022.1" +load(pathJoin("hpc-impi", impi_ver)) + +bacio_ver=os.getenv("bacio_ver") or "2.4.1" +load(pathJoin("bacio", bacio_ver)) + +g2_ver=os.getenv("g2_ver") or "3.4.5" +load(pathJoin("g2", g2_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.4" +load(pathJoin("nemsio", nemsio_ver)) + +sp_ver=os.getenv("sp_ver") or "2.3.3" +load(pathJoin("sp", sp_ver)) + +w3nco_ver=os.getenv("w3nco_ver") or "2.4.1" +load(pathJoin("w3nco", w3nco_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)) + +zlib_ver=os.getenv("zlib_ver") or "1.2.11" +load(pathJoin("zlib", zlib_ver)) + +png_ver=os.getenv("png_ver") or "1.6.35" +load(pathJoin("libpng", png_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)) + +nccmp_ver=os.getenv("nccmp_ver") or "1.8.9.0" +load(pathJoin("nccmp", nccmp_ver)) + +esmf_ver=os.getenv("esmf_ver") or "8.2.1b04" +load(pathJoin("esmf", esmf_ver)) + +whatis("Description: UFS_UTILS build environment") diff --git a/reg_tests/chgres_cube/driver.s4.sh b/reg_tests/chgres_cube/driver.s4.sh new file mode 100755 index 000000000..4e6e60119 --- /dev/null +++ b/reg_tests/chgres_cube/driver.s4.sh @@ -0,0 +1,224 @@ +#!/bin/bash + +#----------------------------------------------------------------------------- +# +# Run the chgres_cube consistency tests on S4. +# +# Set WORK_DIR to a general working location outside the UFS_UTILS directory. +# The exact working directory (OUTDIR) will be WORK_DIR/reg_tests/chgres-cube. +# Set the PROJECT_CODE and QUEUE as appropriate. To see which projects you +# are authorized to use, type +# "sacctmgr show assoc Users= format=account,user,qos" +# +# Invoke the script with no arguments. A series of daisy-chained +# jobs will be submitted. To check the queue, type: +# "squeue -u USERNAME". +# +# The run output will be stored in OUTDIR. Log output from the suite +# will be in LOG_FILE. Once the suite has completed, a summary is +# placed in SUM_FILE. +# +# A test fails when its output does not match the baseline files as +# determined by the "nccmp" utility. The baseline files are stored in +# HOMEreg. +# +#----------------------------------------------------------------------------- + +set -x + +compiler=${compiler:-"intel"} + +source ../../sorc/machine-setup.sh > /dev/null 2>&1 +module use ../../modulefiles +module load build.$target.$compiler +module list + +export OUTDIR="${WORK_DIR:-/scratch/short/users/$LOGNAME}" +export OUTDIR="${OUTDIR}/reg-tests/chgres-cube" + +PROJECT_CODE="${PROJECT_CODE:-star}" +QUEUE="${QUEUE:-s4}" + +#----------------------------------------------------------------------------- +# Should not have to change anything below here. HOMEufs is the root +# directory of your UFS_UTILS clone. HOMEreg contains the input data +# and baseline data for each test. +#----------------------------------------------------------------------------- + +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + +export HOMEufs=$PWD/../.. + +export HOMEreg=/data/users/dhuber/save/nems/role.ufsutils/ufs_utils/reg_tests/chgres_cube + +LOG_FILE=consistency.log +SUM_FILE=summary.log +rm -f $LOG_FILE* $SUM_FILE + +export OMP_STACKSIZE=1024M + +export APRUN=srun +export NCCMP=${NCCMP:-nccmp} +rm -fr $OUTDIR + +#----------------------------------------------------------------------------- +# Initialize C96 using FV3 warm restart files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log01 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST1=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.restart \ + -o $LOG_FILE -e $LOG_FILE ./c96.fv3.restart.sh) + +#----------------------------------------------------------------------------- +# Initialize C192 using FV3 tiled history files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log02 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST2=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c192.fv3.history \ + -o $LOG_FILE -e $LOG_FILE ./c192.fv3.history.sh) + +#----------------------------------------------------------------------------- +# Initialize C96 using FV3 gaussian nemsio files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log03 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST3=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.nemsio \ + -o $LOG_FILE -e $LOG_FILE ./c96.fv3.nemsio.sh) + +#----------------------------------------------------------------------------- +# Initialize C96 using spectral GFS sigio/sfcio files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log04 +export OMP_NUM_THREADS=6 # should match cpus-per-task +TEST4=$(sbatch --parsable --ntasks-per-node=3 --cpus-per-task=6 --nodes=2 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.gfs.sigio \ + -o $LOG_FILE -e $LOG_FILE ./c96.gfs.sigio.sh) + +#----------------------------------------------------------------------------- +# Initialize C96 using spectral GFS gaussian nemsio files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log05 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST5=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.gfs.nemsio \ + -o $LOG_FILE -e $LOG_FILE ./c96.gfs.nemsio.sh) + +#----------------------------------------------------------------------------- +# Initialize regional C96 using FV3 gaussian nemsio files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log06 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST6=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.regional \ + -o $LOG_FILE -e $LOG_FILE ./c96.regional.sh) + +#----------------------------------------------------------------------------- +# Initialize C96 using FV3 gaussian netcdf files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log07 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST7=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.netcdf \ + -o $LOG_FILE -e $LOG_FILE ./c96.fv3.netcdf.sh) + +#----------------------------------------------------------------------------- +# Initialize global C192 using GFS GRIB2 files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log08 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST8=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J c192.gfs.grib2 \ + -o $LOG_FILE -e $LOG_FILE ./c192.gfs.grib2.sh) + +#----------------------------------------------------------------------------- +# Initialize CONUS 25-KM USING GFS GRIB2 files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log09 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST9=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J 25km.conus.gfs.grib2.conus \ + -o $LOG_FILE -e $LOG_FILE ./25km.conus.gfs.grib2.sh) + +#----------------------------------------------------------------------------- +# Initialize CONUS 3-KM USING HRRR GRIB2 file WITH GFS PHYSICS. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log10 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST10=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 3km.conus.hrrr.gfssdf.grib2.conus \ + -o $LOG_FILE -e $LOG_FILE ./3km.conus.hrrr.gfssdf.grib2.sh) + +#----------------------------------------------------------------------------- +# Initialize CONUS 3-KM USING HRRR GRIB2 file WITH GSD PHYSICS AND SFC VARS FROM FILE. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log11 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST11=$(sbatch --parsable --ntasks-per-node=6 --nodes=2 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J 3km.conus.hrrr.newsfc.grib2.conus \ + -o $LOG_FILE -e $LOG_FILE ./3km.conus.hrrr.newsfc.grib2.sh) + +#----------------------------------------------------------------------------- +# Initialize CONUS 13-KM USING NAM GRIB2 file WITH GFS PHYSICS . +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log12 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST12=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J 13km.conus.nam.grib2.conus \ + -o $LOG_FILE -e $LOG_FILE ./13km.conus.nam.grib2.sh) + +#----------------------------------------------------------------------------- +# Initialize CONUS 13-KM USING RAP GRIB2 file WITH GSD PHYSICS . +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log13 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST13=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J 13km.conus.rap.grib2.conus \ + -o $LOG_FILE -e $LOG_FILE ./13km.conus.rap.grib2.sh) + +#----------------------------------------------------------------------------- +# Initialize CONUS 13-KM NA USING NCEI GFS GRIB2 file WITH GFS PHYSICS . +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log14 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST14=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J 13km.na.gfs.ncei.grib2.conus \ + -o $LOG_FILE -e $LOG_FILE ./13km.na.gfs.ncei.grib2.sh) + +#----------------------------------------------------------------------------- +# Initialize C96 WAM IC using FV3 gaussian netcdf files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log15 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST15=$(sbatch --parsable --ntasks-per-node=12 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.fv3.netcdf2wam \ + -o $LOG_FILE -e $LOG_FILE ./c96.fv3.netcdf2wam.sh) + +#----------------------------------------------------------------------------- +# Initialize CONUS 25-KM USING GFS PGRIB2+BGRIB2 files. +#----------------------------------------------------------------------------- + +LOG_FILE=consistency.log16 +export OMP_NUM_THREADS=1 # should match cpus-per-task +TEST16=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J 25km.conus.gfs.pbgrib2.conus \ + -o $LOG_FILE -e $LOG_FILE ./25km.conus.gfs.pbgrib2.sh) + +#----------------------------------------------------------------------------- +# Create summary log. +#----------------------------------------------------------------------------- +LOG_FILE=consistency.log +sbatch --nodes=1 -t 0:01:00 -A $PROJECT_CODE -J chgres_summary -o $LOG_FILE -e $LOG_FILE \ + --open-mode=append -q $QUEUE -d\ + afterok:$TEST1:$TEST2:$TEST3:$TEST4:$TEST5:$TEST6:$TEST7:$TEST8:$TEST9:$TEST10:$TEST11:$TEST12:$TEST13:$TEST14:$TEST15:$TEST16 << EOF +#!/bin/bash +grep -a '<<<' $LOG_FILE* > $SUM_FILE +EOF + +exit 0 diff --git a/reg_tests/global_cycle/driver.s4.sh b/reg_tests/global_cycle/driver.s4.sh new file mode 100755 index 000000000..439925c7e --- /dev/null +++ b/reg_tests/global_cycle/driver.s4.sh @@ -0,0 +1,84 @@ +#!/bin/bash + +#----------------------------------------------------------------------------- +# +# Run global_cycle consistency test on S4. +# +# Set $WORK_DIR to your working directory. Set the project code +# and queue as appropriate. +# +# Invoke the script from the command line as follows: ./$script +# +# Log output is placed in consistency.log??. A summary is +# placed in summary.log +# +# A test fails when its output does not match the baseline files +# as determined by the 'nccmp' utility. This baseline files are +# stored in HOMEreg. +# +#----------------------------------------------------------------------------- + +set -x + +compiler=${compiler:-"intel"} + +source ../../sorc/machine-setup.sh > /dev/null 2>&1 +module use ../../modulefiles +module load build.$target.$compiler +module list + +WORK_DIR="${WORK_DIR:-/scratch/short/users/$LOGNAME}" + +PROJECT_CODE="${PROJECT_CODE:-star}" +QUEUE="${QUEUE:-batch}" + +#----------------------------------------------------------------------------- +# Should not have to change anything below. +#----------------------------------------------------------------------------- + +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + +DATA_DIR="${WORK_DIR}/reg-tests/global-cycle" + +export HOMEreg=/data/users/dhuber/save/nems/role.ufsutils/ufs_utils/reg_tests/global_cycle + +export OMP_NUM_THREADS_CY=2 + +export APRUNCY="srun" + +export NWPROD=$PWD/../.. + +reg_dir=$PWD + +LOG_FILE=consistency.log01 +export DATA="${DATA_DIR}/test1" +export COMOUT=$DATA +TEST1=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J c768.fv3gfs \ + -o $LOG_FILE -e $LOG_FILE ./C768.fv3gfs.sh) + +LOG_FILE=consistency.log02 +export DATA="${DATA_DIR}/test2" +export COMOUT=$DATA +TEST2=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J c768.lndincsoil \ + -o $LOG_FILE -e $LOG_FILE ./C768.lndincsoil.sh) + +LOG_FILE=consistency.log03 +export DATA="${DATA_DIR}/test3" +export COMOUT=$DATA +TEST3=$(sbatch --parsable --ntasks-per-node=6 --nodes=1 -t 0:05:00 -A $PROJECT_CODE -q $QUEUE -J c768.lndincsnow \ + -o $LOG_FILE -e $LOG_FILE ./C768.lndincsnow.sh) + +LOG_FILE=consistency.log +sbatch --nodes=1 -t 0:01:00 -A $PROJECT_CODE -J summary -o $LOG_FILE -e $LOG_FILE \ + --open-mode=append -q $QUEUE -d\ + afterok:$TEST1:$TEST2:$TEST3 << EOF +#!/bin/bash +grep -a '<<<' ${LOG_FILE}* > summary.log +EOF + +exit diff --git a/reg_tests/grid_gen/driver.s4.sh b/reg_tests/grid_gen/driver.s4.sh new file mode 100755 index 000000000..190c22c9c --- /dev/null +++ b/reg_tests/grid_gen/driver.s4.sh @@ -0,0 +1,109 @@ +#!/bin/bash + +#----------------------------------------------------------------------------- +# +# Run grid generation consistency tests on S4. +# +# Set WORK_DIR to your working directory. Set the PROJECT_CODE and QUEUE +# as appropriate. To see which projects you are authorized to use, +# type +# "sacctmgr show assoc Users= format=account,user,qos" +# +# Invoke the script with no arguments. A series of daily- +# chained jobs will be submitted. To check the queue, type: +# "squeue -u USERNAME". +# +# Log output from the suite will be in LOG_FILE. Once the suite +# has completed, a summary is placed in SUM_FILE. +# +# A test fails when its output does not match the baseline files as +# determined by the "nccmp" utility. The baseline files are stored in +# HOMEreg +# +#----------------------------------------------------------------------------- + +compiler=${compiler:-"intel"} + +source ../../sorc/machine-setup.sh > /dev/null 2>&1 +module use ../../modulefiles +module load build.$target.$compiler +module list + +set -x + +export WORK_DIR="${WORK_DIR:-/scratch/short/users/$LOGNAME}" +export WORK_DIR="${WORK_DIR}/reg-tests/grid-gen" +QUEUE="${QUEUE:-s4}" +PROJECT_CODE="${PROJECT_CODE:-star}" + +#----------------------------------------------------------------------------- +# Should not have to change anything below here. +#----------------------------------------------------------------------------- + +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + +LOG_FILE=consistency.log +SUM_FILE=summary.log +export home_dir=$PWD/../.. +export APRUN=time +export APRUN_SFC=srun +export OMP_STACKSIZE=2048m +export machine=S4 +export HOMEreg=/data/users/dhuber/save/nems/role.ufsutils/ufs_utils/reg_tests/grid_gen/baseline_data + +ulimit -a +#ulimit -s unlimited + +rm -fr $WORK_DIR + +export OMP_NUM_THREADS=24 + +#----------------------------------------------------------------------------- +# C96 uniform grid +#----------------------------------------------------------------------------- + +TEST1=$(sbatch --parsable --ntasks-per-node=24 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.uniform \ + -o $LOG_FILE -e $LOG_FILE ./c96.uniform.sh) + +#----------------------------------------------------------------------------- +# C96 uniform grid using viirs vegetation data. +#----------------------------------------------------------------------------- + +TEST2=$(sbatch --parsable --ntasks-per-node=24 --nodes=1 -t 0:15:00 -A $PROJECT_CODE -q $QUEUE -J c96.viirs.vegt \ + -o $LOG_FILE -e $LOG_FILE -d afterok:$TEST1 ./c96.viirs.vegt.sh) + +#----------------------------------------------------------------------------- +# gfdl regional grid +#----------------------------------------------------------------------------- + +TEST3=$(sbatch --parsable --ntasks-per-node=24 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J gfdl.regional \ + -o $LOG_FILE -e $LOG_FILE -d afterok:$TEST2 ./gfdl.regional.sh) + +#----------------------------------------------------------------------------- +# esg regional grid +#----------------------------------------------------------------------------- + +TEST4=$(sbatch --parsable --ntasks-per-node=24 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J esg.regional \ + -o $LOG_FILE -e $LOG_FILE -d afterok:$TEST3 ./esg.regional.sh) + +#----------------------------------------------------------------------------- +# Regional GSL gravity wave drag test. +#----------------------------------------------------------------------------- + +TEST5=$(sbatch --parsable --ntasks-per-node=24 --nodes=1 -t 0:10:00 -A $PROJECT_CODE -q $QUEUE -J reg.gsl.gwd \ + -o $LOG_FILE -e $LOG_FILE -d afterok:$TEST4 ./regional.gsl.gwd.sh) + +#----------------------------------------------------------------------------- +# Create summary log. +#----------------------------------------------------------------------------- + +sbatch --nodes=1 -t 0:01:00 -A $PROJECT_CODE -J grid_summary -o $LOG_FILE -e $LOG_FILE \ + --open-mode=append -q $QUEUE -d afterok:$TEST5 << EOF +#!/bin/bash +grep -a '<<<' $LOG_FILE > $SUM_FILE +EOF diff --git a/reg_tests/ice_blend/driver.s4.sh b/reg_tests/ice_blend/driver.s4.sh new file mode 100755 index 000000000..7aee14a02 --- /dev/null +++ b/reg_tests/ice_blend/driver.s4.sh @@ -0,0 +1,66 @@ +#!/bin/bash + +#----------------------------------------------------------------------------- +# +# Run ice_blend consistency test on S4. +# +# Set $DATA to your working directory. Set the project code (SBATCH -A) +# and queue (SBATCH -q) as appropriate. +# +# Invoke the script as follows: sbatch $script +# +# Log output is placed in consistency.log. A summary is +# placed in summary.log +# +# The test fails when its output does not match the baseline file +# as determined by the 'cmp' command. The baseline file is +# stored in HOMEreg. +# +#----------------------------------------------------------------------------- + +#SBATCH -J ice_blend +#SBATCH -A s4 +#SBATCH --open-mode=truncate +#SBATCH -o consistency.log +#SBATCH -e consistency.log +#SBATCH --ntasks=1 +#SBATCH -q s4 +#SBATCH -t 00:03:00 + +set -x + +compiler=${compiler:-"intel"} + +source ../../sorc/machine-setup.sh > /dev/null 2>&1 +module use ../../modulefiles +module load build.$target.$compiler +module list + +export DATA="${WORK_DIR:-/scratch/short/users/$LOGNAME}" +export DATA="${DATA}/reg-tests/ice-blend" + +#----------------------------------------------------------------------------- +# Should not have to change anything below. +#----------------------------------------------------------------------------- + +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + +export WGRIB=/data/prod/hpc-stack/intel-2022.1/grib_util/1.2.2/bin/wgrib +export WGRIB2=/data/prod/hpc-stack/intel-2022.1/wgrib2/2.0.8/bin/wgrib2 +export COPYGB=/data/prod/hpc-stack/intel-2022.1/grib_util/1.2.2/bin/copygb +export COPYGB2=/data/prod/hpc-stack/intel-2022.1/grib_util/1.2.2/bin/copygb2 +export CNVGRIB=/data/prod/hpc-stack/intel-2022.1/grib_util/1.2.2/bin/cnvgrib + +export HOMEreg=/data/users/dhuber/save/nems/role.ufsutils/ufs_utils/reg_tests/ice_blend +export HOMEgfs=$PWD/../.. + +rm -fr $DATA + +./ice_blend.sh + +exit 0 diff --git a/reg_tests/rt.sh b/reg_tests/rt.sh index bf196f576..b16d98c07 100755 --- a/reg_tests/rt.sh +++ b/reg_tests/rt.sh @@ -91,7 +91,7 @@ fi for dir in ice_blend; do cd $dir - if [[ $target == "hera" ]] || [[ $target == "jet" ]] || [[ $target == "orion" ]]; then + if [[ $target == "hera" ]] || [[ $target == "jet" ]] || [[ $target == "orion" ]] || [[ $target == "s4" ]] ; then sbatch -A ${PROJECT_CODE} ./driver.$target.sh elif [[ $target == "wcoss_dell_p3" ]] || [[ $target == "wcoss_cray" ]]; then cat ./driver.$target.sh | bsub -P ${PROJECT_CODE} diff --git a/reg_tests/snow2mdl/driver.s4.sh b/reg_tests/snow2mdl/driver.s4.sh new file mode 100755 index 000000000..608a19584 --- /dev/null +++ b/reg_tests/snow2mdl/driver.s4.sh @@ -0,0 +1,72 @@ +#!/bin/bash + +#----------------------------------------------------------------------------- +# +# Run snow2mdl consistency test on S4. +# +# Set $DATA_ROOT to your working directory. Set the project code +# and queue as appropriate. +# +# Invoke the script as follows: ./$script +# +# Log output is placed in consistency.log. A summary is +# placed in summary.log +# +# The test fails when its output does not match the baseline file +# as determined by the 'cmp' command. The baseline file is +# stored in HOMEreg. +# +#----------------------------------------------------------------------------- + +set -x + +compiler=${compiler:-"intel"} + +source ../../sorc/machine-setup.sh > /dev/null 2>&1 +module use ../../modulefiles +module load build.$target.$compiler +module list + +DATA_ROOT="${WORK_DIR:-/scratch/short/users/$LOGNAME}" +DATA_ROOT="${DATA_ROOT}/reg-tests/snow2mdl" + +PROJECT_CODE="${PROJECT_CODE:-star}" +QUEUE="${QUEUE:-s4}" + +#----------------------------------------------------------------------------- +# Should not have to change anything below. +#----------------------------------------------------------------------------- + +export UPDATE_BASELINE="FALSE" +#export UPDATE_BASELINE="TRUE" + +if [ "$UPDATE_BASELINE" = "TRUE" ]; then + source ../get_hash.sh +fi + +export HOMEreg=/data/users/dhuber/save/nems/role.ufsutils/ufs_utils/reg_tests/snow2mdl +export HOMEgfs=$PWD/../.. +export WGRIB=/data/prod/hpc-stack/intel-2022.1/grib_util/1.2.2/bin/wgrib +export WGRIB2=/data/prod/hpc-stack/intel-2022.1/wgrib2/2.0.8/bin/wgrib2 + +# The first test mimics GFS OPS. + +export DATA="${DATA_ROOT}/test.ops" +TEST1=$(sbatch --parsable -J snow.ops -A ${PROJECT_CODE} -o consistency.log -e consistency.log \ + --ntasks=1 -q ${QUEUE} -t 00:03:00 ./snow2mdl.ops.sh) + +# The second test is for the new AFWA global GRIB2 data. + +export DATA="${DATA_ROOT}/test.global" +TEST2=$(sbatch --parsable -J snow.global -A ${PROJECT_CODE} -o consistency.log -e consistency.log \ + --ntasks=1 -q ${QUEUE} -t 00:03:00 -d afterok:$TEST1 ./snow2mdl.global.sh) + +# Create summary file. + +sbatch --nodes=1 -t 0:01:00 -A ${PROJECT_CODE} -J snow_summary -o consistency.log -e consistency.log \ + --open-mode=append -q ${QUEUE} -d afterok:$TEST2 << EOF +#!/bin/bash +grep -a '<<<' consistency.log > summary.log +EOF + +exit 0 From 4e9ca5e9621d1e05e5105c11937d8bd96751e492 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 31 May 2022 13:59:28 -0400 Subject: [PATCH 036/109] New coupled model utility (#647) Adds a new utility - cpld_gridgen - which creates several files for the coupled model. Fixes #143 --- README.md | 2 + build_all.sh | 2 +- docs/user_guide.md | 2 + modulefiles/build.hera.gnu.lua | 2 +- modulefiles/build.hera.intel.lua | 3 + modulefiles/build.jet.intel.lua | 3 + modulefiles/build.orion.intel.lua | 3 + .../RegressionTests_hera.intel.log | 76 + .../RegressionTests_jet.intel.log | 76 + .../RegressionTests_orion.intel.log | 76 + reg_tests/cpld_gridgen/parm/grid.nml.IN | 15 + reg_tests/cpld_gridgen/rt.conf | 6 + reg_tests/cpld_gridgen/rt.sh | 272 ++ reg_tests/rt.sh | 28 +- sorc/CMakeLists.txt | 1 + sorc/cpld_gridgen.fd/CMakeLists.txt | 62 + sorc/cpld_gridgen.fd/angles.F90 | 204 ++ sorc/cpld_gridgen.fd/charstrings.F90 | 34 + sorc/cpld_gridgen.fd/cicegrid.F90 | 97 + sorc/cpld_gridgen.fd/debugprint.F90 | 247 ++ sorc/cpld_gridgen.fd/docs/CMakeLists.txt | 16 + sorc/cpld_gridgen.fd/docs/Doxyfile.in | 2573 +++++++++++++++++ sorc/cpld_gridgen.fd/docs/user_guide.md | 173 ++ sorc/cpld_gridgen.fd/gen_fixgrid.F90 | 554 ++++ sorc/cpld_gridgen.fd/gengrid_kinds.F90 | 22 + sorc/cpld_gridgen.fd/grdvars.F90 | 207 ++ sorc/cpld_gridgen.fd/inputnml.F90 | 57 + sorc/cpld_gridgen.fd/mapped_mask.F90 | 157 + sorc/cpld_gridgen.fd/postwgts.F90 | 116 + sorc/cpld_gridgen.fd/scripgrid.F90 | 183 ++ sorc/cpld_gridgen.fd/topoedits.F90 | 227 ++ sorc/cpld_gridgen.fd/tripolegrid.F90 | 162 ++ sorc/cpld_gridgen.fd/vartypedefs.F90 | 208 ++ sorc/cpld_gridgen.fd/vertices.F90 | 150 + tests/CMakeLists.txt | 1 + tests/cpld_gridgen/CMakeLists.txt | 27 + tests/cpld_gridgen/LSanSuppress.supp | 2 + tests/cpld_gridgen/ftst_find_angq.F90 | 108 + ush/cpld_gridgen.sh | 109 + 39 files changed, 6259 insertions(+), 4 deletions(-) create mode 100644 reg_tests/cpld_gridgen/RegressionTests_hera.intel.log create mode 100644 reg_tests/cpld_gridgen/RegressionTests_jet.intel.log create mode 100644 reg_tests/cpld_gridgen/RegressionTests_orion.intel.log create mode 100644 reg_tests/cpld_gridgen/parm/grid.nml.IN create mode 100644 reg_tests/cpld_gridgen/rt.conf create mode 100755 reg_tests/cpld_gridgen/rt.sh create mode 100644 sorc/cpld_gridgen.fd/CMakeLists.txt create mode 100644 sorc/cpld_gridgen.fd/angles.F90 create mode 100644 sorc/cpld_gridgen.fd/charstrings.F90 create mode 100644 sorc/cpld_gridgen.fd/cicegrid.F90 create mode 100644 sorc/cpld_gridgen.fd/debugprint.F90 create mode 100644 sorc/cpld_gridgen.fd/docs/CMakeLists.txt create mode 100644 sorc/cpld_gridgen.fd/docs/Doxyfile.in create mode 100644 sorc/cpld_gridgen.fd/docs/user_guide.md create mode 100644 sorc/cpld_gridgen.fd/gen_fixgrid.F90 create mode 100644 sorc/cpld_gridgen.fd/gengrid_kinds.F90 create mode 100644 sorc/cpld_gridgen.fd/grdvars.F90 create mode 100644 sorc/cpld_gridgen.fd/inputnml.F90 create mode 100644 sorc/cpld_gridgen.fd/mapped_mask.F90 create mode 100644 sorc/cpld_gridgen.fd/postwgts.F90 create mode 100644 sorc/cpld_gridgen.fd/scripgrid.F90 create mode 100644 sorc/cpld_gridgen.fd/topoedits.F90 create mode 100644 sorc/cpld_gridgen.fd/tripolegrid.F90 create mode 100644 sorc/cpld_gridgen.fd/vartypedefs.F90 create mode 100644 sorc/cpld_gridgen.fd/vertices.F90 create mode 100644 tests/cpld_gridgen/CMakeLists.txt create mode 100644 tests/cpld_gridgen/LSanSuppress.supp create mode 100644 tests/cpld_gridgen/ftst_find_angq.F90 create mode 100755 ush/cpld_gridgen.sh diff --git a/README.md b/README.md index ec3d9deb5..f1fa48fd4 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,7 @@ https://ufs-community.github.io/UFS_UTILS/. Utility | Programmer(s) --------|---------- chgres_cube | George Gayno, Jeff Beck, Larissa Reames +cpld_gridgen | Denise Worthen, Minsuk Ji emcsfc_ice_blend | George Gayno emcsfc_snow2mdl | George Gayno fre-nctools | GFDL progammer @@ -70,6 +71,7 @@ make install The UFS_UTILS package contains the following utilities (under the sorc directory): - chgres_cube +- cpld_gridgen - emcsfc_ice_blend - emcsfc_snow2mdl - fre-nctools diff --git a/build_all.sh b/build_all.sh index 0a8de2d7c..6b5dad10d 100755 --- a/build_all.sh +++ b/build_all.sh @@ -15,7 +15,7 @@ export MOD_PATH if [[ "$target" == "linux.*" || "$target" == "macosx.*" ]]; then unset -f module set +x - source ./modulefiles/build.$target > /dev/null + source ./modulefiles/build.$target > /dev/null set -x else set +x diff --git a/docs/user_guide.md b/docs/user_guide.md index 624c2f66d..7e91938fe 100644 --- a/docs/user_guide.md +++ b/docs/user_guide.md @@ -71,4 +71,6 @@ https://github.com/ufs-community/UFS_UTILS. Currently, contains the routines required by global_cycle to perform data assimilation updates to land model states +- cpld_gridgen - Utility to + create the Fix and IC files for the S2SW and S2S applications diff --git a/modulefiles/build.hera.gnu.lua b/modulefiles/build.hera.gnu.lua index 6b57b13c3..331aefe85 100644 --- a/modulefiles/build.hera.gnu.lua +++ b/modulefiles/build.hera.gnu.lua @@ -22,7 +22,7 @@ load(pathJoin("hpc-mpich", mpich_ver)) netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" load(pathJoin("netcdf", netcdf_ver)) -esmf_ver=os.getenv("esmf_ver") or "8_1_1" +esmf_ver=os.getenv("esmf_ver") or "8.2.1b04" load(pathJoin("esmf", esmf_ver)) bacio_ver=os.getenv("bacio_ver") or "2.4.1" diff --git a/modulefiles/build.hera.intel.lua b/modulefiles/build.hera.intel.lua index e75162486..d82571889 100644 --- a/modulefiles/build.hera.intel.lua +++ b/modulefiles/build.hera.intel.lua @@ -61,4 +61,7 @@ load(pathJoin("nccmp", nccmp_ver)) esmf_ver=os.getenv("esmf_ver") or "8.2.1b04" load(pathJoin("esmf", esmf_ver)) +nco_ver=os.getenv("nco_ver") or "4.9.1" +load(pathJoin("nco", nco_ver)) + whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.jet.intel.lua b/modulefiles/build.jet.intel.lua index c6652460e..fbf9d8024 100644 --- a/modulefiles/build.jet.intel.lua +++ b/modulefiles/build.jet.intel.lua @@ -58,4 +58,7 @@ load(pathJoin("g2", g2_ver)) prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("prod_util", prod_util_ver)) +nco_ver=os.getenv("nco_ver") or "4.9.3" +load(pathJoin("nco", nco_ver)) + whatis("Description: UFS_UTILS build environment") diff --git a/modulefiles/build.orion.intel.lua b/modulefiles/build.orion.intel.lua index ec13ac657..80e5986d1 100644 --- a/modulefiles/build.orion.intel.lua +++ b/modulefiles/build.orion.intel.lua @@ -58,4 +58,7 @@ load(pathJoin("nccmp", nccmp_ver)) esmf_ver=os.getenv("esmf_ver") or "8.2.0" load(pathJoin("esmf", esmf_ver)) +nco_ver=os.getenv("nco_ver") or "4.9.3" +load(pathJoin("nco", nco_ver)) + whatis("Description: UFS_UTILS build environment") diff --git a/reg_tests/cpld_gridgen/RegressionTests_hera.intel.log b/reg_tests/cpld_gridgen/RegressionTests_hera.intel.log new file mode 100644 index 000000000..6e9632d61 --- /dev/null +++ b/reg_tests/cpld_gridgen/RegressionTests_hera.intel.log @@ -0,0 +1,76 @@ +Sat Apr 23 17:52:41 UTC 2022 +Start Regression test + +Working dir = /scratch1/NCEPDEV/stmp4/Minsuk.Ji/CPLD_GRIDGEN/rt_142841/025 +Baseline dir = /scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data/025 + +Checking test 025 results .... +Comparing Bu.mx025_SCRIP.nc........OK +Comparing C384.mx025.tile1.nc........OK +Comparing C384.mx025.tile2.nc........OK +Comparing C384.mx025.tile3.nc........OK +Comparing C384.mx025.tile4.nc........OK +Comparing C384.mx025.tile5.nc........OK +Comparing C384.mx025.tile6.nc........OK +Comparing Ct.mx025_SCRIP_land.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx025.to.C384.nc........OK +Comparing Cu.mx025_SCRIP.nc........OK +Comparing Cv.mx025_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx025.nc........OK +Comparing kmtu_cice_NEMS_mx025.nc........OK +Comparing mesh.mx025.nc........OK +Comparing tripole.mx025.nc........OK + + +Working dir = /scratch1/NCEPDEV/stmp4/Minsuk.Ji/CPLD_GRIDGEN/rt_142841/050 +Baseline dir = /scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data/050 + +Checking test 050 results .... +Comparing Bu.mx050_SCRIP.nc........OK +Comparing C192.mx050.tile1.nc........OK +Comparing C192.mx050.tile2.nc........OK +Comparing C192.mx050.tile3.nc........OK +Comparing C192.mx050.tile4.nc........OK +Comparing C192.mx050.tile5.nc........OK +Comparing C192.mx050.tile6.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx050_SCRIP_land.nc........OK +Comparing Ct.mx050_SCRIP.nc........OK +Comparing Ct.mx050.to.C192.nc........OK +Comparing Cu.mx050_SCRIP.nc........OK +Comparing Cv.mx050_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx050.nc........OK +Comparing kmtu_cice_NEMS_mx050.nc........OK +Comparing mesh.mx050.nc........OK +Comparing tripole.mx025.Ct.to.mx050.Ct.neareststod.nc........OK +Comparing tripole.mx050.nc........OK + + +Working dir = /scratch1/NCEPDEV/stmp4/Minsuk.Ji/CPLD_GRIDGEN/rt_142841/100 +Baseline dir = /scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data/100 + +Checking test 100 results .... +Comparing Bu.mx100_SCRIP.nc........OK +Comparing C96.mx100.tile1.nc........OK +Comparing C96.mx100.tile2.nc........OK +Comparing C96.mx100.tile3.nc........OK +Comparing C96.mx100.tile4.nc........OK +Comparing C96.mx100.tile5.nc........OK +Comparing C96.mx100.tile6.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx100_SCRIP_land.nc........OK +Comparing Ct.mx100_SCRIP.nc........OK +Comparing Ct.mx100.to.C96.nc........OK +Comparing Cu.mx100_SCRIP.nc........OK +Comparing Cv.mx100_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx100.nc........OK +Comparing kmtu_cice_NEMS_mx100.nc........OK +Comparing mesh.mx100.nc........OK +Comparing tripole.mx025.Ct.to.mx100.Ct.neareststod.nc........OK +Comparing tripole.mx100.nc........OK +Comparing ufs.topo_edits_011818.nc........OK + + +REGRESSION TEST WAS SUCCESSFUL +Sat Apr 23 17:57:15 UTC 2022 diff --git a/reg_tests/cpld_gridgen/RegressionTests_jet.intel.log b/reg_tests/cpld_gridgen/RegressionTests_jet.intel.log new file mode 100644 index 000000000..88b074661 --- /dev/null +++ b/reg_tests/cpld_gridgen/RegressionTests_jet.intel.log @@ -0,0 +1,76 @@ +Mon Apr 25 14:59:30 GMT 2022 +Start Regression test + +Working dir = /lfs4/HFIP/h-nems//Minsuk.Ji/CPLD_GRIDGEN/rt_25376/025 +Baseline dir = /lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data/025 + +Checking test 025 results .... +Comparing Bu.mx025_SCRIP.nc........OK +Comparing C384.mx025.tile1.nc........OK +Comparing C384.mx025.tile2.nc........OK +Comparing C384.mx025.tile3.nc........OK +Comparing C384.mx025.tile4.nc........OK +Comparing C384.mx025.tile5.nc........OK +Comparing C384.mx025.tile6.nc........OK +Comparing Ct.mx025.to.C384.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx025_SCRIP_land.nc........OK +Comparing Cu.mx025_SCRIP.nc........OK +Comparing Cv.mx025_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx025.nc........OK +Comparing kmtu_cice_NEMS_mx025.nc........OK +Comparing mesh.mx025.nc........OK +Comparing tripole.mx025.nc........OK + + +Working dir = /lfs4/HFIP/h-nems//Minsuk.Ji/CPLD_GRIDGEN/rt_25376/050 +Baseline dir = /lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data/050 + +Checking test 050 results .... +Comparing Bu.mx050_SCRIP.nc........OK +Comparing C192.mx050.tile1.nc........OK +Comparing C192.mx050.tile2.nc........OK +Comparing C192.mx050.tile3.nc........OK +Comparing C192.mx050.tile4.nc........OK +Comparing C192.mx050.tile5.nc........OK +Comparing C192.mx050.tile6.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx050.to.C192.nc........OK +Comparing Ct.mx050_SCRIP.nc........OK +Comparing Ct.mx050_SCRIP_land.nc........OK +Comparing Cu.mx050_SCRIP.nc........OK +Comparing Cv.mx050_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx050.nc........OK +Comparing kmtu_cice_NEMS_mx050.nc........OK +Comparing mesh.mx050.nc........OK +Comparing tripole.mx025.Ct.to.mx050.Ct.neareststod.nc........OK +Comparing tripole.mx050.nc........OK + + +Working dir = /lfs4/HFIP/h-nems//Minsuk.Ji/CPLD_GRIDGEN/rt_25376/100 +Baseline dir = /lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data/100 + +Checking test 100 results .... +Comparing Bu.mx100_SCRIP.nc........OK +Comparing C96.mx100.tile1.nc........OK +Comparing C96.mx100.tile2.nc........OK +Comparing C96.mx100.tile3.nc........OK +Comparing C96.mx100.tile4.nc........OK +Comparing C96.mx100.tile5.nc........OK +Comparing C96.mx100.tile6.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx100.to.C96.nc........OK +Comparing Ct.mx100_SCRIP.nc........OK +Comparing Ct.mx100_SCRIP_land.nc........OK +Comparing Cu.mx100_SCRIP.nc........OK +Comparing Cv.mx100_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx100.nc........OK +Comparing kmtu_cice_NEMS_mx100.nc........OK +Comparing mesh.mx100.nc........OK +Comparing tripole.mx025.Ct.to.mx100.Ct.neareststod.nc........OK +Comparing tripole.mx100.nc........OK +Comparing ufs.topo_edits_011818.nc........OK + + +REGRESSION TEST WAS SUCCESSFUL +Mon Apr 25 15:07:31 GMT 2022 diff --git a/reg_tests/cpld_gridgen/RegressionTests_orion.intel.log b/reg_tests/cpld_gridgen/RegressionTests_orion.intel.log new file mode 100644 index 000000000..2a7e3b8e0 --- /dev/null +++ b/reg_tests/cpld_gridgen/RegressionTests_orion.intel.log @@ -0,0 +1,76 @@ +Sat Apr 23 12:52:18 CDT 2022 +Start Regression test + +Working dir = /work/noaa/stmp/jminsuk/CPLD_GRIDGEN/rt_614/025 +Baseline dir = /work/noaa/nems/role-nems/ufs_utils/reg_tests/cpld_gridgen/baseline_data/025 + +Checking test 025 results .... +Comparing Bu.mx025_SCRIP.nc........OK +Comparing C384.mx025.tile1.nc........OK +Comparing C384.mx025.tile2.nc........OK +Comparing C384.mx025.tile3.nc........OK +Comparing C384.mx025.tile4.nc........OK +Comparing C384.mx025.tile5.nc........OK +Comparing C384.mx025.tile6.nc........OK +Comparing Ct.mx025_SCRIP_land.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx025.to.C384.nc........OK +Comparing Cu.mx025_SCRIP.nc........OK +Comparing Cv.mx025_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx025.nc........OK +Comparing kmtu_cice_NEMS_mx025.nc........OK +Comparing mesh.mx025.nc........OK +Comparing tripole.mx025.nc........OK + + +Working dir = /work/noaa/stmp/jminsuk/CPLD_GRIDGEN/rt_614/050 +Baseline dir = /work/noaa/nems/role-nems/ufs_utils/reg_tests/cpld_gridgen/baseline_data/050 + +Checking test 050 results .... +Comparing Bu.mx050_SCRIP.nc........OK +Comparing C192.mx050.tile1.nc........OK +Comparing C192.mx050.tile2.nc........OK +Comparing C192.mx050.tile3.nc........OK +Comparing C192.mx050.tile4.nc........OK +Comparing C192.mx050.tile5.nc........OK +Comparing C192.mx050.tile6.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx050_SCRIP_land.nc........OK +Comparing Ct.mx050_SCRIP.nc........OK +Comparing Ct.mx050.to.C192.nc........OK +Comparing Cu.mx050_SCRIP.nc........OK +Comparing Cv.mx050_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx050.nc........OK +Comparing kmtu_cice_NEMS_mx050.nc........OK +Comparing mesh.mx050.nc........OK +Comparing tripole.mx025.Ct.to.mx050.Ct.neareststod.nc........OK +Comparing tripole.mx050.nc........OK + + +Working dir = /work/noaa/stmp/jminsuk/CPLD_GRIDGEN/rt_614/100 +Baseline dir = /work/noaa/nems/role-nems/ufs_utils/reg_tests/cpld_gridgen/baseline_data/100 + +Checking test 100 results .... +Comparing Bu.mx100_SCRIP.nc........OK +Comparing C96.mx100.tile1.nc........OK +Comparing C96.mx100.tile2.nc........OK +Comparing C96.mx100.tile3.nc........OK +Comparing C96.mx100.tile4.nc........OK +Comparing C96.mx100.tile5.nc........OK +Comparing C96.mx100.tile6.nc........OK +Comparing Ct.mx025_SCRIP.nc........OK +Comparing Ct.mx100_SCRIP_land.nc........OK +Comparing Ct.mx100_SCRIP.nc........OK +Comparing Ct.mx100.to.C96.nc........OK +Comparing Cu.mx100_SCRIP.nc........OK +Comparing Cv.mx100_SCRIP.nc........OK +Comparing grid_cice_NEMS_mx100.nc........OK +Comparing kmtu_cice_NEMS_mx100.nc........OK +Comparing mesh.mx100.nc........OK +Comparing tripole.mx025.Ct.to.mx100.Ct.neareststod.nc........OK +Comparing tripole.mx100.nc........OK +Comparing ufs.topo_edits_011818.nc........OK + + +REGRESSION TEST WAS SUCCESSFUL +Sat Apr 23 12:56:51 CDT 2022 diff --git a/reg_tests/cpld_gridgen/parm/grid.nml.IN b/reg_tests/cpld_gridgen/parm/grid.nml.IN new file mode 100644 index 000000000..8776b58c8 --- /dev/null +++ b/reg_tests/cpld_gridgen/parm/grid.nml.IN @@ -0,0 +1,15 @@ +& grid_nml +ni=NI_GLB +nj=NJ_GLB +dirsrc='FIXDIR' +dirout='OUTDIR' +fv3dir='MOSAICDIR' +topofile=TOPOGFILE +editsfile=EDITSFILE +res=RESNAME +atmres=MOSAICRES +npx=NPX +editmask=DO_MASKEDIT +debug=DO_DEBUG +do_postwgts=DO_POSTWGTS +/ diff --git a/reg_tests/cpld_gridgen/rt.conf b/reg_tests/cpld_gridgen/rt.conf new file mode 100644 index 000000000..7c263f631 --- /dev/null +++ b/reg_tests/cpld_gridgen/rt.conf @@ -0,0 +1,6 @@ +# C384_025 needs to be the first test due to dependency +# TEST_NAME | DEP_NAME +# + C384_025 | + C192_050 | C384_025 + C096_100 | C384_025 diff --git a/reg_tests/cpld_gridgen/rt.sh b/reg_tests/cpld_gridgen/rt.sh new file mode 100755 index 000000000..ffda43358 --- /dev/null +++ b/reg_tests/cpld_gridgen/rt.sh @@ -0,0 +1,272 @@ +#!/bin/bash +set -eu + +error() { + echo + echo "$@" 1>&2 + exit 1 +} + +usage() { + echo + echo "Usage: $program [-c] [-m] [-h] [-b]" + echo + echo " -b build the executable" + echo + echo " -c create a new baseline" + echo + echo " -m compare against the new baseline" + echo + echo " -h display this help and exit" + echo + echo " Examples" + echo + echo " './rt.sh -b' build exe file. compare against the existing baseline" + echo " './rt.sh -bc' build exe file. create a new baseline" + echo " './rt.sh -m' do not build exe file. compare against the new baseline" + echo +} + +usage_and_exit() { + usage + exit $1 +} + +check_results() { + + [ -o xtrace ] && set_x='set -x' || set_x='set +x' + set +x + + local test_status=PASS + # verification run + if [[ $CREATE_BASELINE = false ]]; then + + echo | tee -a $PATHRT/$REGRESSIONTEST_LOG + echo "Working dir = $RUNDIR" | tee -a $PATHRT/$REGRESSIONTEST_LOG + echo "Baseline dir = $BASELINE" | tee -a $PATHRT/$REGRESSIONTEST_LOG + echo | tee -a $PATHRT/$REGRESSIONTEST_LOG + echo "Checking test $TEST_NAME results ...." | tee -a $PATHRT/$REGRESSIONTEST_LOG + + for file in $BASELINE/*.nc; do + printf %s "Comparing " $(basename ${file}) "...." | tee -a $PATHRT/$REGRESSIONTEST_LOG + + if [[ ! -f $RUNDIR/$(basename ${file}) ]]; then + echo "....MISSING file" | tee -a $PATHRT/$REGRESSIONTEST_LOG + test_status=FAIL + else + nccmp -dmfqS $(basename ${file}) $file >>${PATHRT}/nccmp_${TEST_NAME}.log 2>&1 && d=$? || d=$? + if [[ $d -ne 0 ]]; then + echo "....NOT OK" | tee -a $PATHRT/$REGRESSIONTEST_LOG + test_status=FAIL + else + echo "....OK" | tee -a $PATHRT/$REGRESSIONTEST_LOG + fi + fi + done + echo | tee -a $PATHRT/$REGRESSIONTEST_LOG + + # baseline creation run + else + + echo | tee -a $PATHRT/$REGRESSIONTEST_LOG + echo "Working dir = $RUNDIR" | tee -a $PATHRT/$REGRESSIONTEST_LOG + echo "Moving baseline files to $NEW_BASELINE ...." | tee -a $PATHRT/$REGRESSIONTEST_LOG + echo | tee -a $PATHRT/$REGRESSIONTEST_LOG + + mkdir -p $NEW_BASELINE + + for file in *.nc; do + printf %s "Moving " $file "...." | tee -a $PATHRT/$REGRESSIONTEST_LOG + + cp $file $NEW_BASELINE/$file && d=$? || d=$? + if [[ $d -ne 0 ]]; then + echo "....NOT OK" | tee -a $PATHRT/$REGRESSIONTEST_LOG + test_status=FAIL + else + echo "....OK" | tee -a $PATHRT/$REGRESSIONTEST_LOG + fi + done + echo | tee -a $PATHRT/$REGRESSIONTEST_LOG + + fi + + if [[ $test_status == FAIL ]]; then + echo "$TEST_NAME failed" >> $PATHRT/fail_test_$TEST_NAME + fi +} + +readonly program=$(basename $0) +# PATHRT - Path to regression tests directory +readonly PATHRT="$(cd $(dirname $0) && pwd -P)" +export PATHRT +# PATHTR - Path to the UFS UTILS directory +readonly PATHTR="$(cd $PATHRT/../.. && pwd)" +export PATHTR +TESTS_FILE="$PATHRT/rt.conf" +export TEST_NAME= + +cd $PATHRT +export compiler=${compiler:-intel} +source $PATHTR/sorc/machine-setup.sh >/dev/null 2>&1 +echo "Machine: $target" +echo "Compiler: $compiler" + +COMPILE_LOG=compile.log +REGRESSIONTEST_LOG=RegressionTests_$target.$compiler.log +rm -f fail_test* $COMPILE_LOG run_*.log nccmp_*.log summary.log + +if [[ $target = hera ]]; then + STMP=${STMP:-/scratch1/NCEPDEV/stmp4/$USER} + export MOM6_FIXDIR=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/fix_mom6 + BASELINE_ROOT=/scratch1/NCEPDEV/nems/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data + ACCOUNT=${ACCOUNT:-nems} + QUEUE=${QUEUE:-batch} + PARTITION=hera + SBATCH_COMMAND="./cpld_gridgen.sh" +elif [[ $target = orion ]]; then + STMP=${STMP:-/work/noaa/stmp/$USER} + export MOM6_FIXDIR=/work/noaa/nems/role-nems/ufs_utils/reg_tests/cpld_gridgen/fix_mom6 + BASELINE_ROOT=/work/noaa/nems/role-nems/ufs_utils/reg_tests/cpld_gridgen/baseline_data + ACCOUNT=${ACCOUNT:-nems} + QUEUE=${QUEUE:-batch} + PARTITION=orion + ulimit -s unlimited + SBATCH_COMMAND="./cpld_gridgen.sh" +elif [[ $target = jet ]]; then + STMP=${STMP:-/lfs4/HFIP/h-nems/$USER} + export MOM6_FIXDIR=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/fix_mom6 + BASELINE_ROOT=/lfs4/HFIP/hfv3gfs/emc.nemspara/role.ufsutils/ufs_utils/reg_tests/cpld_gridgen/baseline_data + ACCOUNT=${ACCOUNT:-h-nems} + QUEUE=${QUEUE:-batch} + PARTITION=xjet + ulimit -s unlimited + SBATCH_COMMAND="./cpld_gridgen.sh" +fi +NEW_BASELINE_ROOT=$STMP/CPLD_GRIDGEN/BASELINE +RUNDIR_ROOT=$STMP/CPLD_GRIDGEN/rt_$$ + +BUILD_EXE=false +CREATE_BASELINE=false +while getopts :bcmh opt; do + case $opt in + b) + BUILD_EXE=true + ;; + c) + CREATE_BASELINE=true + ;; + m) + BASELINE_ROOT=$NEW_BASELINE_ROOT + ;; + h) + usage_and_exit 0 + ;; + '?') + error "$program: invalid option" + ;; + esac +done + +# Build the executable file +if [[ $BUILD_EXE = true ]]; then + cd $PATHTR + rm -rf $PATHTR/build $PATHTR/exec $PATHTR/lib + ./build_all.sh >$PATHRT/$COMPILE_LOG 2>&1 && d=$? || d=$? + if [[ d -ne 0 ]]; then + error "Build did not finish successfully. Check $COMPILE_LOG" + else + echo "Build was successful" + fi +fi + +if [[ ! -f $PATHTR/exec/cpld_gridgen ]]; then + error "cpld_gridgen exe file is not found in $PATHTR/exe/. Try -b to build or -h for help." +else + echo "cpld_gridgen exe file is found in $PATHTR/exec/" +fi + +module use $PATHTR/modulefiles +module load build.$target.$compiler +module list + +if [[ $CREATE_BASELINE = true ]]; then + rm -rf $NEW_BASELINE_ROOT + mkdir -p $NEW_BASELINE_ROOT +fi + +date > $PATHRT/$REGRESSIONTEST_LOG +echo "Start Regression test" | tee -a $PATHRT/$REGRESSIONTEST_LOG + +# Run tests specified in $TESTS_FILE +while read -r line || [ "$line" ]; do + + line="${line#"${line%%[![:space:]]*}"}" + [[ ${#line} == 0 ]] && continue + [[ $line =~ \# ]] && continue + + TEST_NAME=$(echo $line | cut -d'|' -f1 | sed -e 's/^ *//' -e 's/ *$//') + DEP_NAME=$(echo $line | cut -d'|' -f2 | sed -e 's/^ *//' -e 's/ *$//') + TEST_NAME=${TEST_NAME##*_} + DEP_NAME=${DEP_NAME##*_} + + cd $PATHRT + RUNDIR=$RUNDIR_ROOT/$TEST_NAME + BASELINE=$BASELINE_ROOT/$TEST_NAME + NEW_BASELINE=$NEW_BASELINE_ROOT/$TEST_NAME + DEPDIR=$RUNDIR_ROOT/$DEP_NAME + mkdir -p $RUNDIR + + # OUTDIR_PATH is passed down to $PATHTR/ush/cpld_gridgen.sh + # It MUST be set + export OUTDIR_PATH=$RUNDIR + + if [[ -n $DEP_NAME ]]; then + cp $DEPDIR/Ct.mx025_SCRIP.nc $RUNDIR >/dev/null 2>&1 && d=$? || d=$? + if [[ $d -eq 1 ]]; then + error "DEPDIR $DEPDIR does not exist. Dependency not met" + fi + fi + + cp $PATHTR/exec/cpld_gridgen $RUNDIR + cp $PATHTR/ush/cpld_gridgen.sh $RUNDIR + cp $PATHRT/parm/grid.nml.IN $RUNDIR + cd $RUNDIR + + sbatch --wait --ntasks-per-node=1 --nodes=1 --mem=4G -t 0:05:00 -A $ACCOUNT -q $QUEUE -J $TEST_NAME \ + --partition=$PARTITION -o $PATHRT/run_${TEST_NAME}.log -e $PATHRT/run_${TEST_NAME}.log \ + --wrap "$SBATCH_COMMAND $TEST_NAME" && d=$? || d=$? + + if [[ d -ne 0 ]]; then + error "Batch job for test $TEST_NAME did not finish successfully. Refer to run_${TEST_NAME}.log" + fi + + check_results + +done <$TESTS_FILE +if [[ $? -ne 0 ]]; then + error "Run test while loop did not finish properly" +fi + +cd $PATHRT +FAIL_FILES="fail_test_*" +for file in $FAIL_FILES; do + if [[ -f "$file" ]]; then + cat "$file" >> fail_test + fi +done + +if [[ -e fail_test ]]; then + echo | tee -a $REGRESSIONTEST_LOG + for file in fail_test_*; do + cat $file >>$REGRESSIONTEST_LOG + cat $file >>summary.log + done + + echo | tee -a $REGRESSIONTEST_LOG + echo "REGRESSION TEST FAILED" | tee -a $REGRESSIONTEST_LOG +else + echo | tee -a $REGRESSIONTEST_LOG + echo "REGRESSION TEST WAS SUCCESSFUL" | tee -a $REGRESSIONTEST_LOG + echo "All tests passed" >>summary.log +fi +date >> $REGRESSIONTEST_LOG diff --git a/reg_tests/rt.sh b/reg_tests/rt.sh index b16d98c07..e533191b2 100755 --- a/reg_tests/rt.sh +++ b/reg_tests/rt.sh @@ -67,6 +67,30 @@ cd fix cd ../reg_tests +if [[ $target == "orion" ]] || [[ $target == "jet" ]] || [[ $target == "hera" ]] ; then + + cd cpld_gridgen + export ACCOUNT=$PROJECT_CODE + export STMP=$WORK_DIR/reg-tests + + ./rt.sh 2>/dev/null & + + set -x + + sleep_time=0 + while [ ! -f "summary.log" ]; do + sleep 10 + sleep_time=$((sleep_time+10)) + if (( sleep_time > TIMEOUT_LIMIT )); then + kill -9 %1 + mail -s "UFS_UTILS Consistency Tests timed out on ${target}" ${MAILTO} < ${WORK_DIR}/reg_test_results.txt + exit 1 + fi + done + cd .. + +fi + sleep_time=0 for dir in snow2mdl global_cycle chgres_cube grid_gen; do cd $dir @@ -114,8 +138,8 @@ done echo "Commit hash: ${current_hash}" >> ${WORK_DIR}/reg_test_results.txt echo "" >> ${WORK_DIR}/reg_test_results.txt -for dir in chgres_cube grid_gen global_cycle ice_blend snow2mdl; do - success=true +success=true +for dir in cpld_gridgen chgres_cube grid_gen global_cycle ice_blend snow2mdl; do if grep -qi "FAILED" ${dir}/summary.log; then success=false echo "${dir} consistency tests FAILED" >> ${WORK_DIR}/reg_test_results.txt diff --git a/sorc/CMakeLists.txt b/sorc/CMakeLists.txt index 282878ff5..02e142110 100644 --- a/sorc/CMakeLists.txt +++ b/sorc/CMakeLists.txt @@ -18,3 +18,4 @@ add_subdirectory(sfc_climo_gen.fd) add_subdirectory(vcoord_gen.fd) add_subdirectory(fvcom_tools.fd) add_subdirectory(gblevents.fd) +add_subdirectory(cpld_gridgen.fd) diff --git a/sorc/cpld_gridgen.fd/CMakeLists.txt b/sorc/cpld_gridgen.fd/CMakeLists.txt new file mode 100644 index 000000000..7087d0589 --- /dev/null +++ b/sorc/cpld_gridgen.fd/CMakeLists.txt @@ -0,0 +1,62 @@ +# This is the CMake build file for the chgres_cube utility in the +# UFS_UTILS package. +# +# George Gayno, Mark Potts, Kyle Gerheiser + +set(lib_src + angles.F90 + charstrings.F90 + cicegrid.F90 + debugprint.F90 + gengrid_kinds.F90 + grdvars.F90 + inputnml.F90 + mapped_mask.F90 + postwgts.F90 + scripgrid.F90 + topoedits.F90 + tripolegrid.F90 + vartypedefs.F90 + vertices.F90) + +set(exe_src gen_fixgrid.F90) + +if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -assume byterecl") +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-0 -fdefault-real-8") + + # Turn on this argument mismatch flag for gfortran10. + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch") + endif() +endif() + +set(exe_name cpld_gridgen) + +add_library(cpld_gridgen_lib STATIC ${lib_src}) +add_executable(${exe_name} ${exe_src}) + +set(mod_dir "${CMAKE_CURRENT_BINARY_DIR}/mod") +set_target_properties(cpld_gridgen_lib PROPERTIES Fortran_MODULE_DIRECTORY ${mod_dir}) +target_include_directories(cpld_gridgen_lib INTERFACE ${mod_dir}) + +target_link_libraries( + cpld_gridgen_lib + PUBLIC + esmf + MPI::MPI_Fortran + NetCDF::NetCDF_Fortran) + +if(OpenMP_Fortran_FOUND) + target_link_libraries(${exe_name} PUBLIC OpenMP::OpenMP_Fortran) +endif() + +target_link_libraries(${exe_name} PRIVATE cpld_gridgen_lib) + +install(TARGETS ${exe_name} RUNTIME DESTINATION ${exec_dir}) + +# If doxygen documentation we enabled, build it. +if(ENABLE_DOCS) + add_subdirectory(docs) +endif() diff --git a/sorc/cpld_gridgen.fd/angles.F90 b/sorc/cpld_gridgen.fd/angles.F90 new file mode 100644 index 000000000..99d323f3d --- /dev/null +++ b/sorc/cpld_gridgen.fd/angles.F90 @@ -0,0 +1,204 @@ +!> @file +!! @brief Determine the rotation angle on center and +!! corner points +!! @author Denise.Worthen@noaa.gov +!! +!> This module finds the rotation angle for at both center and corner points +!! It utilizes the MOM6 function modulo_around_point +!! @author Denise.Worthen@noaa.gov + +module angles + + use gengrid_kinds, only : dbl_kind, int_kind + use grdvars, only : ni,nj,nx,ny + use grdvars, only : x,y,xsgp1,ysgp1,sg_maxlat + use grdvars, only : latBu,lonBu,lonCt + use grdvars, only : angq,anglet + use grdvars, only : mastertask, debug + + implicit none + + contains +!> Find the rotation angle on corner grid (Bu) points using the full MOM6 supergrid +!! +!! @author Denise.Worthen@noaa.gov + subroutine find_angq + + ! local variables + integer :: i,j,i1,i2,m,n + + ! pole locations on SG + integer(int_kind) :: ipolesg(2) + + ! from geolonB fix in MOM6 + real(dbl_kind) :: len_lon ! The periodic range of longitudes, usually 360 degrees. + real(dbl_kind) :: pi_720deg ! One quarter the conversion factor from degrees to radians. + real(dbl_kind) :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. + real(dbl_kind) :: lon_scale = 0.0 + +!--------------------------------------------------------------------- +! to find angleq on seam, replicate supergrid values across seam +!--------------------------------------------------------------------- + + angq = 0.0 + xsgp1 = 0.0; ysgp1 = 0.0 + !pole on supergrid + ipolesg = -1 + j = ny + do i = 1,nx/2 + if(y(i,j) .eq. sg_maxlat)ipolesg(1) = i + enddo + do i = nx/2+1,nx + if(y(i,j) .eq. sg_maxlat)ipolesg(2) = i + enddo + if(mastertask .and. debug)print *,'poles found at ',ipolesg + + xsgp1(:,0:ny) = x(:,0:ny) + ysgp1(:,0:ny) = y(:,0:ny) + + !check + do i = ipolesg(1)-5,ipolesg(1)+5 + i2 = ipolesg(2)+(ipolesg(1)-i)+1 + if(mastertask .and. debug)print *,i,i2 + enddo + print * + do i = ipolesg(2)-5,ipolesg(2)+5 + i2 = ipolesg(2)+(ipolesg(1)-i)+1 + if(mastertask .and. debug)print *,i,i2 + enddo + + !replicate supergrid across pole + do i = 1,nx + i2 = ipolesg(2)+(ipolesg(1)-i) + xsgp1(i,ny+1) = xsgp1(i2,ny) + ysgp1(i,ny+1) = ysgp1(i2,ny) + enddo + + !check + if(mastertask .and. debug)then + j = ny+1 + i1 = ipolesg(1); i2 = ipolesg(2)-(ipolesg(1)-i1) + print *,'replicate X across seam on SG' + print *,xsgp1(i1-2,j),xsgp1(i2+2,j) + print *,xsgp1(i1-1,j),xsgp1(i2+1,j) + print *,xsgp1(i1, j),xsgp1(i2, j) + print *,xsgp1(i1+1,j),xsgp1(i2-1,j) + print *,xsgp1(i1+2,j),xsgp1(i2-2,j) + + print *,'replicate Y across seam on SG' + print *,ysgp1(i1-2,j),ysgp1(i2+2,j) + print *,ysgp1(i1-1,j),ysgp1(i2+1,j) + print *,ysgp1(i1, j),ysgp1(i2, j) + print *,ysgp1(i1+1,j),ysgp1(i2-1,j) + print *,ysgp1(i1+2,j),ysgp1(i2-2,j) + end if + +!--------------------------------------------------------------------- +! rotation angle on supergrid vertices +! lonB: x(i-1,j-1) has same relationship to x(i,j) on SG as +! geolonT(i,j) has to geolonBu(i,j) on the reduced grid +!--------------------------------------------------------------------- + + ! constants as defined in MOM + pi_720deg = atan(1.0) / 180.0 + len_lon = 360.0 + do j=1,ny ; do i=1,nx-1 + do n=1,2 ; do m=1,2 + lonB(m,n) = modulo_around_point(xsgp1(I+m-2,J+n-2), xsgp1(i-1,j-1), len_lon) + enddo ; enddo + lon_scale = cos(pi_720deg*(ysgp1(i-1,j-1) + ysgp1(i+1,j-1) + & + ysgp1(i-1,j+1) + ysgp1(i+1,j+1)) ) + angq(i,j) = atan2(lon_scale*((lonB(1,2) - lonB(2,1)) + (lonB(2,2) - lonB(1,1))), & + ysgp1(i-1,j+1) + ysgp1(i+1,j+1) - & + ysgp1(i-1,j-1) - ysgp1(i+1,j-1) ) + enddo ; enddo + + !check + if(mastertask .and. debug) then + j = ny + i1 = ipolesg(1); i2 = ipolesg(2)-(ipolesg(1)-i1) + print *,'angq along seam on SG' + print *,angq(i1-2,j),angq(i2+2,j) + print *,angq(i1-1,j),angq(i2+1,j) + print *,angq(i1, j),angq(i2, j) + print *,angq(i1+1,j),angq(i2-1,j) + print *,angq(i1+2,j),angq(i2-2,j) + end if + + end subroutine find_angq + +!> Find the rotation angle on center (Ct) grid points +!! +!! @author Denise.Worthen@noaa.gov + subroutine find_ang + + ! local variables + integer :: i,j,m,n + integer :: ii,jj + + ! from geolonB fix in MOM6 + real(dbl_kind) :: len_lon ! The periodic range of longitudes, usually 360 degrees. + real(dbl_kind) :: pi_720deg ! One quarter the conversion factor from degrees to radians. + real(dbl_kind) :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. + real(dbl_kind) :: lon_scale = 0.0 + +!--------------------------------------------------------------------- +! rotation angle for "use_bugs" = false case from MOM6 +! src/initialization/MOM_shared_initialization.F90 but allow for not +! having halo values +! note this does not reproduce sin_rot,cos_rot found in MOM6 output +! differences are ~O 10-6 +!--------------------------------------------------------------------- + + anglet = 0.0 + pi_720deg = atan(1.0) / 180.0 + len_lon = 360.0 + do j=1,nj; do i = 1,ni + do n=1,2 ; do m=1,2 + jj = J+n-2; ii = I+m-2 + if(jj .eq. 0)jj = 1 + if(ii .eq. 0)ii = ni + lonB(m,n) = modulo_around_point(LonBu(ii,jj), LonCt(i,j), len_lon) + ! lonB(m,n) = modulo_around_point(LonBu(I+m-2,J+n-2), LonCt(i,j), len_lon) + enddo ; enddo + jj = j-1; ii = i-1 + if(jj .eq. 0)jj = 1 + if(ii .eq. 0)ii = ni + lon_scale = cos(pi_720deg*((LatBu(ii,jj) + LatBu(I,J)) + & + (LatBu(I,jj) + LatBu(ii,J)) ) ) + anglet(i,j) = atan2(lon_scale*((lonB(1,2) - lonB(2,1)) + (lonB(2,2) - lonB(1,1))), & + (LatBu(ii,J) - LatBu(I,jj)) + & + (LatBu(I,J) - LatBu(ii,jj)) ) + + !lon_scale = cos(pi_720deg*((LatBu(I-1,J-1) + LatBu(I,J)) + & + ! (LatBu(I,J-1) + LatBu(I-1,J)) ) ) + !anglet(i,j) = atan2(lon_scale*((lonB(1,2) - lonB(2,1)) + (lonB(2,2) - lonB(1,1))), & + ! (LatBu(I-1,J) - LatBu(I,J-1)) + & + ! (LatBu(I,J) - LatBu(I-1,J-1)) ) + enddo ; enddo + + end subroutine find_ang +! ----------------------------------------------------------------------------- +!> Return the modulo value of x in an interval [xc-(Lx/2) xc+(Lx/2)] +!! If Lx<=0, then it returns x without applying modulo arithmetic. +!! +!! From src/initialization/MOM_shared_initialization.F90: +!! @param[in] x Value to which to apply modulo arithmetic +!! @param[in] xc Center of modulo range +!! @param[in] Lx Modulo range width +!! @return x_mod Value x shifted by an integer multiple of Lx to be close to xc + function modulo_around_point(x, xc, Lx) result(x_mod) + use gengrid_kinds, only : dbl_kind + + real(dbl_kind), intent(in) :: x + real(dbl_kind), intent(in) :: xc + real(dbl_kind), intent(in) :: Lx + real(dbl_kind) :: x_mod + + if (Lx > 0.0) then + x_mod = modulo(x - (xc - 0.5*Lx), Lx) + (xc - 0.5*Lx) + else + x_mod = x + endif + end function modulo_around_point +end module angles diff --git a/sorc/cpld_gridgen.fd/charstrings.F90 b/sorc/cpld_gridgen.fd/charstrings.F90 new file mode 100644 index 000000000..93c6b304c --- /dev/null +++ b/sorc/cpld_gridgen.fd/charstrings.F90 @@ -0,0 +1,34 @@ +!> @file +!! @brief Define required character string variables +!! @author Denise.Worthen@noaa.gov +!! +!> This module contains the character string variables +!! @author Denise.Worthen@noaa.gov + +module charstrings + + use gengrid_kinds, only : CL,CM,CS + + implicit none + + character(len=CL) :: dirsrc !< The source directory containing the fix files for MOM6 + character(len=CL) :: dirout !< The directory where output files will be written + character(len=CL) :: fv3dir !< The directory containing the FV3 mosaic files + character(len=CS) :: res !< The Ocean/Ice resolution, e.g. 100 (1deg), 050 (1/2deg), + !! 025 (1/4deg) + character(len=CS) :: atmres !< The ATM resolution, e.g. C96, C192, C384 + character(len=CL) :: logmsg !< An informational message + + character(len=CL) :: maskfile = 'ocean_mask.nc' !< The name of the MOM6 mask file + character(len=CS) :: maskname = 'mask' !< The variable name of the mask field + character(len=CL) :: editsfile !< The name of the topo edits file (resolution specific) + + character(len=CL) :: topofile !< The name of the MOM6 bathymetry file + character(len=CS) :: toponame = 'depth' !< The name of the bathymetry field + + character(len=CL) :: history !< A documentation string + character(len=CS) :: cdate !< The date stamp of file creation + + character(len= 2), dimension(4) :: staggerlocs = (/'Ct','Cu','Cv','Bu'/) !< The named stagger locations of the grid + +end module charstrings diff --git a/sorc/cpld_gridgen.fd/cicegrid.F90 b/sorc/cpld_gridgen.fd/cicegrid.F90 new file mode 100644 index 000000000..aaca257da --- /dev/null +++ b/sorc/cpld_gridgen.fd/cicegrid.F90 @@ -0,0 +1,97 @@ +!> @file +!! @brief Write the CICE6 grid file +!! @author Denise.Worthen@noaa.gov +!! +!> Write the CICE6 grid file +!! @author Denise.Worthen@noaa.gov + +module cicegrid + + use grdvars, only: ni,nj,ulat,ulon,htn,hte,angle,wet4,mastertask + use charstrings, only: history, logmsg + use vartypedefs, only: maxvars, cicevars, cicevars_typedefine + use gengrid_kinds, only: CM + use netcdf + + implicit none + private + + public write_cicegrid + + contains +!> Write the CICE6 grid file +!! +!! @param[in] fname the name of the CICE6 grid file to write +!! +!! @author Denise.Worthen@noaa.gov + + subroutine write_cicegrid(fname) + + character(len=*), intent(in) :: fname + + ! local variables + integer :: ii,id,rc, ncid, dim2(2) + integer :: idimid,jdimid + + character(len=2) :: vtype + character(len=CM) :: vname + character(len=CM) :: vlong + character(len=CM) :: vunit + +!--------------------------------------------------------------------- +! create the netcdf file +!--------------------------------------------------------------------- + + ! define the output variables and file name + call cicevars_typedefine + + rc = nf90_create(fname, nf90_write, ncid) + if(mastertask) then + logmsg = '==> writing CICE grid to '//trim(fname) + print '(a)', trim(logmsg) + if(rc .ne. 0)print '(a)', 'nf90_create = '//trim(nf90_strerror(rc)) + end if + + rc = nf90_def_dim(ncid, 'ni', ni, idimid) + rc = nf90_def_dim(ncid, 'nj', nj, jdimid) + + do ii = 1,maxvars + if(len_trim(cicevars(ii)%var_name) .gt. 0)then + vname = trim(cicevars(ii)%var_name) + vlong = trim(cicevars(ii)%long_name) + vunit = trim(cicevars(ii)%unit_name) + vtype = trim(cicevars(ii)%var_type) + + dim2(:) = (/idimid, jdimid/) + if(vtype .eq. 'r8')rc = nf90_def_var(ncid, vname, nf90_double, dim2, id) + if(vtype .eq. 'r4')rc = nf90_def_var(ncid, vname, nf90_float, dim2, id) + if(vtype .eq. 'i4')rc = nf90_def_var(ncid, vname, nf90_int, dim2, id) + rc = nf90_put_att(ncid, id, 'units', vunit) + rc = nf90_put_att(ncid, id, 'long_name', vlong) + end if + enddo + rc = nf90_put_att(ncid, nf90_global, 'history', trim(history)) + rc = nf90_enddef(ncid) + + rc = nf90_inq_varid(ncid, 'ulon', id) + rc = nf90_put_var(ncid, id, ulon) + + rc = nf90_inq_varid(ncid, 'ulat', id) + rc = nf90_put_var(ncid, id, ulat) + + rc = nf90_inq_varid(ncid, 'htn', id) + rc = nf90_put_var(ncid, id, htn) + + rc = nf90_inq_varid(ncid, 'hte', id) + rc = nf90_put_var(ncid, id, hte) + + rc = nf90_inq_varid(ncid, 'angle', id) + rc = nf90_put_var(ncid, id, angle) + + rc = nf90_inq_varid(ncid, 'kmt', id) + rc = nf90_put_var(ncid, id, int(wet4)) + + rc = nf90_close(ncid) + + end subroutine write_cicegrid +end module cicegrid diff --git a/sorc/cpld_gridgen.fd/debugprint.F90 b/sorc/cpld_gridgen.fd/debugprint.F90 new file mode 100644 index 000000000..93f0d98b9 --- /dev/null +++ b/sorc/cpld_gridgen.fd/debugprint.F90 @@ -0,0 +1,247 @@ +!> @file +!! @brief Print debugging information +!! @author Denise.Worthen@noaa.gov +!! +!> Print values for debugging +!! @author Denise.Worthen@noaa.gov + +module debugprint + + use esmf, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use grdvars, only : ni,nj,ipole,angle,angleT + use grdvars, only : htn,latCt,lonCt,latCv,lonCv,latCu,lonCu,latBu,lonBu + use grdvars, only : xlatCt,xlonCt,xlatCu,xlonCu + use grdvars, only : latBu_vert,lonBu_vert,latCv_vert,lonCv_vert + use grdvars, only : latCt_vert,lonCt_vert,latCu_vert,lonCu_vert + + implicit none + private + + public :: checkseam, checkxlatlon, checkpoint + + contains +!> Print values across the tripole seam +!! +!! @author Denise.Worthen@noaa.gov + + subroutine checkseam + + ! local variables + integer :: j,i1,i2 + + j = nj + i1 = ipole(1); i2 = ipole(2)+1 + + !htn must be the same along seam + j = nj + i1 = ipole(1); i2 = ipole(2)+1 + print *,'HTN across seam ' + print *,htn(i1-2,j),htn(i2+2,j) + print *,htn(i1-1,j),htn(i2+1,j) + print *,htn(i1, j),htn(i2, j) + print *,htn(i1+1,j),htn(i2-1,j) + print *,htn(i1+2,j),htn(i2-2,j) + + print *,'latCv across seam ' + print *,latCv(i1-2,j),latCv(i2+2,j) + print *,latCv(i1-1,j),latCv(i2+1,j) + print *,latCv(i1, j),latCv(i2, j) + print *,latCv(i1+1,j),latCv(i2-1,j) + print *,latCv(i1+2,j),latCv(i2-2,j) + + print *,'lonCv across seam ' + print *,lonCv(i1-2,j),lonCv(i2+2,j) + print *,lonCv(i1-1,j),lonCv(i2+1,j) + print *,lonCv(i1, j),lonCv(i2, j) + print *,lonCv(i1+1,j),lonCv(i2-1,j) + print *,lonCv(i1+2,j),lonCv(i2-2,j) + + print *,'angleT across seam ' + print *,angleT(i1-2,j),angleT(i2+2,j) + print *,angleT(i1-1,j),angleT(i2+1,j) + print *,angleT(i1, j),angleT(i2, j) + print *,angleT(i1+1,j),angleT(i2-1,j) + print *,angleT(i1+2,j),angleT(i2-2,j) + + print *,'latCu across seam ' + print *,latCu(i1-3,j),latCu(i2+2,j),latCu(i1-3,j)-latCu(i2+2,j) + print *,latCu(i1-2,j),latCu(i2+1,j) + print *,latCu(i1-1,j),latCu(i2+0,j) + print *,latCu(i1, j),latCu(i2-1,j) + print *,latCu(i1+1,j),latCu(i2-2,j) + print *,latCu(i1+2,j),latCu(i2-3,j) + print *,latCu(i1+3,j),latCu(i2-4,j) + + print *,'lonCu across seam ' + print *,lonCu(i1-3,j),lonCu(i2+2,j),lonCu(i1-3,j)+lonCu(i2+2,j) + print *,lonCu(i1-2,j),lonCu(i2+1,j) + print *,lonCu(i1-1,j),lonCu(i2+0,j) + print *,lonCu(i1, j),lonCu(i2-1,j) + print *,lonCu(i1+1,j),lonCu(i2-2,j) + print *,lonCu(i1+2,j),lonCu(i2-3,j) + print *,lonCu(i1+3,j),lonCu(i2-4,j) + + print *,'latCt across seam ' + print *,latCt(i1-3,j),latCt(i2+3,j),latCt(i1-3,j)-latCt(i2+3,j) + print *,latCt(i1-2,j),latCt(i2+2,j) + print *,latCt(i1-1,j),latCt(i2+1,j) + print *,latCt(i1, j),latCt(i2, j) + print *,latCt(i1+1,j),latCt(i2-1,j) + print *,latCt(i1+2,j),latCt(i2-2,j) + print *,latCt(i1+3,j),latCt(i2-3,j) + + print *,'lonCt across seam ' + print *,lonCt(i1-3,j),lonCt(i2+3,j),lonCt(i1-3,j)+lonCt(i2+3,j) + print *,lonCt(i1-2,j),lonCt(i2+2,j) + print *,lonCt(i1-1,j),lonCt(i2+1,j) + print *,lonCt(i1, j),lonCt(i2, j) + print *,lonCt(i1+1,j),lonCt(i2-1,j) + print *,lonCt(i1+2,j),lonCt(i2-2,j) + print *,lonCt(i1+3,j),lonCt(i2-3,j) + print * + end subroutine checkseam + + !> Print values near the poles and along the domain edges + !! + !! @author Denise.Worthen@noaa.gov + + subroutine checkxlatlon + + ! local variables + integer :: i + + print *,'============== Ct grid ===============' + print *,'============== Left pole ============' + do i = ipole(1)-3,ipole(1)+3 + print '(i5,6f12.5)',i,lonCt(i,nj),xlonCt(i),lonCt(i,nj)+xlonCt(i),latCt(i,nj),xlatCt(i),latCt(i,nj)-xlatCt(i) + enddo + print * + + print *,'============ Right pole ============' + do i = ipole(2)-3,ipole(2)+3 + print '(i5,6f12.5)',i,lonCt(i,nj),xlonCt(i),lonCt(i,nj)+xlonCt(i),latCt(i,nj),xlatCt(i),latCt(i,nj)-xlatCt(i) + enddo + print * + + print *,'============== Ct grid ===============' + print *,'============== Left edge ============' + do i = 1,5 + print '(i5,6f12.5)',i,lonCt(i,nj),xlonCt(i),lonCt(i,nj)+xlonCt(i),latCt(i,nj),xlatCt(i),latCt(i,nj)-xlatCt(i) + enddo + print * + print *,'============== Right edge ===========' + do i = ni-4,ni + print '(i5,6f12.5)',i,lonCt(i,nj),xlonCt(i),lonCt(i,nj)+xlonCt(i),latCt(i,nj),xlatCt(i),latCt(i,nj)-xlatCt(i) + enddo + print * + + + print *,'============== Cu grid ===============' + print *,'============== Left pole =============' + do i = ipole(1)-3,ipole(1)+3 + print '(i5,6f12.5)',i,lonCu(i,nj),xlonCu(i),lonCu(i,nj)+xlonCu(i),latCu(i,nj),xlatCu(i),latCu(i,nj)-xlatCu(i) + enddo + print * + + print *,'============ Right pole ============' + do i = ipole(2)-3,ipole(2)+3 + print '(i5,6f12.5)',i,lonCu(i,nj),xlonCu(i),lonCu(i,nj)+xlonCu(i),latCu(i,nj),xlatCu(i),latCu(i,nj)-xlatCu(i) + enddo + print * + + print *,'============== Cu grid ===============' + print *,'============== Left edge ============' + do i = 1,5 + print '(i5,6f12.5)',i,lonCu(i,nj),xlonCu(i),lonCu(i,nj)+xlonCu(i),latCu(i,nj),xlatCu(i),latCu(i,nj)-xlatCu(i) + enddo + print * + print *,'============== Right edge ===========' + do i = ni-4,ni + print '(i5,6f12.5)',i,lonCu(i,nj),xlonCu(i),lonCu(i,nj)+xlonCu(i),latCu(i,nj),xlatCu(i),latCu(i,nj)-xlatCu(i) + enddo + print * + + end subroutine checkxlatlon + +!> Print values at specified point +!! +!! @author Denise.Worthen@noaa.gov + + subroutine checkpoint + + ! local variables + integer :: i,j + + ! check + i = 1; j = nj + print '(f12.5,a,f12.5)',latBu_vert(i,j,2),' ',latBu_vert(i,j,1) + print '(a12,f12.5)',' ',latBu(i,j) + print '(f12.5,a,f12.5)',latBu_vert(i,j,3),' ',latBu_vert(i,j,4) + print * + print '(f12.5,a,f12.5)',lonBu_vert(i,j,2),' ',lonBu_vert(i,j,1) + print '(a12,f12.5)',' ',lonBu(i,j) + print '(f12.5,a,f12.5)',lonBu_vert(i,j,3),' ',lonBu_vert(i,j,4) + print * + print * + ! check + print '(f12.5,a,f12.5)',latCv_vert(i,j,2),' ',latCv_vert(i,j,1) + print '(a12,f12.5)',' ',latCv(i,j) + print '(f12.5,a,f12.5)',latCv_vert(i,j,3),' ',latCv_vert(i,j,4) + print * + print '(f12.5,a,f12.5)',lonCv_vert(i,j,2),' ',lonCv_vert(i,j,1) + print '(a12,f12.5)',' ',lonCv(i,j) + print '(f12.5,a,f12.5)',lonCv_vert(i,j,3),' ',lonCv_vert(i,j,4) + + print * + print * + + i = 1; j = 10 + print '(f12.5,a,f12.5)',latCt_vert(i,j,2),' ',latCt_vert(i,j,1) + print '(a12,f12.5)',' ',latCt(i,j) + print '(f12.5,a,f12.5)',latCt_vert(i,j,3),' ',latCt_vert(i,j,4) + print * + print '(f12.5,a,f12.5)',lonCt_vert(i,j,2),' ',lonCt_vert(i,j,1) + print '(a12,f12.5)',' ',lonCt(i,j) + print '(f12.5,a,f12.5)',lonCt_vert(i,j,3),' ',lonCt_vert(i,j,4) + print * + print * + ! check + print '(f12.5,a,f12.5)',latCu_vert(i,j,2),' ',latCu_vert(i,j,1) + print '(a12,f12.5)',' ',latCu(i,j) + print '(f12.5,a,f12.5)',latCu_vert(i,j,3),' ',latCu_vert(i,j,4) + print * + print '(f12.5,a,f12.5)',lonCu_vert(i,j,2),' ',lonCu_vert(i,j,1) + print '(a12,f12.5)',' ',lonCu(i,j) + print '(f12.5,a,f12.5)',lonCu_vert(i,j,3),' ',lonCu_vert(i,j,4) + + + i = ni; j = 10 + print '(f12.5,a,f12.5)',latCt_vert(i,j,2),' ',latCt_vert(i,j,1) + print '(a12,f12.5)',' ',latCt(i,j) + print '(f12.5,a,f12.5)',latCt_vert(i,j,3),' ',latCt_vert(i,j,4) + print * + print '(f12.5,a,f12.5)',lonCt_vert(i,j,2),' ',lonCt_vert(i,j,1) + print '(a12,f12.5)',' ',lonCt(i,j) + print '(f12.5,a,f12.5)',lonCt_vert(i,j,3),' ',lonCt_vert(i,j,4) + print * + print * + ! check + print '(f12.5,a,f12.5)',latCu_vert(i,j,2),' ',latCu_vert(i,j,1) + print '(a12,f12.5)',' ',latCu(i,j) + print '(f12.5,a,f12.5)',latCu_vert(i,j,3),' ',latCu_vert(i,j,4) + print * + print '(f12.5,a,f12.5)',lonCu_vert(i,j,2),' ',lonCu_vert(i,j,1) + print '(a12,f12.5)',' ',lonCu(i,j) + print '(f12.5,a,f12.5)',lonCu_vert(i,j,3),' ',lonCu_vert(i,j,4) + + print *,"latCt minmax ",minval(latCt),maxval(latCt) + print *,"latCu minmax ",minval(latCu),maxval(latCu) + print *,"latCv minmax ",minval(latCv),maxval(latCv) + print *,"latBu minmax ",minval(latBu),maxval(latBu) + + ! print *,minval(latCt_vert),maxval(latCt_vert) + ! print *,minval(lonCt_vert),maxval(lonCt_vert) + ! print *,minval(latBu_vert),maxval(latBu_vert) + ! print *,minval(lonBu_vert),maxval(lonBu_vert) + end subroutine checkpoint +end module debugprint diff --git a/sorc/cpld_gridgen.fd/docs/CMakeLists.txt b/sorc/cpld_gridgen.fd/docs/CMakeLists.txt new file mode 100644 index 000000000..d9496f340 --- /dev/null +++ b/sorc/cpld_gridgen.fd/docs/CMakeLists.txt @@ -0,0 +1,16 @@ +# This is the CMake file for building the docs directory of UFS_UTILS +# utility cpld_gridgen +# +# Ed Hartnett 3/8/21 + +# Create doxyfile. +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/Doxyfile.in ${CMAKE_CURRENT_BINARY_DIR}/Doxyfile @ONLY) + +# Build documentation with target all. +add_custom_target(cpld_gridgen_doc ALL + ${DOXYGEN_EXECUTABLE} ${CMAKE_CURRENT_BINARY_DIR}/Doxyfile + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + COMMENT "Generating API Documentation with Doxygen" VERBATIM) + +# Ensure top-level docs have been generated. +add_dependencies(cpld_gridgen_doc doc) diff --git a/sorc/cpld_gridgen.fd/docs/Doxyfile.in b/sorc/cpld_gridgen.fd/docs/Doxyfile.in new file mode 100644 index 000000000..62808f419 --- /dev/null +++ b/sorc/cpld_gridgen.fd/docs/Doxyfile.in @@ -0,0 +1,2573 @@ +# Doxyfile 1.9.1 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project. +# +# All text after a double hash (##) is considered a comment and is placed in +# front of the TAG it is preceding. +# +# All text after a single hash (#) is considered a comment and will be ignored. +# The format is: +# TAG = value [value, ...] +# For lists, items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (\" \"). + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the configuration +# file that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# https://www.gnu.org/software/libiconv/ for the list of possible encodings. +# The default value is: UTF-8. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by +# double-quotes, unless you are using Doxywizard) that should identify the +# project for which the documentation is generated. This name is used in the +# title of most generated pages and in a few other places. +# The default value is: My Project. + +PROJECT_NAME = cpld_gridgen + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. This +# could be handy for archiving the generated documentation or if some version +# control system is used. + +PROJECT_NUMBER = @PROJECT_VERSION@ + +# Using the PROJECT_BRIEF tag one can provide an optional one line description +# for a project that appears at the top of each page and should give viewer a +# quick idea about the purpose of the project. Keep the description short. + +PROJECT_BRIEF = + +# With the PROJECT_LOGO tag one can specify a logo or an icon that is included +# in the documentation. The maximum height of the logo should not exceed 55 +# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy +# the logo to the output directory. + +PROJECT_LOGO = + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path +# into which the generated documentation will be written. If a relative path is +# entered, it will be relative to the location where doxygen was started. If +# left blank the current directory will be used. + +OUTPUT_DIRECTORY = ../../../docs/html/cpld_gridgen + +# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- +# directories (in 2 levels) under the output directory of each output format and +# will distribute the generated files over these directories. Enabling this +# option can be useful when feeding doxygen a huge amount of source files, where +# putting all generated files in the same directory would otherwise causes +# performance problems for the file system. +# The default value is: NO. + +CREATE_SUBDIRS = NO + +# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII +# characters to appear in the names of generated files. If set to NO, non-ASCII +# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode +# U+3044. +# The default value is: NO. + +ALLOW_UNICODE_NAMES = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, +# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), +# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, +# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), +# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, +# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, +# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, +# Ukrainian and Vietnamese. +# The default value is: English. + +OUTPUT_LANGUAGE = English + +# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all generated output in the proper direction. +# Possible values are: None, LTR, RTL and Context. +# The default value is: None. + +OUTPUT_TEXT_DIRECTION = None + +# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member +# descriptions after the members that are listed in the file and class +# documentation (similar to Javadoc). Set to NO to disable this. +# The default value is: YES. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief +# description of a member or function before the detailed description +# +# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. +# The default value is: YES. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator that is +# used to form the text in various listings. Each string in this list, if found +# as the leading text of the brief description, will be stripped from the text +# and the result, after processing the whole list, is used as the annotated +# text. Otherwise, the brief description is used as-is. If left blank, the +# following values are used ($name is automatically replaced with the name of +# the entity):The $name class, The $name widget, The $name file, is, provides, +# specifies, contains, represents, a, an and the. + +ABBREVIATE_BRIEF = + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# doxygen will generate a detailed section even if there is only a brief +# description. +# The default value is: NO. + +ALWAYS_DETAILED_SEC = YES + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. +# The default value is: NO. + +INLINE_INHERITED_MEMB = YES + +# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path +# before files name in the file list and in the header files. If set to NO the +# shortest path that makes the file name unique will be used +# The default value is: YES. + +FULL_PATH_NAMES = YES + +# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. +# Stripping is only done if one of the specified strings matches the left-hand +# part of the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the path to +# strip. +# +# Note that you can specify absolute paths here, but also relative paths, which +# will be relative from the directory where doxygen is started. +# This tag requires that the tag FULL_PATH_NAMES is set to YES. + +STRIP_FROM_PATH = + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the +# path mentioned in the documentation of a class, which tells the reader which +# header file to include in order to use a class. If left blank only the name of +# the header file containing the class definition is used. Otherwise one should +# specify the list of include paths that are normally passed to the compiler +# using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but +# less readable) file names. This can be useful is your file systems doesn't +# support long names like on DOS, Mac, or CD-ROM. +# The default value is: NO. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the +# first line (until the first dot) of a Javadoc-style comment as the brief +# description. If set to NO, the Javadoc-style will behave just like regular Qt- +# style comments (thus requiring an explicit @brief command for a brief +# description.) +# The default value is: NO. + +JAVADOC_AUTOBRIEF = YES + +# If the JAVADOC_BANNER tag is set to YES then doxygen will interpret a line +# such as +# /*************** +# as being the beginning of a Javadoc-style comment "banner". If set to NO, the +# Javadoc-style will behave just like regular comments and it will not be +# interpreted by doxygen. +# The default value is: NO. + +JAVADOC_BANNER = NO + +# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first +# line (until the first dot) of a Qt-style comment as the brief description. If +# set to NO, the Qt-style will behave just like regular Qt-style comments (thus +# requiring an explicit \brief command for a brief description.) +# The default value is: NO. + +QT_AUTOBRIEF = YES + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a +# multi-line C++ special comment block (i.e. a block of //! or /// comments) as +# a brief description. This used to be the default behavior. The new default is +# to treat a multi-line C++ comment block as a detailed description. Set this +# tag to YES if you prefer the old behavior instead. +# +# Note that setting this tag to YES also means that rational rose comments are +# not recognized any more. +# The default value is: NO. + +MULTILINE_CPP_IS_BRIEF = YES + +# By default Python docstrings are displayed as preformatted text and doxygen's +# special commands cannot be used. By setting PYTHON_DOCSTRING to NO the +# doxygen's special commands can be used and the contents of the docstring +# documentation blocks is shown as doxygen documentation. +# The default value is: YES. + +PYTHON_DOCSTRING = YES + +# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the +# documentation from any documented member that it re-implements. +# The default value is: YES. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new +# page for each member. If set to NO, the documentation of a member will be part +# of the file/class/namespace that contains it. +# The default value is: NO. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen +# uses this value to replace tabs by spaces in code fragments. +# Minimum value: 1, maximum value: 16, default value: 4. + +TAB_SIZE = 4 + +# This tag can be used to specify a number of aliases that act as commands in +# the documentation. An alias has the form: +# name=value +# For example adding +# "sideeffect=@par Side Effects:\n" +# will allow you to put the command \sideeffect (or @sideeffect) in the +# documentation, which will result in a user-defined paragraph with heading +# "Side Effects:". You can put \n's in the value part of an alias to insert +# newlines (in the resulting output). You can put ^^ in the value part of an +# alias to insert a newline as if a physical newline was in the original file. +# When you need a literal { or } or , in the value part of an alias you have to +# escape them by means of a backslash (\), this can lead to conflicts with the +# commands \{ and \} for these it is advised to use the version @{ and @} or use +# a double escape (\\{ and \\}) + +ALIASES = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources +# only. Doxygen will then generate output that is more tailored for C. For +# instance, some of the names that are used will be different. The list of all +# members will be omitted, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_FOR_C = YES + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or +# Python sources only. Doxygen will then generate output that is more tailored +# for that language. For instance, namespaces will be presented as packages, +# qualified scopes will look different, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources. Doxygen will then generate output that is tailored for Fortran. +# The default value is: NO. + +OPTIMIZE_FOR_FORTRAN = YES + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for VHDL. +# The default value is: NO. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice +# sources only. Doxygen will then generate output that is more tailored for that +# language. For instance, namespaces will be presented as modules, types will be +# separated into more groups, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_SLICE = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given +# extension. Doxygen has a built-in mapping, but you can override or extend it +# using this tag. The format is ext=language, where ext is a file extension, and +# language is one of the parsers supported by doxygen: IDL, Java, JavaScript, +# Csharp (C#), C, C++, D, PHP, md (Markdown), Objective-C, Python, Slice, VHDL, +# Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: +# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser +# tries to guess whether the code is fixed or free formatted code, this is the +# default for Fortran type files). For instance to make doxygen treat .inc files +# as Fortran files (default is PHP), and .f files as C (default is Fortran), +# use: inc=Fortran f=C. +# +# Note: For files without extension you can use no_extension as a placeholder. +# +# Note that for custom extensions you also need to set FILE_PATTERNS otherwise +# the files are not read by doxygen. When specifying no_extension you should add +# * to the FILE_PATTERNS. +# +# Note see also the list of default file extension mappings. + +EXTENSION_MAPPING = + +# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments +# according to the Markdown format, which allows for more readable +# documentation. See https://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by doxygen, so you can +# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# case of backward compatibilities issues. +# The default value is: YES. + +MARKDOWN_SUPPORT = YES + +# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up +# to that level are automatically included in the table of contents, even if +# they do not have an id attribute. +# Note: This feature currently applies only to Markdown headings. +# Minimum value: 0, maximum value: 99, default value: 5. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +TOC_INCLUDE_HEADINGS = 5 + +# When enabled doxygen tries to link words that correspond to documented +# classes, or namespaces to their corresponding documentation. Such a link can +# be prevented in individual cases by putting a % sign in front of the word or +# globally by setting AUTOLINK_SUPPORT to NO. +# The default value is: YES. + +AUTOLINK_SUPPORT = YES + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should set this +# tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); +# versus func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. +# The default value is: NO. + +BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. +# The default value is: NO. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: +# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen +# will parse them like normal C++ but will assume all classes use public instead +# of private inheritance when no explicit protection keyword is present. +# The default value is: NO. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate +# getter and setter methods for a property. Setting this option to YES will make +# doxygen to replace the get and set methods by a property in the documentation. +# This will only work if the methods are indeed getting or setting a simple +# type. If this is not the case, or you want to show the methods anyway, you +# should set this option to NO. +# The default value is: YES. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. +# The default value is: NO. + +DISTRIBUTE_GROUP_DOC = YES + +# If one adds a struct or class to a group and this option is enabled, then also +# any nested class or struct is added to the same group. By default this option +# is disabled and one has to add nested compounds explicitly via \ingroup. +# The default value is: NO. + +GROUP_NESTED_COMPOUNDS = NO + +# Set the SUBGROUPING tag to YES to allow class member groups of the same type +# (for instance a group of public functions) to be put as a subgroup of that +# type (e.g. under the Public Functions section). Set it to NO to prevent +# subgrouping. Alternatively, this can be done per class using the +# \nosubgrouping command. +# The default value is: YES. + +SUBGROUPING = YES + +# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions +# are shown inside the group in which they are included (e.g. using \ingroup) +# instead of on a separate page (for HTML and Man pages) or section (for LaTeX +# and RTF). +# +# Note that this feature does not work in combination with +# SEPARATE_MEMBER_PAGES. +# The default value is: NO. + +INLINE_GROUPED_CLASSES = YES + +# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions +# with only public data fields or simple typedef fields will be shown inline in +# the documentation of the scope in which they are defined (i.e. file, +# namespace, or group documentation), provided this scope is documented. If set +# to NO, structs, classes, and unions are shown on a separate page (for HTML and +# Man pages) or section (for LaTeX and RTF). +# The default value is: NO. + +INLINE_SIMPLE_STRUCTS = YES + +# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or +# enum is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically be +# useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. +# The default value is: NO. + +TYPEDEF_HIDES_STRUCT = NO + +# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This +# cache is used to resolve symbols given their name and scope. Since this can be +# an expensive process and often the same symbol appears multiple times in the +# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# doxygen will become slower. If the cache is too large, memory is wasted. The +# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range +# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# symbols. At the end of a run doxygen will report the cache usage and suggest +# the optimal cache size from a speed point of view. +# Minimum value: 0, maximum value: 9, default value: 0. + +LOOKUP_CACHE_SIZE = 0 + +# The NUM_PROC_THREADS specifies the number threads doxygen is allowed to use +# during processing. When set to 0 doxygen will based this on the number of +# cores available in the system. You can set it explicitly to a value larger +# than 0 to get more control over the balance between CPU load and processing +# speed. At this moment only the input processing can be done using multiple +# threads. Since this is still an experimental feature the default is set to 1, +# which efficively disables parallel processing. Please report any issues you +# encounter. Generating dot graphs in parallel is controlled by the +# DOT_NUM_THREADS setting. +# Minimum value: 0, maximum value: 32, default value: 1. + +NUM_PROC_THREADS = 1 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in +# documentation are documented, even if no documentation was available. Private +# class members and static file members will be hidden unless the +# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. +# Note: This will also disable the warnings about undocumented members that are +# normally produced when WARNINGS is set to YES. +# The default value is: NO. + +EXTRACT_ALL = NO + +# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will +# be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIVATE = YES + +# If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual +# methods of a class will be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIV_VIRTUAL = NO + +# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal +# scope will be included in the documentation. +# The default value is: NO. + +EXTRACT_PACKAGE = YES + +# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be +# included in the documentation. +# The default value is: NO. + +EXTRACT_STATIC = YES + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined +# locally in source files will be included in the documentation. If set to NO, +# only classes defined in header files are included. Does not have any effect +# for Java sources. +# The default value is: YES. + +EXTRACT_LOCAL_CLASSES = NO + +# This flag is only useful for Objective-C code. If set to YES, local methods, +# which are defined in the implementation section but not in the interface are +# included in the documentation. If set to NO, only methods in the interface are +# included. +# The default value is: NO. + +EXTRACT_LOCAL_METHODS = NO + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base name of +# the file that contains the anonymous namespace. By default anonymous namespace +# are hidden. +# The default value is: NO. + +EXTRACT_ANON_NSPACES = YES + +# If this flag is set to YES, the name of an unnamed parameter in a declaration +# will be determined by the corresponding definition. By default unnamed +# parameters remain unnamed in the output. +# The default value is: YES. + +RESOLVE_UNNAMED_PARAMS = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all +# undocumented members inside documented classes or files. If set to NO these +# members will be included in the various overviews, but no documentation +# section is generated. This option has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. If set +# to NO, these classes will be included in the various overviews. This option +# has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend +# declarations. If set to NO, these declarations will be included in the +# documentation. +# The default value is: NO. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any +# documentation blocks found inside the body of a function. If set to NO, these +# blocks will be appended to the function's detailed documentation block. +# The default value is: NO. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation that is typed after a +# \internal command is included. If the tag is set to NO then the documentation +# will be excluded. Set it to YES to include the internal documentation. +# The default value is: NO. + +INTERNAL_DOCS = NO + +# With the correct setting of option CASE_SENSE_NAMES doxygen will better be +# able to match the capabilities of the underlying filesystem. In case the +# filesystem is case sensitive (i.e. it supports files in the same directory +# whose names only differ in casing), the option must be set to YES to properly +# deal with such files in case they appear in the input. For filesystems that +# are not case sensitive the option should be be set to NO to properly deal with +# output files written for symbols that only differ in casing, such as for two +# classes, one named CLASS and the other named Class, and to also support +# references to files without having to specify the exact matching casing. On +# Windows (including Cygwin) and MacOS, users should typically set this option +# to NO, whereas on Linux or other Unix flavors it should typically be set to +# YES. +# The default value is: system dependent. + +CASE_SENSE_NAMES = YES + +# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with +# their full class and namespace scopes in the documentation. If set to YES, the +# scope will be hidden. +# The default value is: NO. + +HIDE_SCOPE_NAMES = NO + +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will +# append additional text to a page's title, such as Class Reference. If set to +# YES the compound reference will be hidden. +# The default value is: NO. + +HIDE_COMPOUND_REFERENCE= NO + +# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of +# the files that are included by a file in the documentation of that file. +# The default value is: YES. + +SHOW_INCLUDE_FILES = YES + +# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each +# grouped member an include statement to the documentation, telling the reader +# which file to include in order to use the member. +# The default value is: NO. + +SHOW_GROUPED_MEMB_INC = NO + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include +# files with double quotes in the documentation rather than with sharp brackets. +# The default value is: NO. + +FORCE_LOCAL_INCLUDES = YES + +# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the +# documentation for inline members. +# The default value is: YES. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the +# (detailed) documentation of file and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. +# The default value is: YES. + +SORT_MEMBER_DOCS = YES + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief +# descriptions of file, namespace and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. Note that +# this will also influence the order of the classes in the class list. +# The default value is: NO. + +SORT_BRIEF_DOCS = YES + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the +# (brief and detailed) documentation of class members so that constructors and +# destructors are listed first. If set to NO the constructors will appear in the +# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. +# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief +# member documentation. +# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting +# detailed member documentation. +# The default value is: NO. + +SORT_MEMBERS_CTORS_1ST = YES + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy +# of group names into alphabetical order. If set to NO the group names will +# appear in their defined order. +# The default value is: NO. + +SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by +# fully-qualified names, including namespaces. If set to NO, the class list will +# be sorted only by class name, not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the alphabetical +# list. +# The default value is: NO. + +SORT_BY_SCOPE_NAME = NO + +# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper +# type resolution of all parameters of a function it will reject a match between +# the prototype and the implementation of a member function even if there is +# only one candidate or it is obvious which candidate to choose by doing a +# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still +# accept a match between prototype and implementation in such cases. +# The default value is: NO. + +STRICT_PROTO_MATCHING = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo +# list. This list is created by putting \todo commands in the documentation. +# The default value is: YES. + +GENERATE_TODOLIST = NO + +# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test +# list. This list is created by putting \test commands in the documentation. +# The default value is: YES. + +GENERATE_TESTLIST = NO + +# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug +# list. This list is created by putting \bug commands in the documentation. +# The default value is: YES. + +GENERATE_BUGLIST = NO + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) +# the deprecated list. This list is created by putting \deprecated commands in +# the documentation. +# The default value is: YES. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional documentation +# sections, marked by \if ... \endif and \cond +# ... \endcond blocks. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the +# initial value of a variable or macro / define can have for it to appear in the +# documentation. If the initializer consists of more lines than specified here +# it will be hidden. Use a value of 0 to hide initializers completely. The +# appearance of the value of individual variables and macros / defines can be +# controlled using \showinitializer or \hideinitializer command in the +# documentation regardless of this setting. +# Minimum value: 0, maximum value: 10000, default value: 30. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at +# the bottom of the documentation of classes and structs. If set to YES, the +# list will mention the files that were used to generate the documentation. +# The default value is: YES. + +SHOW_USED_FILES = YES + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This +# will remove the Files entry from the Quick Index and from the Folder Tree View +# (if specified). +# The default value is: YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces +# page. This will remove the Namespaces entry from the Quick Index and from the +# Folder Tree View (if specified). +# The default value is: YES. + +SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command command input-file, where command is the value of the +# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided +# by doxygen. Whatever the program writes to standard output is used as the file +# version. For an example see the documentation. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. To create the layout file +# that represents doxygen's defaults, run doxygen with the -l option. You can +# optionally specify a file name after the option, if omitted DoxygenLayout.xml +# will be used as the name of the layout file. +# +# Note that if you run doxygen from a directory containing a file called +# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE +# tag is left empty. + +LAYOUT_FILE = + +# The CITE_BIB_FILES tag can be used to specify one or more bib files containing +# the reference definitions. This must be a list of .bib files. The .bib +# extension is automatically appended if omitted. This requires the bibtex tool +# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. +# For LaTeX the style of the bibliography can be controlled using +# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the +# search path. See also \cite for info how to create references. + +CITE_BIB_FILES = + +#--------------------------------------------------------------------------- +# Configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated to +# standard output by doxygen. If QUIET is set to YES this implies that the +# messages are off. +# The default value is: NO. + +QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES +# this implies that the warnings are on. +# +# Tip: Turn warnings on while writing the documentation. +# The default value is: YES. + +WARNINGS = YES + +# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate +# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: YES. + +WARN_IF_UNDOCUMENTED = YES + +# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as not documenting some parameters +# in a documented function, or documenting parameters that don't exist or using +# markup commands wrongly. +# The default value is: YES. + +WARN_IF_DOC_ERROR = YES + +# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that +# are documented, but have no documentation for their parameters or return +# value. If set to NO, doxygen will only warn about wrong or incomplete +# parameter documentation, but not about the absence of documentation. If +# EXTRACT_ALL is set to YES then this flag will automatically be disabled. +# The default value is: NO. + +WARN_NO_PARAMDOC = YES + +# If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when +# a warning is encountered. If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS +# then doxygen will continue running as if WARN_AS_ERROR tag is set to NO, but +# at the end of the doxygen process doxygen will return with a non-zero status. +# Possible values are: NO, YES and FAIL_ON_WARNINGS. +# The default value is: NO. + +WARN_AS_ERROR = YES +#WARN_AS_ERROR = NO + +# The WARN_FORMAT tag determines the format of the warning messages that doxygen +# can produce. The string should contain the $file, $line, and $text tags, which +# will be replaced by the file and line number from which the warning originated +# and the warning text. Optionally the format may contain $version, which will +# be replaced by the version of the file (if it could be obtained via +# FILE_VERSION_FILTER) +# The default value is: $file:$line: $text. + +WARN_FORMAT = "$file:$line: $text" + +# The WARN_LOGFILE tag can be used to specify a file to which warning and error +# messages should be written. If left blank the output is written to standard +# error (stderr). + +WARN_LOGFILE = + +#--------------------------------------------------------------------------- +# Configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag is used to specify the files and/or directories that contain +# documented source files. You may enter file names like myfile.cpp or +# directories like /usr/src/myproject. Separate the files or directories with +# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING +# Note: If this tag is empty the current directory is searched. + +INPUT = @abs_top_srcdir@/sorc/cpld_gridgen.fd/docs/user_guide.md \ + @abs_top_srcdir@/sorc/cpld_gridgen.fd + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses +# libiconv (or the iconv built into libc) for the transcoding. See the libiconv +# documentation (see: +# https://www.gnu.org/software/libiconv/) for the list of possible encodings. +# The default value is: UTF-8. + +INPUT_ENCODING = UTF-8 + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and +# *.h) to filter out the source-files in the directories. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# read by doxygen. +# +# Note the list of default checked file patterns might differ from the list of +# default file extension mappings. +# +# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, +# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, +# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, +# *.m, *.markdown, *.md, *.mm, *.dox (to be provided as doxygen C comment), +# *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, *.f18, *.f, *.for, *.vhd, *.vhdl, +# *.ucf, *.qsf and *.ice. + +FILE_PATTERNS = *.F90 \ + *.f90 \ + *.f \ + *.F \ + *.h \ + *.c \ + *.md \ + *.inc + +# The RECURSIVE tag can be used to specify whether or not subdirectories should +# be searched for input files as well. +# The default value is: NO. + +RECURSIVE = YES + +# The EXCLUDE tag can be used to specify files and/or directories that should be +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. +# +# Note that relative paths are relative to the directory from which doxygen is +# run. + +EXCLUDE = ../../fre-nctools.fd + +# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or +# directories that are symbolic links (a Unix file system feature) are excluded +# from the input. +# The default value is: NO. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories for example use the pattern */test/* + +EXCLUDE_PATTERNS = + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# AClass::ANamespace, ANamespace::*Test +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories use the pattern */test/* + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or directories +# that contain example code fragments that are included (see the \include +# command). + +EXAMPLE_PATH = + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank all +# files are included. + +EXAMPLE_PATTERNS = + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude commands +# irrespective of the value of the RECURSIVE tag. +# The default value is: NO. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or directories +# that contain images that are to be included in the documentation (see the +# \image command). + +IMAGE_PATH = + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command: +# +# +# +# where is the value of the INPUT_FILTER tag, and is the +# name of an input file. Doxygen will then use the output that the filter +# program writes to standard output. If FILTER_PATTERNS is specified, this tag +# will be ignored. +# +# Note that the filter must not add or remove lines; it is applied before the +# code is scanned, but not when the output code is generated. If lines are added +# or removed, the anchors will not be placed correctly. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: pattern=filter +# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how +# filters are used. If the FILTER_PATTERNS tag is empty or if none of the +# patterns match the file name, INPUT_FILTER is applied. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will also be used to filter the input files that are used for +# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). +# The default value is: NO. + +FILTER_SOURCE_FILES = NO + +# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file +# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and +# it is also possible to disable source filtering for a specific pattern using +# *.ext= (so without naming a filter). +# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. + +FILTER_SOURCE_PATTERNS = + +# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that +# is part of the input, its contents will be placed on the main page +# (index.html). This can be useful if you have a project on for instance GitHub +# and want to reuse the introduction page also for the doxygen output. + +USE_MDFILE_AS_MAINPAGE = user_guide.md + +#--------------------------------------------------------------------------- +# Configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will be +# generated. Documented entities will be cross-referenced with these sources. +# +# Note: To get rid of all source code in the generated output, make sure that +# also VERBATIM_HEADERS is set to NO. +# The default value is: NO. + +SOURCE_BROWSER = YES + +# Setting the INLINE_SOURCES tag to YES will include the body of functions, +# classes and enums directly into the documentation. +# The default value is: NO. + +INLINE_SOURCES = NO + +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any +# special comment blocks from generated source code fragments. Normal C, C++ and +# Fortran comments will always remain visible. +# The default value is: YES. + +STRIP_CODE_COMMENTS = YES + +# If the REFERENCED_BY_RELATION tag is set to YES then for each documented +# entity all documented functions referencing it will be listed. +# The default value is: NO. + +REFERENCED_BY_RELATION = YES + +# If the REFERENCES_RELATION tag is set to YES then for each documented function +# all documented entities called/used by that function will be listed. +# The default value is: NO. + +REFERENCES_RELATION = YES + +# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set +# to YES then the hyperlinks from functions in REFERENCES_RELATION and +# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will +# link to the documentation. +# The default value is: YES. + +REFERENCES_LINK_SOURCE = YES + +# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the +# source code will show a tooltip with additional information such as prototype, +# brief description and links to the definition and documentation. Since this +# will make the HTML file larger and loading of large files a bit slower, you +# can opt to disable this feature. +# The default value is: YES. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +SOURCE_TOOLTIPS = YES + +# If the USE_HTAGS tag is set to YES then the references to source code will +# point to the HTML generated by the htags(1) tool instead of doxygen built-in +# source browser. The htags tool is part of GNU's global source tagging system +# (see https://www.gnu.org/software/global/global.html). You will need version +# 4.8.6 or higher. +# +# To use it do the following: +# - Install the latest version of global +# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file +# - Make sure the INPUT points to the root of the source tree +# - Run doxygen as normal +# +# Doxygen will invoke htags (and that will in turn invoke gtags), so these +# tools must be available from the command line (i.e. in the search path). +# +# The result: instead of the source browser generated by doxygen, the links to +# source code will now point to the output of htags. +# The default value is: NO. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a +# verbatim copy of the header file for each class for which an include is +# specified. Set to NO to disable this. +# See also: Section \class. +# The default value is: YES. + +VERBATIM_HEADERS = YES + +#--------------------------------------------------------------------------- +# Configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all +# compounds will be generated. Enable this if the project contains a lot of +# classes, structs, unions or interfaces. +# The default value is: YES. + +ALPHABETICAL_INDEX = NO + +# In case all classes in a project start with a common prefix, all classes will +# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag +# can be used to specify a prefix (or a list of prefixes) that should be ignored +# while generating the index headers. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output +# The default value is: YES. + +GENERATE_HTML = YES + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a +# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of +# it. +# The default directory is: html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_OUTPUT = . + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each +# generated HTML page (for example: .htm, .php, .asp). +# The default value is: .html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a user-defined HTML header file for +# each generated HTML page. If the tag is left blank doxygen will generate a +# standard header. +# +# To get valid HTML the header file that includes any scripts and style sheets +# that doxygen needs, which is dependent on the configuration options used (e.g. +# the setting GENERATE_TREEVIEW). It is highly recommended to start with a +# default header using +# doxygen -w html new_header.html new_footer.html new_stylesheet.css +# YourConfigFile +# and then modify the file new_header.html. See also section "Doxygen usage" +# for information on how to generate the default header that doxygen normally +# uses. +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of doxygen. For a description +# of the possible markers and block names see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_HEADER = + +# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each +# generated HTML page. If the tag is left blank doxygen will generate a standard +# footer. See HTML_HEADER for more information on how to generate a default +# footer and what special commands can be used inside the footer. See also +# section "Doxygen usage" for information on how to generate the default footer +# that doxygen normally uses. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FOOTER = + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style +# sheet that is used by each HTML page. It can be used to fine-tune the look of +# the HTML output. If left blank doxygen will generate a default style sheet. +# See also section "Doxygen usage" for information on how to generate the style +# sheet that doxygen normally uses. +# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as +# it is more robust and this tag (HTML_STYLESHEET) will in the future become +# obsolete. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_STYLESHEET = + +# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined +# cascading style sheets that are included after the standard style sheets +# created by doxygen. Using this option one can overrule certain style aspects. +# This is preferred over using HTML_STYLESHEET since it does not replace the +# standard style sheet and is therefore more robust against future updates. +# Doxygen will copy the style sheet files to the output directory. +# Note: The order of the extra style sheet files is of importance (e.g. the last +# style sheet in the list overrules the setting of the previous ones in the +# list). For an example see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_STYLESHEET = + +# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the HTML output directory. Note +# that these files will be copied to the base HTML output directory. Use the +# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these +# files. In the HTML_STYLESHEET file, use the file name only. Also note that the +# files will be copied as-is; there are no commands or markers available. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_FILES = + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen +# will adjust the colors in the style sheet and background images according to +# this color. Hue is specified as an angle on a colorwheel, see +# https://en.wikipedia.org/wiki/Hue for more information. For instance the value +# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 +# purple, and 360 is red again. +# Minimum value: 0, maximum value: 359, default value: 220. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_HUE = 220 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors +# in the HTML output. For a value of 0 the output will use grayscales only. A +# value of 255 will produce the most vivid colors. +# Minimum value: 0, maximum value: 255, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_SAT = 100 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the +# luminance component of the colors in the HTML output. Values below 100 +# gradually make the output lighter, whereas values above 100 make the output +# darker. The value divided by 100 is the actual gamma applied, so 80 represents +# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not +# change the gamma. +# Minimum value: 40, maximum value: 240, default value: 80. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_GAMMA = 80 + +# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML +# page will contain the date and time when the page was generated. Setting this +# to YES can help to show when doxygen was last run and thus if the +# documentation is up to date. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_TIMESTAMP = NO + +# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML +# documentation will contain a main index with vertical navigation menus that +# are dynamically created via JavaScript. If disabled, the navigation index will +# consists of multiple levels of tabs that are statically embedded in every HTML +# page. Disable this option to support browsers that do not have JavaScript, +# like the Qt help browser. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_MENUS = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_SECTIONS = NO + +# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries +# shown in the various tree structured indices initially; the user can expand +# and collapse entries dynamically later on. Doxygen will expand the tree to +# such a level that at most the specified number of entries are visible (unless +# a fully collapsed tree already exceeds this amount). So setting the number of +# entries 1 will produce a full collapsed tree by default. 0 is a special value +# representing an infinite number of entries and will result in a full expanded +# tree by default. +# Minimum value: 0, maximum value: 9999, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_INDEX_NUM_ENTRIES = 100 + +# If the GENERATE_DOCSET tag is set to YES, additional index files will be +# generated that can be used as input for Apple's Xcode 3 integrated development +# environment (see: +# https://developer.apple.com/xcode/), introduced with OSX 10.5 (Leopard). To +# create a documentation set, doxygen will generate a Makefile in the HTML +# output directory. Running make will produce the docset in that directory and +# running make install will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at +# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy +# genXcode/_index.html for more information. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_DOCSET = NO + +# This tag determines the name of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# The default value is: Doxygen generated docs. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# This tag specifies a string that should uniquely identify the documentation +# set bundle. This should be a reverse domain-name style string, e.g. +# com.mycompany.MyDocSet. Doxygen will append .docset to the name. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. +# The default value is: org.doxygen.Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. +# The default value is: Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three +# additional HTML index files: index.hhp, index.hhc, and index.hhk. The +# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop +# (see: +# https://www.microsoft.com/en-us/download/details.aspx?id=21138) on Windows. +# +# The HTML Help Workshop contains a compiler that can convert all HTML output +# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML +# files are now used as the Windows 98 help format, and will replace the old +# Windows help format (.hlp) on all Windows platforms in the future. Compressed +# HTML files also contain an index, a table of contents, and you can search for +# words in the documentation. The HTML workshop also contains a viewer for +# compressed HTML files. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_HTMLHELP = NO + +# The CHM_FILE tag can be used to specify the file name of the resulting .chm +# file. You can add a path in front of the file if the result should not be +# written to the html output directory. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_FILE = + +# The HHC_LOCATION tag can be used to specify the location (absolute path +# including file name) of the HTML help compiler (hhc.exe). If non-empty, +# doxygen will try to run the HTML help compiler on the generated index.hhp. +# The file has to be specified with full path. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +HHC_LOCATION = + +# The GENERATE_CHI flag controls if a separate .chi index file is generated +# (YES) or that it should be included in the main .chm file (NO). +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +GENERATE_CHI = NO + +# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) +# and project file content. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_INDEX_ENCODING = + +# The BINARY_TOC flag controls whether a binary table of contents is generated +# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it +# enables the Previous and Next buttons. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members to +# the table of contents of the HTML help documentation and to the tree view. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that +# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help +# (.qch) of the generated HTML documentation. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify +# the file name of the resulting .qch file. The path specified is relative to +# the HTML output folder. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help +# Project output. For more information please see Qt Help Project / Namespace +# (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_NAMESPACE = org.doxygen.Project + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt +# Help Project output. For more information please see Qt Help Project / Virtual +# Folders (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual-folders). +# The default value is: doc. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_VIRTUAL_FOLDER = doc + +# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom +# filter to add. For more information please see Qt Help Project / Custom +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see Qt Help Project / Custom +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's filter section matches. Qt Help Project / Filter Attributes (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_SECT_FILTER_ATTRS = + +# The QHG_LOCATION tag can be used to specify the location (absolute path +# including file name) of Qt's qhelpgenerator. If non-empty doxygen will try to +# run qhelpgenerator on the generated .qhp file. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be +# generated, together with the HTML files, they form an Eclipse help plugin. To +# install this plugin and make it available under the help contents menu in +# Eclipse, the contents of the directory containing the HTML and XML files needs +# to be copied into the plugins directory of eclipse. The name of the directory +# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. +# After copying Eclipse needs to be restarted before the help appears. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the Eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have this +# name. Each documentation set should have its own identifier. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. + +ECLIPSE_DOC_ID = org.doxygen.Project + +# If you want full control over the layout of the generated HTML pages it might +# be necessary to disable the index and replace it with your own. The +# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top +# of each HTML page. A value of NO enables the index and the value YES disables +# it. Since the tabs in the index contain the same information as the navigation +# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +DISABLE_INDEX = NO + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. If the tag +# value is set to YES, a side panel will be generated containing a tree-like +# index structure (just like the one that is generated for HTML Help). For this +# to work a browser that supports JavaScript, DHTML, CSS and frames is required +# (i.e. any modern browser). Windows users are probably better off using the +# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can +# further fine-tune the look of the index. As an example, the default style +# sheet generated by doxygen has an example that shows how to put an image at +# the root of the tree instead of the PROJECT_NAME. Since the tree basically has +# the same information as the tab index, you could consider setting +# DISABLE_INDEX to YES when enabling this option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_TREEVIEW = YES + +# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that +# doxygen will group on one line in the generated HTML documentation. +# +# Note that a value of 0 will completely suppress the enum values from appearing +# in the overview section. +# Minimum value: 0, maximum value: 20, default value: 4. +# This tag requires that the tag GENERATE_HTML is set to YES. + +ENUM_VALUES_PER_LINE = 4 + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used +# to set the initial width (in pixels) of the frame in which the tree is shown. +# Minimum value: 0, maximum value: 1500, default value: 250. +# This tag requires that the tag GENERATE_HTML is set to YES. + +TREEVIEW_WIDTH = 250 + +# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to +# external symbols imported via tag files in a separate window. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +EXT_LINKS_IN_WINDOW = NO + +# If the HTML_FORMULA_FORMAT option is set to svg, doxygen will use the pdf2svg +# tool (see https://github.com/dawbarton/pdf2svg) or inkscape (see +# https://inkscape.org) to generate formulas as SVG images instead of PNGs for +# the HTML output. These images will generally look nicer at scaled resolutions. +# Possible values are: png (the default) and svg (looks nicer but requires the +# pdf2svg or inkscape tool). +# The default value is: png. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FORMULA_FORMAT = png + +# Use this tag to change the font size of LaTeX formulas included as images in +# the HTML documentation. When you change the font size after a successful +# doxygen run you need to manually remove any form_*.png images from the HTML +# output directory to force them to be regenerated. +# Minimum value: 8, maximum value: 50, default value: 10. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_FONTSIZE = 10 + +# Use the FORMULA_TRANSPARENT tag to determine whether or not the images +# generated for formulas are transparent PNGs. Transparent PNGs are not +# supported properly for IE 6.0, but are supported on all modern browsers. +# +# Note that when changing this option you need to delete any form_*.png files in +# the HTML output directory before the changes have effect. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_TRANSPARENT = YES + +# The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands +# to create new LaTeX commands to be used in formulas as building blocks. See +# the section "Including formulas" for details. + +FORMULA_MACROFILE = + +# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see +# https://www.mathjax.org) which uses client side JavaScript for the rendering +# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX +# installed or if you want to formulas look prettier in the HTML output. When +# enabled you may also need to install MathJax separately and configure the path +# to it using the MATHJAX_RELPATH option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +USE_MATHJAX = NO + +# When MathJax is enabled you can set the default output format to be used for +# the MathJax output. See the MathJax site (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. +# Possible values are: HTML-CSS (which is slower, but has the best +# compatibility), NativeMML (i.e. MathML) and SVG. +# The default value is: HTML-CSS. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_FORMAT = HTML-CSS + +# When MathJax is enabled you need to specify the location relative to the HTML +# output directory using the MATHJAX_RELPATH option. The destination directory +# should contain the MathJax.js script. For instance, if the mathjax directory +# is located at the same level as the HTML output directory, then +# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# Content Delivery Network so you can quickly see the result without installing +# MathJax. However, it is strongly recommended to install a local copy of +# MathJax from https://www.mathjax.org before deployment. +# The default value is: https://cdn.jsdelivr.net/npm/mathjax@2. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_RELPATH = http://cdn.mathjax.org/mathjax/latest + +# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax +# extension names that should be enabled during MathJax rendering. For example +# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_EXTENSIONS = + +# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces +# of code that will be used on startup of the MathJax code. See the MathJax site +# (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. For an +# example see the documentation. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_CODEFILE = + +# When the SEARCHENGINE tag is enabled doxygen will generate a search box for +# the HTML output. The underlying search engine uses javascript and DHTML and +# should work on any modern browser. Note that when using HTML help +# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) +# there is already a search function so this one should typically be disabled. +# For large projects the javascript based search engine can be slow, then +# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to +# search using the keyboard; to jump to the search box use + S +# (what the is depends on the OS and browser, but it is typically +# , /