diff --git a/.github/workflows/data/oro_data.tile1.nc b/.github/workflows/data/oro_data.tile1.nc deleted file mode 100644 index 9405b125..00000000 Binary files a/.github/workflows/data/oro_data.tile1.nc and /dev/null differ diff --git a/.github/workflows/data/oro_data.tile2.nc b/.github/workflows/data/oro_data.tile2.nc deleted file mode 100644 index 444f1d20..00000000 Binary files a/.github/workflows/data/oro_data.tile2.nc and /dev/null differ diff --git a/.github/workflows/data/oro_data.tile3.nc b/.github/workflows/data/oro_data.tile3.nc deleted file mode 100644 index d4c19bc8..00000000 Binary files a/.github/workflows/data/oro_data.tile3.nc and /dev/null differ diff --git a/.github/workflows/data/oro_data.tile4.nc b/.github/workflows/data/oro_data.tile4.nc deleted file mode 100644 index b3d5e5d2..00000000 Binary files a/.github/workflows/data/oro_data.tile4.nc and /dev/null differ diff --git a/.github/workflows/data/oro_data.tile5.nc b/.github/workflows/data/oro_data.tile5.nc deleted file mode 100644 index 6642bf39..00000000 Binary files a/.github/workflows/data/oro_data.tile5.nc and /dev/null differ diff --git a/.github/workflows/data/oro_data.tile6.nc b/.github/workflows/data/oro_data.tile6.nc deleted file mode 100644 index 26a4804e..00000000 Binary files a/.github/workflows/data/oro_data.tile6.nc and /dev/null differ diff --git a/.github/workflows/datm_noahmp.yaml b/.github/workflows/datm_noahmp.yaml index 7ffdfe7a..cd1511fa 100644 --- a/.github/workflows/datm_noahmp.yaml +++ b/.github/workflows/datm_noahmp.yaml @@ -1,4 +1,20 @@ -name: test_datm_lnd +name: Test NUOPC cap + +env: + # default compiler version + compiler: gcc@latest + # default esmf version + esmf_version: 'esmf@develop' + # default test name + test: test_datm_lnd + # set token to access gh command + GH_TOKEN: ${{ github.token }} + # installation location for application + APP_INSTALL_DIR: ${{ github.workspace }}/app + # installation location for dependencies + DEP_INSTALL_DIR: ~/.spack-ci + # option for retention period for artifacts, default is 90 days + ARTIFACTS_RETENTION_PERIOD: 2 on: push: @@ -10,40 +26,86 @@ on: - cron: '0 0 * * MON' - cron: '0 0 * * FRI' workflow_dispatch: - + inputs: + compiler: + description: 'Compiler version like gcc@12.3.0 or gcc@latest (latest available version on runner)' + required: false + type: string + default: 'gcc@latest' + esmf_version: + description: 'ESMF version or tag: esmf@develop, esmf@=8.5.0b23, esmf@git.hconfig_change_equal=8.6.0' + required: false + type: string + default: 'esmf@develop' + test: + description: 'Test that will be run' + required: false + type: string + default: test_datm_lnd + jobs: - latest-stable: - runs-on: ${{ matrix.os }} + set-matrix: + runs-on: ubuntu-latest + + outputs: + matrix: ${{ steps.generate.outputs.matrix }} + + steps: + # generete matrix + - name: Generate Matrix by Listing Compiler and ESMF Packages + id: generate + run: | + # output variables for debugging + echo "INPUT: >${{ inputs.compiler }}< >${{ inputs.esmf_version }}<" + echo "ENV : >${{ env.compiler }}< >${{ env.esmf_version }}<" + + # create matrix JSON file + # compiler + if [ -z "${{ inputs.compiler }}" ]; then + str1="{\"compiler\": [\"${{ env.compiler }}\"]," + else + str1="{\"compiler\": [\"${{ inputs.compiler }}\"]," + fi + # esmf + if [ -z "${{ inputs.esmf_version }}" ]; then + str2="\"esmf\": [\"${{ env.esmf_version }}+external-parallelio\"]," + else + str2="\"esmf\": [\"${{ inputs.esmf_version }}+external-parallelio\"]," + fi + # test + if [ -z "${{ inputs.test }}" ]; then + str3="\"test\": [\"${{ env.test }}\"]}" + else + str3="\"test\": [\"${{ inputs.test }}\"]}" + fi + + # output contect for debugging + echo "matrix=${str1}${str2}${str3}" + + # output for next step + echo "matrix=${str1}${str2}${str3}" >> $GITHUB_OUTPUT + + build: + needs: set-matrix + + runs-on: ubuntu-latest strategy: - fail-fast: false - matrix: - os: [ubuntu-22.04] - test: [test_datm_lnd] - esmf: [8.4.2] - - env: - # set token to access gh command - GH_TOKEN: ${{ github.token }} - # installation location for application - APP_INSTALL_DIR: ${{ github.workspace }}/app - # installation location for dependencies - DEP_INSTALL_DIR: ~/.spack-ci - # option for retention period for artifacts, default is 90 days - ARTIFACTS_RETENTION_PERIOD: 2 + matrix: ${{ fromJson(needs.set-matrix.outputs.matrix) }} steps: # test component - name: Test Component - uses: esmf-org/nuopc-comp-testing@feature/v1.2 + uses: esmf-org/nuopc-comp-testing@feature/v1.3 with: app_install_dir: ${{ env.APP_INSTALL_DIR }} + artifacts_name: artifacts for ${{ matrix.test }} ${{ matrix.compiler }} ${{ matrix.esmf }} artifacts_files: | ${{ env.APP_INSTALL_DIR }}/run/PET* ${{ env.APP_INSTALL_DIR }}/run/*.txt ${{ env.APP_INSTALL_DIR }}/run/*.log ${{ env.APP_INSTALL_DIR }}/run/comp.test.lnd.out.2000-01-01-75600.* - baseline_files: | + baseline_files: | ${{ env.APP_INSTALL_DIR }}/run/comp.test.*.nc cache_input_file_list: | ${{ env.APP_INSTALL_DIR }}/run/INPUT @@ -56,14 +118,13 @@ jobs: cd ${{ env.APP_INSTALL_DIR }}/noahmp mkdir build cd build - cmake -DCMAKE_INSTALL_PREFIX=${{ env.APP_INSTALL_DIR }} -DOPENMP=ON ../ + cmake -DCMAKE_INSTALL_PREFIX=${{ env.APP_INSTALL_DIR }} -DCMAKE_Fortran_FLAGS=\"-g -fbacktrace\" ../ make make install - component_module_name: lnd_comp_nuopc + component_module_name: lnd_comp_nuopc.mod data_component_name: datm dependencies: | - fms@2022.04 precision=32,64 - esmf@${{ matrix.esmf }}+external-parallelio + ${{ matrix.esmf }} dependencies_install_dir: ${{ env.DEP_INSTALL_DIR }} mpirun_args: --oversubscribe -np 6 --mca btl_tcp_if_include eth0 test_definition: ${{ env.APP_INSTALL_DIR }}/noahmp/.github/workflows/tests/${{ matrix.test }}.yaml diff --git a/.github/workflows/tests/test_datm_lnd.yaml b/.github/workflows/tests/test_datm_lnd.yaml index fa32dec7..57ce6bfc 100644 --- a/.github/workflows/tests/test_datm_lnd.yaml +++ b/.github/workflows/tests/test_datm_lnd.yaml @@ -1,60 +1,69 @@ --- components: drv: - runseq: - dt: - values: 3600 - lnd-to-atm: - values: remapMethod=bilinear:unmappedaction=ignore:zeroregion=select:srcTermProcessing=0:termOrder:srcseq - atm-to-lnd: - values: remapMethod=bilinear:unmappedaction=ignore:zeroregion=select:srcTermProcessing=0:termOrder:srcseq - atm: - lnd: input: field_table: protocol: wget end_point: 'https://raw.githubusercontent.com' files: - - /ufs-community/ufs-weather-model/develop/tests/parm/fd_nems.yaml + #- /ufs-community/ufs-weather-model/develop/tests/parm/fd_nems.yaml + - /uturuncoglu/ufs-weather-model/feature/noahmp/tests/parm/fd_ufs.yaml + force: True config: - nuopc: - name: esmxRun.config + hconfig: + name: esmxRun.yaml content: - ESMX_attributes: - Verbosity: - values: high - ALLCOMP_attributes: - case_name: - values: comp.test - stop_n: - values: 1 - stop_option: - values: ndays - stop_tod: - values: 0 - stop_ymd: - values: -999 - restart_n: - values: 1 - restart_option: - values: never - restart_ymd: - values: -999 - no_group: - ESMX_component_list: - values: ATM LND - startTime: - values: '2000-01-01T00:00:00' - stopTime: - values: '2000-01-02T00:00:00' - logKindFlag: - values: ESMF_LOGKIND_MULTI - globalResourceControl: - values: .true. - ESMX_log_flush: - values: .true. - ESMX_field_dictionary: - values: fd_nems.yaml + ESMX: + App: + globalResourceControl: + values: 'true' + logKindFlag: + values: ESMF_LOGKIND_Multi + logAppendFlag: + values: 'false' + logFlush: + values: 'true' + fieldDictionary: + values: fd_ufs.yaml + startTime: + values: '2000-01-01T00:00:00' + stopTime: + values: '2000-01-02T00:00:00' + Driver: + componentList: + values: + - ATM + - LND + attributes: + Verbosity: + values: low + no_group: + runSequence: + values: | + @3600 + LND -> ATM :remapMethod=bilinear:unmappedaction=ignore:zeroregion=select:srcTermProcessing=0:termOrder:srcseq + ATM -> LND :remapMethod=bilinear:unmappedaction=ignore:zeroregion=select:srcTermProcessing=0:termOrder:srcseq + ATM + LND + @ + generalAttributes: + no_group: + case_name: + values: comp.test + stop_n: + values: 1 + stop_option: + values: ndays + stop_tod: + values: 0 + stop_ymd: + values: -999 + restart_n: + values: 1 + restart_option: + values: never + restart_ymd: + values: -999 lnd: test_datm_lnd/lnd.yaml diff --git a/.github/workflows/tests/test_datm_lnd/datm.yaml b/.github/workflows/tests/test_datm_lnd/datm.yaml index fa3a28b4..c4dc06a3 100644 --- a/.github/workflows/tests/test_datm_lnd/datm.yaml +++ b/.github/workflows/tests/test_datm_lnd/datm.yaml @@ -16,60 +16,45 @@ input: - /trunk/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc target_directory: 'INPUT' config: - nuopc1: - name: esmxRun.config + hconfig: + name: esmxRun.yaml content: - no_group: - ATM_model: - values: datm - ATM_petlist: - values: 0-5 - ATM_attributes: - Verbosity: - values: 0 - Diagnostic: - values: 0 - read_restart: - values: .false. - orb_eccen: - values: 1.e36 - orb_iyear: - values: 2000 - orb_iyear_align: - values: 2000 - orb_mode: - values: fixed_year - orb_mvelp: - values: 1.e36 - orb_obliq: - values: 1.e36 - ScalarFieldCount: - values: 3 - ScalarFieldIdxGridNX: - values: 1 - ScalarFieldIdxGridNY: - values: 2 - ScalarFieldIdxNextSwCday: - values: 3 - ScalarFieldName: - values: cpl_scalars - case_name: - values: comp.test - stop_n: - values: 1 - stop_option: - values: ndays - stop_tod: - values: 0 - stop_ymd: - values: -999 - restart_n: - values: 1 - restart_option: - values: never - restart_ymd: - values: -999 - nuopc2: + ATM: + no_group: + model: + values: datm + petlist: + values: 0-5 + attributes: + Verbosity: + values: 0 + Diagnostic: + values: 0 + read_restart: + values: .false. + orb_eccen: + values: 1.e36 + orb_iyear: + values: 2000 + orb_iyear_align: + values: 2000 + orb_mode: + values: fixed_year + orb_mvelp: + values: 1.e36 + orb_obliq: + values: 1.e36 + ScalarFieldCount: + values: 3 + ScalarFieldIdxGridNX: + values: 1 + ScalarFieldIdxGridNY: + values: 2 + ScalarFieldIdxNextSwCday: + values: 3 + ScalarFieldName: + values: cpl_scalars + nuopc: name: datm.streams content: no_group: diff --git a/.github/workflows/tests/test_datm_lnd/lnd.yaml b/.github/workflows/tests/test_datm_lnd/lnd.yaml index 7b5b79f5..5d23020b 100644 --- a/.github/workflows/tests/test_datm_lnd/lnd.yaml +++ b/.github/workflows/tests/test_datm_lnd/lnd.yaml @@ -72,76 +72,67 @@ input: - /esmf-org/noahmp/develop/.github/workflows/data/C96.initial.tile6.nc target_directory: 'INPUT' config: - nuopc: - name: esmxRun.config + hconfig: + name: esmxRun.yaml content: - no_group: - LND_model: - values: noahmp - LND_petlist: - values: 0-5 - LND_attributes: - Verbosity: - values: 0 - Diagnostic: - values: 0 - mosaic_file: - values: INPUT/grid_spec.nc - input_dir: - values: INPUT/ - ic_type: - values: custom - num_soil_levels: - values: 4 - forcing_height: - values: 10 - soil_level_thickness: - values: 0.10:0.30:0.60:1.00 - soil_level_nodes: - values: 0.05:0.25:0.70:1.50 - dynamic_vegetation_option: - values: 4 - canopy_stomatal_resistance_option: - values: 2 - soil_wetness_option: - values: 1 - runoff_option: - values: 1 - surface_exchange_option: - values: 3 - supercooled_soilwater_option: - values: 1 - frozen_soil_adjust_option: - values: 1 - radiative_transfer_option: - values: 3 - snow_albedo_option: - values: 1 - precip_partition_option: - values: 4 - soil_temp_lower_bdy_option: - values: 2 - soil_temp_time_scheme_option: - values: 3 - surface_evap_resistance_option: - values: 1 - glacier_option: - values: 1 - surface_thermal_roughness_option: - values: 2 - output_freq: - values: 10800 - has_export: - values: .false. - nml: - name: input.nml - content: - fms_nml: - clock_grain: - values: "'ROUTINE'" - clock_flags: - values: "'NONE'" - domains_stack_size: - values: 5000000 - stack_size: - values: 0 + LND: + no_group: + model: + values: noahmp + petlist: + values: 0-5 + attributes: + Verbosity: + values: 0 + Diagnostic: + values: 0 + mosaic_file: + values: INPUT/grid_spec.nc + input_dir: + values: INPUT/ + ic_type: + values: custom + layout: + values: "1:1" + num_soil_levels: + values: 4 + forcing_height: + values: 10 + soil_level_thickness: + values: 0.10:0.30:0.60:1.00 + soil_level_nodes: + values: 0.05:0.25:0.70:1.50 + dynamic_vegetation_option: + values: 4 + canopy_stomatal_resistance_option: + values: 2 + soil_wetness_option: + values: 1 + runoff_option: + values: 1 + surface_exchange_option: + values: 3 + supercooled_soilwater_option: + values: 1 + frozen_soil_adjust_option: + values: 1 + radiative_transfer_option: + values: 3 + snow_albedo_option: + values: 1 + precip_partition_option: + values: 4 + soil_temp_lower_bdy_option: + values: 2 + soil_temp_time_scheme_option: + values: 3 + surface_evap_resistance_option: + values: 1 + glacier_option: + values: 1 + surface_thermal_roughness_option: + values: 2 + output_freq: + values: 10800 + has_export: + values: .false. diff --git a/CMakeLists.txt b/CMakeLists.txt index bfba716b..df20602d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -30,16 +30,9 @@ list(APPEND _noahmp_ccpp_files drivers/ccpp/noahmpdrv.F90 list(APPEND _noahmp_files src/module_sf_noahmplsm.F90 src/module_sf_noahmp_glacier.F90) -#------------------------------------------------------------------------------ -# Build options -set(OPENMP OFF CACHE BOOL "Enable OpenMP threading") - #------------------------------------------------------------------------------ # Find dependencies find_package(MPI REQUIRED) -if(OPENMP) - find_package(OpenMP REQUIRED) -endif() find_package(NetCDF REQUIRED) if (TARGET esmf) message("Target esmf is already found. Skip find_package ...") @@ -52,8 +45,20 @@ else() set(CMAKE_Fortran_LINK_FLAGS "${ESMF_F90LINKOPTS} ${ESMF_F90LINKPATHS} ${ESMF_F90LINKRPATHS} ${ESMF_F90ESMFLINKLIBS}") endif() endif() -find_package(FMS REQUIRED COMPONENTS R8) -add_library(fms ALIAS FMS::fms_r8) + +#------------------------------------------------------------------------------ +# Modification for compiler flags +if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -fbacktrace") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fdefault-double-8") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Waliasing -fcray-pointer -fconvert=big-endian -ffree-line-length-none -fno-range-check -fbacktrace") +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -i4 -r8") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fno-alias -auto -safe-cray-ptr -ftz -assume byterecl -sox") +else() + message(WARNING "Fortran compiler with ID ${CMAKE_Fortran_COMPILER_ID} will be used with CMake default options") +endif() #------------------------------------------------------------------------------ # Set CCPP flags for C/C++/Fortran preprocessor @@ -71,19 +76,14 @@ target_link_libraries(noahmp PUBLIC esmf fms) #------------------------------------------------------------------------------ # CMake export for ESMX driver -file(WRITE ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake "add_library(FMS::fms_r8 STATIC IMPORTED)\n") -file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake "set_target_properties(FMS::fms_r8 PROPERTIES\n") -file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake " IMPORTED_LOCATION \"${FMS_R8_LIBRARIES}\"\n") -file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake " INTERFACE_INCLUDE_DIRECTORIES \"${FMS_INSTALL_PREFIX}/include\"\n") -file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake " INTERFACE_LINK_DIRECTORIES \"${FMS_INSTALL_PREFIX}/lib\"\n") -file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake ")\n\n") - +if(EXISTS "${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake") + file(REMOVE ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake) +endif() file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake "add_library(noahmp STATIC IMPORTED)\n") file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake "set_target_properties(noahmp PROPERTIES\n") file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake " IMPORTED_LOCATION \"${CMAKE_INSTALL_PREFIX}/lib/libnoahmp.a\"\n") file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake " INTERFACE_INCLUDE_DIRECTORIES \"${CMAKE_INSTALL_PREFIX}/include\"\n") file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake " INTERFACE_LINK_DIRECTORIES \"${CMAKE_INSTALL_PREFIX}/lib\"\n") -file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake " INTERFACE_LINK_LIBRARIES \"noahmp;FMS::fms_r8\"\n") file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake ")\n") file(APPEND ${CMAKE_INSTALL_PREFIX}/lib/cmake/noahmp-esmx.cmake "target_link_libraries(esmx_driver PUBLIC noahmp)\n") diff --git a/drivers/ccpp/noahmp_tables.f90 b/drivers/ccpp/noahmp_tables.f90 index 3b06d7f5..753c8ff2 100644 --- a/drivers/ccpp/noahmp_tables.f90 +++ b/drivers/ccpp/noahmp_tables.f90 @@ -484,6 +484,9 @@ subroutine read_mp_table_parameters(errmsg, errflg) sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, & sr2006_smcmax_b + errmsg = '' + errflg = 0 + ! initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything. ! vegetation parameters isurban_table = -99999 @@ -783,7 +786,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if ( ierr /= 0 ) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -914,7 +917,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if ( ierr /= 0 ) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -957,7 +960,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if ( ierr /= 0 ) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -982,7 +985,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1011,7 +1014,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1069,7 +1072,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1096,7 +1099,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1249,7 +1252,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1278,7 +1281,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') diff --git a/drivers/ccpp/noahmpdrv.F90 b/drivers/ccpp/noahmpdrv.F90 index 4500d51a..6aff5066 100644 --- a/drivers/ccpp/noahmpdrv.F90 +++ b/drivers/ccpp/noahmpdrv.F90 @@ -136,7 +136,7 @@ subroutine noahmpdrv_run & iopt_trs,iopt_diag,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, rhonewsn1,& con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, & + con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm,& ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & @@ -310,6 +310,9 @@ subroutine noahmpdrv_run & logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + logical , intent(in) :: cpllnd ! Flag for land coupling (atm->lnd) + logical , intent(in) :: cpllnd2atm ! Flag for land coupling (lnd->atm) + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] @@ -450,7 +453,7 @@ subroutine noahmpdrv_run & integer :: iopt_pedo = 1 ! option for pedotransfer function integer :: iopt_crop = 0 ! option for crop model integer :: iopt_gla = 2 ! option for glacier treatment - integer :: iopt_z0m = 2 ! option for z0m treatment + integer :: iopt_z0m = 1 ! option for z0m treatment ! ! --- local inputs to noah-mp and glacier subroutines; listed in order in noah-mp call @@ -684,7 +687,12 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 -do i = 1, im +! +! --- Just return if external land component is activated for two-way interaction +! + if (cpllnd .and. cpllnd2atm) return + + do i = 1, im if (flag_iter(i) .and. dry(i)) then diff --git a/drivers/ccpp/noahmpdrv.meta b/drivers/ccpp/noahmpdrv.meta index 293a3653..39eed149 100644 --- a/drivers/ccpp/noahmpdrv.meta +++ b/drivers/ccpp/noahmpdrv.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = ../../../funcphys.f90,../../../machine.F,../../../sfc_diff.f,../../../set_soilveg.f - dependencies = ../../src/module_sf_noahmp_glacier.f90,../../src/module_sf_noahmplsm.f90,noahmp_tables.f90 + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F + dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 + dependencies = ../Noah/set_soilveg.f ######################################################################## [ccpp-arg-table] @@ -175,6 +176,13 @@ dimensions = (horizontal_loop_extent) type = integer intent= in +[soilcol] + standard_name = soil_color_classification + long_name = soil color at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent= in [vegtype] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell @@ -454,6 +462,13 @@ dimensions = () type = integer intent = in +[iopt_diag] + standard_name = control_for_land_surface_scheme_surface_diagnose_approach + long_name = choice for surface diagnose approach option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in [xlatin] standard_name = latitude long_name = latitude @@ -534,7 +549,7 @@ kind = kind_phys intent = in [rhonewsn1] - standard_name = lwe_density_of_precip_ice + standard_name = surface_frozen_precipitation_density long_name = density of precipitation ice units = kg m-3 dimensions = (horizontal_loop_extent) @@ -620,6 +635,20 @@ dimensions = () type = logical intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land diff --git a/drivers/ccpp/physcons.F90 b/drivers/ccpp/physcons.F90 index e7ec8fb7..4d86301e 100644 --- a/drivers/ccpp/physcons.F90 +++ b/drivers/ccpp/physcons.F90 @@ -33,7 +33,7 @@ !> This module contains some of the most frequently used math and physics !! constants for GCM models. - module physcons + module physcons ! use machine, only: kind_phys, kind_dyn ! @@ -44,7 +44,7 @@ module physcons !> \name Math constants ! real(kind=kind_phys),parameter:: con_pi =3.1415926535897931 !< pi real(kind=kind_phys),parameter:: con_pi =4.0d0*atan(1.0d0) !< pi - real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0_kind_phys !< square root of 2 + real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0_kind_phys !< square root of 2 real(kind=kind_phys),parameter:: con_sqrt3 =1.732051e+0_kind_phys !< quare root of 3 !> \name Geophysics/Astronomy constants @@ -97,6 +97,7 @@ module physcons real(kind=kind_phys),parameter:: con_dldt =con_cvap-con_cliq real(kind=kind_phys),parameter:: con_xpona =-con_dldt/con_rv real(kind=kind_phys),parameter:: con_xponb =-con_dldt/con_rv+con_hvap/(con_rv*con_ttp) + real(kind=kind_phys),parameter:: con_1ovg = 1._kind_phys/con_g !> \name Other Physics/Chemistry constants (source: 2002 CODATA) real(kind=kind_phys),parameter:: con_c =2.99792458e+8_kind_phys !< speed of light (\f$m/s\f$) diff --git a/drivers/ccpp/set_soilveg.f b/drivers/ccpp/set_soilveg.f index 37f2c2a7..35f4ace3 100644 --- a/drivers/ccpp/set_soilveg.f +++ b/drivers/ccpp/set_soilveg.f @@ -44,6 +44,9 @@ subroutine set_soilveg(me,isot,ivet,nlunit,errmsg,errflg) & DEFINED_SLOPE, FXEXP_DATA, NROOT_DATA, REFKDT_DATA, Z0_DATA, & CZIL_DATA, LAI_DATA, CSOIL_DATA + errmsg = '' + errflg = 0 + cmy end locals if(ivet.eq.2) then diff --git a/drivers/ccpp/sfc_diff.f b/drivers/ccpp/sfc_diff.f index 6e834537..c5ed8bfa 100644 --- a/drivers/ccpp/sfc_diff.f +++ b/drivers/ccpp/sfc_diff.f @@ -60,6 +60,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) + & flag_lakefreeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) @@ -90,6 +91,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy + logical, dimension(:), intent(in) :: flag_lakefreeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -168,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i)) then + if(flag_iter(i) .or. flag_lakefreeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 diff --git a/drivers/ccpp/update.sh b/drivers/ccpp/update.sh index ed54b2fa..b5d6ccd1 100755 --- a/drivers/ccpp/update.sh +++ b/drivers/ccpp/update.sh @@ -1,13 +1,24 @@ #!/bin/bash -lst=`ls -al *.[f-F]* | awk '{print $9}'` -for i in $lst -do - cp -f ../../../../FV3/ccpp/physics/physics/$i . - md5sum ../../../../FV3/ccpp/physics/physics/$i $i -done - -cp -f ../../../../FV3/ccpp/physics/physics/module_sf_noahmp_glacier.F90 ../../src/. -md5sum ../../../../FV3/ccpp/physics/physics/module_sf_noahmp_glacier.F90 ../../src/module_sf_noahmp_glacier.F90 -cp -f ../../../../FV3/ccpp/physics/physics/module_sf_noahmplsm.F90 ../../src/. -md5sum ../../../../FV3/ccpp/physics/physics/module_sf_noahmplsm.F90 ../../src/module_sf_noahmplsm.F90 +cp -f ../../../../FV3/ccpp/physics/physics/tools/funcphys.f90 . +md5sum ../../../../FV3/ccpp/physics/physics/tools/funcphys.f90 funcphys.f90 +cp -f ../../../../FV3/ccpp/physics/physics/hooks/machine.F . +md5sum ../../../../FV3/ccpp/physics/physics/hooks/machine.F machine.F +cp -f ../../../../FV3/ccpp/physics/physics/hooks/physcons.F90 . +md5sum ../../../../FV3/ccpp/physics/physics/hooks/physcons.F90 physcons.F90 +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noah/namelist_soilveg.f . +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noah/namelist_soilveg.f namelist_soilveg.f +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noah/set_soilveg.f . +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noah/set_soilveg.f set_soilveg.f +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Layer/UFS/sfc_diff.f . +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Layer/UFS/sfc_diff.f sfc_diff.f +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 . +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 noahmp_tables.f90 +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 . +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 noahmpdrv.F90 +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta . +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta noahmpdrv.meta +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 ../../src/. +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 ../../src/module_sf_noahmp_glacier.F90 +cp -f ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 ../../src/. +md5sum ../../../../FV3/ccpp/physics/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 ../../src/module_sf_noahmplsm.F90 diff --git a/drivers/nuopc/docs/source/BuildingAndRunning.rst b/drivers/nuopc/docs/source/BuildingAndRunning.rst index 70c93e62..9c51b7f8 100644 --- a/drivers/nuopc/docs/source/BuildingAndRunning.rst +++ b/drivers/nuopc/docs/source/BuildingAndRunning.rst @@ -28,16 +28,16 @@ The UFS Weather Model uses the CMake build system. The build system is updated t - Enabled Components - Short Description * - LND - - CDEPS, NOAHMP, CMEPS, and FMS - - Land model forced by GSWP3 data atmosphere + - CDEPS, NOAHMP, CMEPS + - Land model forced by GSWP3 and ERA5 data atmosphere * - ATML - - FV3ATM, NOAHMP, CMEPS, and FMS + - FV3ATM, NOAHMP and CMEPS - Land model forced by active atmosphere (FV3ATM) * - S2SWAL - FV3ATM, MOM6, CICE6, WW3, NOAHMP, FMS, CMEPS - All components used by S2S plus NOAHMP. There is no RT to test this configuration. -To compile the model with land model support, following command can be used for NCAR's Cheyenne. Note that this is using `contol_p8` as an example for CCPP suites. The platform definition can be changed to build model in other platforms such as MSU's Orion but initial implementation is only tested on NCAR's Cheyenne at this point. +To compile the model with land component model support, following command can be used for NCAR's Cheyenne. Note that this is using `contol_p8` as an example for CCPP suites and uses GNU compiler. The platform definition can be changed to build model in other platforms such as MSU's Orion. .. code-block:: console @@ -48,7 +48,7 @@ To compile the model with land model support, following command can be used for Running NoahMP Specific Regression Tests ======================================== -Three new regression test are included to test the external NoahMP land component: +The new regression tests that inclulde NoahMP land component: .. list-table:: List of regression tests :widths: 25 50 @@ -58,17 +58,28 @@ Three new regression test are included to test the external NoahMP land componen - Short Description * - datm_cdeps_lnd_gswp3 - NoahMP forced by the CDEPS "data atmosphere" using Global Soil Wetness Project v3 forcings. 24 hour forecast with 1 hour coupling interval. - * - datm_cdeps_lnd_gswp3_rst - - Restart reproducibility test (compare results with datm_cdeps_lnd_gswp3) + * - datm_cdeps_lnd_era5 + - NoahMP forced by the CDEPS "data atmosphere" using ECMWF's ERA5 ranalysis forcings. 6 hour forecast with 1 hour coupling interval. + * - datm_cdeps_lnd_era5_rst + - Restart reproducibility test (compare results with datm_cdeps_lnd_era5) * - control_p8_atmlnd_sbs - Side-by-side test that forces external land component with active atmosphere in `contol_p8` configuration. This is mainly used to compare land output coming from CCPP/Physics with external NoahMP. In this configuration there is no feedback to active atmosphere. + * - control_p8_atmlnd + - Fully coupled atmosphere-land configuration + * - control_restart_p8_atmlnd + - Restart reproducibility test for fully coupled atmosphere-land configuration (compare results with control_p8_atmlnd). Newly introduced RTs can be run with following command, .. code-block:: console cd tests - ./rt.sh -k -n datm_cdeps_lnd_gswp3_rst + ./rt.sh -k -n datm_cdeps_lnd_gswp3 + +.. code-block:: console + + cd tests + ./rt.sh -k -n datm_cdeps_lnd_era5_rst .. code-block:: console diff --git a/drivers/nuopc/docs/source/ComponentTesting.rst b/drivers/nuopc/docs/source/ComponentTesting.rst index 28fb0ca8..26c8a709 100644 --- a/drivers/nuopc/docs/source/ComponentTesting.rst +++ b/drivers/nuopc/docs/source/ComponentTesting.rst @@ -25,7 +25,7 @@ To create Docker container that will be the foundation of development and testin .. note:: Using container to create test and development environment is optional. The following steps can be used also in other platforms or/and OS in case of lack of depencenies in there. -Then, `spack `_ package manager can be used to install dependencies such as ESMF, FMS. In this case, the content of the `spack.yaml` can be structured as following. Also note that the installadtion directory can be changed through the `config` section of the YAML file. +Then, `spack `_ package manager can be used to install dependencies such as ESMF. In this case, the content of the `spack.yaml` can be structured as following. Also note that the installadtion directory can be changed through the `config` section of the YAML file. .. code-block:: yaml @@ -33,9 +33,8 @@ Then, `spack `_ package manager can be used to install depende concretizer: unify: true specs: - - fms - - esmf@8.4.0b15+parallelio~xerces - - parallelio@2.5.8+pnetcdf~shared + - esmf@8.5.0b17+external-parallelio + - parallelio@2.5.10+pnetcdf~shared view: /root/.spack-ci/view config: source_cache: ~/.spack-ci/source_cache @@ -170,7 +169,8 @@ The NoahMP model uses GitHub Actions (GHA), a GitHub-hosted continuous integrati The GHA-related ``yaml`` script is located in the ``.github/workflows/`` directory. ``datm_noahmp.yaml`` is the main workflow file that aim to run `datm+lnd` configuration. -* `.github/workflows/tests/` directory includes YAML files that will be used to create required configuration files for CDEPS and NoahMP and retrive required input files. -* `.github/workflows/data/` directory includes additional the input files that are not found on the web to retrive. -* `.github/workflows/scripts/` directory includes Python scripts that reads the information from YAML files to create configuration files and retrieve required input files. -* `.github/workflows/spack/` directory includes `spack.yaml` file that is used to insatll dependencies through the use of `spack `_ package manager. +* `.github/workflows/tests/` directory includes YAML file that will be used to create required configuration files for ESMX driver and retrive required input files. +* `.github/workflows/tests/test_datm_lnd/` directory includes YAML files that will be used to create required configuration files for CDEPS and NoahMP and retrive required input files. +* `.github/workflows/data/` directory includes additional the input files (initial conditions) that are not found on the web to retrive. + +The action uses composite action for isolated component testing that can be found in `esmf-org nuopc-comp-testing repository `_. diff --git a/drivers/nuopc/docs/source/DriverAndCoupling.rst b/drivers/nuopc/docs/source/DriverAndCoupling.rst index edef563c..a993c475 100644 --- a/drivers/nuopc/docs/source/DriverAndCoupling.rst +++ b/drivers/nuopc/docs/source/DriverAndCoupling.rst @@ -27,7 +27,7 @@ Within the **drivers/nuopc/** directory, the following files are found, * - lnd_comp_import_export.F90 - Includes subroutines to define import and export states as well as diagnostic code to check the fields in states * - lnd_comp_io.F90 - - Includes subroutines to read in static information and initial conditions from tiled files and writing model output in tiled format. The I/O routines currently using `FMS ` library to access multi-tile files but this will be replaced with ESMF calls in the near future and FMS dependency from NUOPC "cap" will be removed. + - Includes subroutines to read in static information and initial conditions from tiled files and writing model output in tiled format. * - lnd_comp_kind.F90 - Stores parameters that define used kind types etc. * - lnd_comp_nuopc.F90 @@ -56,7 +56,7 @@ The NUOPC "cap" uses set of namelist options provided as ESMF Config file format * - ic_type - Indicates the source of the initial conditions. Two options are supported 'custom' (i.e. C96.initial.tile[1-6].nc) and 'sfc' (default, sfc_data.tile[1-6].nc). * - layout - - Defines decompositions in each direction on each tile (i.e. 3:8 for C96). This needs to be consistent with resolution. If this is missing, then the NUOPC "cap" tries to calculate the tiles using FMS's `mpp_define_layout()` call. + - Defines decompositions in each direction on each tile (i.e. 3:8 for C96). This needs to be consistent with resolution. * - num_soil_levels - Number of soil levels used by NoahMP Land Model (i.e. 4) * - forcing_height @@ -94,7 +94,11 @@ The NUOPC "cap" uses set of namelist options provided as ESMF Config file format * - glacier_option (iopt_gla, Note: this is not used currently and fixed to 2 in `noahmpdrv.F90`) - Options for glacier treatment (1->phase change; 2->simple) * - output_freq - - Options for output frequency in seconds (i.e. 21600 for 6-hourly output, 1 output every coupling time-step and can be used for debugging) + - Option for output frequency in seconds (i.e. 21600 for 6-hourly output, 1 output every coupling time-step and can be used for debugging) + * - restart_freq + - Option for restart frequency in seconds. If it is not provided, it will be same with `output_freq` + * - restart_file + - Option for specifying the restart file (`.tile#.nc` will be added to the given file name). If it is not provided the model specifies the file name internally using current model time and coupling time step. * - do_mynnedmf - Option for MYNN-EDMF (default value is `.false.`) * - do_mynnsfclay @@ -107,6 +111,8 @@ The NUOPC "cap" uses set of namelist options provided as ESMF Config file format - Option for initial surface lw emissivity in fraction (default value is 0.95) * - initial_albedo - Option for initial mean surface albedo (value is default 0.2) + * - calc_snet + - Option for calculating net shortwave radiation using downward component and surface albedo .. note:: ``:`` symbol is used as a seperator for namelist options with multiple values such as `layout`, `soil_level_thickness`. @@ -125,13 +131,13 @@ The current version of the NUOPC "cap" is able to create ESMF grid by reading mo Initialization -------------- -During the `InitializeAdvertise` phase, call is made to `fms_init()` to use `Flexible Modeling System (FMS) `_ for reading and writing cubed-sphere tiled output. In this case, The MPI communicator is pulled in through the ESMF VM object and used by FMS. This phase also calls `advertise_fields()` to setup import and export states. The FMS initialization will be removed once the multi-tile I/O calls is supported by ESMF. +During the `InitializeAdvertise` phase, call is made to `advertise_fields()` to setup import and export states. --- Run --- -During the `ModelAdvance` phase, the `cap` updates the import state and calls NoahMP driver routine (`drv_run`, which is found in `drivers/nuopc/lnd_comp_driver.F90`) to run the model and updates the export state with the information calculated by model. The `drv_run` call mainly read in static information as well as initial conditions when it is first called and interpolate monthly data provided by the static information such as fractional coverage of green vegetation and surface albedo to the date of the simulation. Then calculates solar zenith angle based on the time information extracted from `cap` and calls `noahmpdrv_run` subroutine provided by the NoahMP. This phase also responsible to write NoahMP model output in tiled format by taking advantage of FMS and ESMF routines. +During the `ModelAdvance` phase, the `cap` updates the import state and calls NoahMP driver routine (`drv_run`, which is found in `drivers/nuopc/lnd_comp_driver.F90`) to run the model and updates the export state with the information calculated by model. The `drv_run` call mainly read in static information as well as initial conditions when it is first called and interpolate monthly data provided by the static information such as fractional coverage of green vegetation and surface albedo to the date of the simulation. Then calculates solar zenith angle based on the time information extracted from `cap` and calls `noahmpdrv_run` subroutine provided by the NoahMP. This phase also responsible to write NoahMP model output in tiled format by taking advantage of ESMF I/O multi-tile support. .. note:: : the restart capability is only tested with DATM+NOAHMP configuration. @@ -160,17 +166,17 @@ Model Fields Used for Coupling - m - noahmp%forc%hgt - bottom layer height - - namelist option `forcing_height + - namelist option `forcing_height` * - inst_temp_height_lowest (`Sa_tbot`) - K - noahmp%forc%t1 - bottom layer temperature - - + - * - inst_temp_height_lowest_from_phys (`Sa_ta`) - K - noahmp%forc%t1 - bottom layer temperature - - used under UFS Weather Model, and active atmosphere + - used if coupled with active atmosphere * - inst_temp_height_surface (`Sa_tskn`) - K - noahmp%forc%tskin @@ -185,7 +191,7 @@ Model Fields Used for Coupling - Pa - noahmp%forc%pbot - pressure at lowest model layer - - used under UFS Weather Model, and active atmosphere + - used if coupled with active atmosphere * - inst_pres_height_surface (`Sa_pslv`) - Pa - noahmp%forc%ps @@ -200,7 +206,7 @@ Model Fields Used for Coupling - kg kg-1 - noahmp%forc%q1 - bottom layer specific humidity - - used under UFS Weather Model, and active atmosphere + - used if coupled with active atmosphere * - inst_zonal_wind_height_lowest (`Sa_u`) - m s-1 - noahmp%forc%u1 @@ -211,16 +217,6 @@ Model Fields Used for Coupling - noahmp%forc%v1 - bottom layer meridional wind - - * - inst_zonal_wind_height_lowest_from_phys (`Sa_ua`) - - m s-1 - - noahmp%forc%u1 - - bottom layer zonal wind - - used under UFS Weather Model, and active atmosphere - * - inst_merid_wind_height_lowest_from_phys (`Sa_va`) - - m s-1 - - noahmp%forc%v1 - - bottom layer meridional wind - - used under UFS Weather Model, and active atmosphere * - inst_exner_function_height_lowest (`Sa_exner`) - 1 - noahmp%forc%prslk1 @@ -245,7 +241,7 @@ Model Fields Used for Coupling - W m-2 - noahmp%forc%dlwflx - net SW radiation - - if it is not available, it will be calculated by using `mean_down_sw_flx` and surface albedo + - if it is not available, it will be calculated by using `mean_down_sw_flx` and surface albedo (see `calc_snet` option) * - mean_prec_rate_conv (`Faxa_rainc`) - kg m-2 s-1 - noahmp%forc%tprcpc @@ -276,12 +272,12 @@ Model Fields Used for Coupling - noahmp%forc%snow - total snow precipitation - - * - vfrac + * - Sa_vfrac - 1 - noahmp%forc%vegfrac - areal fractional cover of green vegetation - - * - zorl + * - Sa_zorl - cm - noahmp%forc%zorl - surface roughness @@ -299,10 +295,70 @@ Model Fields Used for Coupling * - Sl_lfrin - 0-1 - noahmp%domain%frac - - land fraction + - land fraction - required by mediator - * - Sl_t + * - Sl_sfrac + - 0-1 + - noahmp%model%sncovr1 + - instantaneous snow area fraction + - + * - Fall_lat + - kg kg-1 m s-1 + - noahmp%model%evap + - mean latent heat flux + - + * - Fall_sen + - kg kg-1 m s-1 + - noahmp%model%hflx + - mean sensible heat flux + - + * - Fall_evap + - W m-2 + - noahmp%model%ep + - mean potential latent heat flux + - + * - Sl_tref - K - noahmp%model%t2mmp - - land surface temperature - - + - instantenous temperature at 2 meters + - + * - Sl_qref + - kg kg-1 + - noahmp%model%q2mp + - instantenous specific humidity at 2 meters + - + * - Sl_q + - kg kg-1 + - noahmp%model%qsurf + - instantenous specific humidity (at lowest model layer) + - + * - Fall_gflx + - W m-2 + - noahmp%model%gflux + - mean upward heat flux (ground) + - + * - Fall_roff + - kg m-2 s-1 + - noahmp%model%runoff + - mean runoff rate (surface) + - + * - Fall_soff + - kg m-2 s-1 + - noahmp%model%drain + - mean runoff rate (sub-surface) + - + * - Sl_cmm + - m s-1 + - noahmp%model%cmm + - instantenous drag wind speed for momentum + - + * - Sl_chh + - kg m-2 s-1 + - noahmp%model%chh + - instantenous drag wind speed for heat and moisture + - + * - Sl_zvfun + - 0-1 + - noahmp%model%zvfun + - instantenous function of roughness length and areal fractional cover of green vegetation + - diff --git a/drivers/nuopc/lnd_comp_domain.F90 b/drivers/nuopc/lnd_comp_domain.F90 index 5ff3e008..92c9be8c 100644 --- a/drivers/nuopc/lnd_comp_domain.F90 +++ b/drivers/nuopc/lnd_comp_domain.F90 @@ -22,22 +22,17 @@ module lnd_comp_domain use ESMF , only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER use ESMF , only : ESMF_RouteHandleDestroy, ESMF_GridGet, ESMF_GridGetCoord use ESMF , only : ESMF_FieldRegridGetArea, ESMF_CoordSys_Flag - use ESMF , only : ESMF_COORDSYS_CART, ESMF_KIND_R8 + use ESMF , only : ESMF_MeshGetFieldBounds, ESMF_COORDSYS_CART, ESMF_KIND_R8 use NUOPC, only : NUOPC_CompAttributeGet + use lnd_comp_kind , only : r4 => shr_kind_r4 use lnd_comp_kind , only : r8 => shr_kind_r8 use lnd_comp_kind , only : cl => shr_kind_cl use lnd_comp_types , only : noahmp_type + use lnd_comp_types , only : field_type use lnd_comp_shr , only : chkerr use lnd_comp_io , only : read_tiled_file - use fms2_io_mod , only : FmsNetcdfFile_t, open_file - use mosaic2_mod , only : get_mosaic_ntiles, get_mosaic_grid_sizes - use mosaic2_mod , only : get_mosaic_contact, get_mosaic_ncontacts - use mpp_mod , only : mpp_root_pe - use mpp_domains_mod, only : mpp_define_mosaic, mpp_domains_init - use mpp_domains_mod, only : mpp_define_layout - implicit none private @@ -65,8 +60,16 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) integer, intent(out) :: rc ! local variables - integer :: n, numOwnedElements, spatialDim, rank + real(r4), target, allocatable :: tmpr4(:) + integer :: n integer :: decomptile(2,6) + integer :: maxIndex(2) + type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) + + type(field_type) :: flds(1) + integer :: numOwnedElements, spatialDim, rank + + integer :: tlb(1), tub(1), tc(1) real(r8), allocatable :: ownedElemCoords(:) integer, allocatable :: vegtype(:) real(ESMF_KIND_R8), pointer :: ptr1d(:) @@ -74,9 +77,7 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) real(ESMF_KIND_R8), pointer :: ptr3d(:,:,:) character(len=CL) :: msg, filename logical :: isPresent, isSet - type(FmsNetcdfFile_t) :: mosaic_fileobj type(ESMF_Field) :: field, farea - type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) type(ESMF_CoordSys_Flag) :: coordSys real(r8), parameter :: con_rerth = 6.3712e+6_r8 character(len=*), parameter :: subname = trim(modName)//':(lnd_set_decomp_and_domain_from_mosaic) ' @@ -86,68 +87,19 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! --------------------- - ! Open mosaic file and query some information - ! --------------------- - - if (.not. open_file(mosaic_fileobj, trim(noahmp%nmlist%mosaic_file), 'read')) then - call ESMF_LogWrite(trim(subname)//'error in opening file '//trim(noahmp%nmlist%mosaic_file), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - - ! query number of tiles - noahmp%domain%ntiles = get_mosaic_ntiles(mosaic_fileobj) - noahmp%domain%global = (noahmp%domain%ntiles > 1) - - ! query domain sizes for each tile - if (.not. allocated(noahmp%domain%nit)) allocate(noahmp%domain%nit(noahmp%domain%ntiles)) - if (.not. allocated(noahmp%domain%njt)) allocate(noahmp%domain%njt(noahmp%domain%ntiles)) - call get_mosaic_grid_sizes(mosaic_fileobj, noahmp%domain%nit, noahmp%domain%njt) - - ! query number of contacts - noahmp%domain%ncontacts = get_mosaic_ncontacts(mosaic_fileobj) - - ! allocate required arrays to create FMS domain from mosaic file - if (.not. allocated(noahmp%domain%tile1)) allocate(noahmp%domain%tile1(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%tile2)) allocate(noahmp%domain%tile2(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%istart1)) allocate(noahmp%domain%istart1(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%iend1)) allocate(noahmp%domain%iend1(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%jstart1)) allocate(noahmp%domain%jstart1(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%jend1)) allocate(noahmp%domain%jend1(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%istart2)) allocate(noahmp%domain%istart2(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%iend2)) allocate(noahmp%domain%iend2(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%jstart2)) allocate(noahmp%domain%jstart2(noahmp%domain%ncontacts)) - if (.not. allocated(noahmp%domain%jend2)) allocate(noahmp%domain%jend2(noahmp%domain%ncontacts)) - - ! query domain related information - call get_mosaic_contact(mosaic_fileobj, noahmp%domain%tile1, noahmp%domain%tile2, & - noahmp%domain%istart1, noahmp%domain%iend1, noahmp%domain%jstart1, noahmp%domain%jend1, & - noahmp%domain%istart2, noahmp%domain%iend2, noahmp%domain%jstart2, noahmp%domain%jend2) - - do n = 1, noahmp%domain%ncontacts - write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' : tile1, tile2 (', n ,') = ', & - noahmp%domain%tile1(n), noahmp%domain%tile2(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart1, iend1, jstart1, jend1 (', n ,') = ', & - noahmp%domain%istart1(n), noahmp%domain%iend1(n), noahmp%domain%jstart1(n), noahmp%domain%jend1(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart2, iend2, jstart2, jend2 (', n ,') = ', & - noahmp%domain%istart2(n), noahmp%domain%iend2(n), noahmp%domain%jstart2(n), noahmp%domain%jend2(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - end do - - ! --------------------- - ! Create FMS domain + ! Set decomposition and decide it is regional or global ! --------------------- - call lnd_domain_create(gcomp, noahmp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + noahmp%domain%global = .true. ! --------------------- ! Create ESMF grid ! --------------------- if (noahmp%domain%global) then + ! set number of tiles + noahmp%domain%ntiles = 6 + ! set decomposition do n = 1, noahmp%domain%ntiles decomptile(1,n) = noahmp%domain%layout(1) @@ -180,6 +132,12 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) end if noahmp%domain%latt(:,:) = ptr2d(:,:) nullify(ptr2d) + + ! query grid resolution (96, 384 etc.) + call ESMF_GridGet(noahmp%domain%grid, 1, ESMF_STAGGERLOC_CENTER, maxIndex=maxIndex, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + noahmp%domain%ni = maxIndex(1) + noahmp%domain%nj = maxIndex(2) else ! TODO: need to define grid for regional application such as HAFS call ESMF_LogWrite(trim(subname)//": "//' number of tile is 1, regional application is not supported!', ESMF_LOGMSG_ERROR) @@ -203,31 +161,45 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! --------------------- - ! Get fraction from orography file + ! Query sizes from mesh ! --------------------- - ! input file name, the tile will be added to it based on the active PET - filename = trim(noahmp%nmlist%input_dir)//'oro_data.tile' - - ! read data to ESMF field - call read_tiled_file(filename, 'land_frac', noahmp, field, numrec=1, rc=rc) + call ESMF_MeshGetFieldBounds(noahmp%domain%mesh, meshloc=ESMF_MESHLOC_ELEMENT, & + totalLBound=tlb, totalUBound=tub, totalCount=tc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! get pointer - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr3d, rc=rc) + noahmp%domain%begl = tlb(1) + noahmp%domain%endl = tub(1) + noahmp%static%im = tc(1) + write(msg, fmt='(A,3I5)') trim(subname)//' : begl, endl, im = ', noahmp%domain%begl, & + noahmp%domain%endl, noahmp%static%im + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + + !---------------------- + ! allocate temporary data structures + !---------------------- + + if (.not. allocated(tmpr4)) then + allocate(tmpr4(noahmp%domain%begl:noahmp%domain%endl)) + tmpr4(:) = 0.0 + end if + + ! --------------------- + ! Get fraction from orography file + ! --------------------- + + ! read field + filename = trim(noahmp%nmlist%input_dir)//'oro_data.tile*.nc' + flds(1)%short_name = 'land_frac' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%domain%begl = lbound(ptr3d, dim=1) - noahmp%domain%endl = ubound(ptr3d, dim=1) - noahmp%static%im = noahmp%domain%endl-noahmp%domain%begl+1 - ! allocate variable and fill it + ! allocate data if (.not. allocated(noahmp%domain%frac)) then allocate(noahmp%domain%frac(noahmp%domain%begl:noahmp%domain%endl)) end if - noahmp%domain%frac(:) = ptr3d(:,1,1) - nullify(ptr3d) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + noahmp%domain%frac = dble(tmpr4) ! --------------------- ! Read one of the static files to get mask information. This will be used to fix @@ -235,17 +207,19 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) ! following link: https://github.com/ufs-community/ufs-weather-model/issues/1423 ! --------------------- - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C',maxval(noahmp%domain%nit), '.vegetation_type.tile' - call read_tiled_file(filename, 'vegetation_type', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr3d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. allocated(vegtype)) allocate(vegtype(noahmp%domain%begl:noahmp%domain%endl)) - vegtype(:) = int(ptr3d(:,1,1)) - nullify(ptr3d) - call ESMF_FieldDestroy(field, rc=rc) + ! read field + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C',noahmp%domain%ni, '.vegetation_type.tile*.nc' + flds(1)%short_name = 'vegetation_type' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! allocate data + if (.not. allocated(vegtype)) then + allocate(vegtype(noahmp%domain%begl:noahmp%domain%endl)) + end if + vegtype(:) = int(tmpr4) + ! --------------------- ! Calculate mask from land-sea fraction ! --------------------- @@ -273,25 +247,18 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) ! Get height from orography file ! --------------------- - ! read data to ESMF field - filename = trim(noahmp%nmlist%input_dir)//'oro_data.tile' - call read_tiled_file(filename, 'orog_raw', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! get pointer - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr3d, rc=rc) + ! read field + filename = trim(noahmp%nmlist%input_dir)//'oro_data.tile*.nc' + flds(1)%short_name = 'orog_raw' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! allocate variable + ! allocate data if (.not. allocated(noahmp%domain%hgt)) then allocate(noahmp%domain%hgt(noahmp%domain%begl:noahmp%domain%endl)) end if - noahmp%domain%hgt(:) = ptr3d(:,1,1) - - ! clean memory - nullify(ptr3d) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + noahmp%domain%hgt = dble(tmpr4) ! --------------------- ! Query cell area @@ -351,115 +318,10 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) ! Clean memory ! --------------------- - call ESMF_FieldDestroy(farea, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (allocated(tmpr4)) deallocate(tmpr4) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine lnd_set_decomp_and_domain_from_mosaic - !=============================================================================== - subroutine lnd_domain_create(gcomp, noahmp, rc) - - ! input/output variables - type(ESMF_GridComp), intent(in) :: gcomp - type(noahmp_type), intent(inout) :: noahmp - integer, intent(inout) :: rc - - ! local variables - type(ESMF_VM) :: vm - integer :: n, npet, npes_per_tile - integer :: halo = 0 - integer :: global_indices(4,6) - integer :: layout2d(2,6) - integer, allocatable :: pe_start(:), pe_end(:) - character(len=cl) :: msg - character(len=*), parameter :: subname=trim(modName)//':(lnd_domain_create) ' - !------------------------------------------------------------------------------- - - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - - ! --------------------- - ! Query components - ! --------------------- - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm=vm, petCount=npet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Initialize domain - !---------------------- - - call mpp_domains_init() - - !---------------------- - ! Create domain - !---------------------- - - ! setup global indices - do n = 1, noahmp%domain%ntiles - global_indices(1,n) = 1 - global_indices(2,n) = noahmp%domain%nit(n) - global_indices(3,n) = 1 - global_indices(4,n) = noahmp%domain%njt(n) - enddo - - ! check total number of PETs - if (mod(npet, noahmp%domain%ntiles) /= 0) then - write(msg, fmt='(A,I5)') trim(subname)//' : nPet should be multiple of 6 to read initial conditions but it is ', npet - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - - ! calculate layout if it is not provided as configuration option - if (noahmp%domain%layout(1) < 0 .and. noahmp%domain%layout(2) < 0) then - npes_per_tile = npet/noahmp%domain%ntiles - call mpp_define_layout(global_indices(:,1), npes_per_tile, noahmp%domain%layout) - end if - - ! set layout and print out debug information - do n = 1, noahmp%domain%ntiles - layout2d(:,n) = noahmp%domain%layout(:) - write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' layout (', n ,') = ', layout2d(1,n), layout2d(2,n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' global_indices (', n,') = ', & - global_indices(1,n), global_indices(2,n), global_indices(3,n), global_indices(4,n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - enddo - - !---------------------- - ! Set pe_start, pe_end - !---------------------- - - allocate(pe_start(noahmp%domain%ntiles)) - allocate(pe_end(noahmp%domain%ntiles)) - do n = 1, noahmp%domain%ntiles - pe_start(n) = mpp_root_pe()+(n-1)*noahmp%domain%layout(1)*noahmp%domain%layout(2) - pe_end(n) = mpp_root_pe()+n*noahmp%domain%layout(1)*noahmp%domain%layout(2)-1 - write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' pe_start, pe_end (', n ,') = ', pe_start(n), pe_end(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - enddo - - call mpp_define_mosaic(global_indices, layout2d, noahmp%domain%mosaic_domain, & - noahmp%domain%ntiles, noahmp%domain%ncontacts, noahmp%domain%tile1, noahmp%domain%tile2, & - noahmp%domain%istart1, noahmp%domain%iend1, noahmp%domain%jstart1, noahmp%domain%jend1, & - noahmp%domain%istart2, noahmp%domain%iend2, noahmp%domain%jstart2, noahmp%domain%jend2, & - pe_start, pe_end, symmetry=.true., whalo=halo, ehalo=halo, shalo=halo, nhalo=halo, & - name='lnd domain') - - !---------------------- - ! Deallocate temporary arrays - !---------------------- - - deallocate(pe_start) - deallocate(pe_end) - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - - end subroutine lnd_domain_create - end module lnd_comp_domain diff --git a/drivers/nuopc/lnd_comp_driver.F90 b/drivers/nuopc/lnd_comp_driver.F90 index 1c92a1d6..7ba04db3 100644 --- a/drivers/nuopc/lnd_comp_driver.F90 +++ b/drivers/nuopc/lnd_comp_driver.F90 @@ -17,9 +17,10 @@ module lnd_comp_driver use lnd_comp_kind , only: cl => shr_kind_cl use lnd_comp_types , only: noahmp_type use lnd_comp_types , only: fldsToLnd, fldsToLnd_num + use lnd_comp_types , only: histflds, restflds use lnd_comp_shr , only: chkerr use lnd_comp_io , only: read_static, read_initial, read_restart - use lnd_comp_io , only: write_mosaic_output + use lnd_comp_io , only: write_tiled_file_init, write_tiled_file use lnd_comp_import_export, only: check_for_connected use sfc_diff , only: stability @@ -42,7 +43,7 @@ module lnd_comp_driver implicit none private - public :: drv_init, drv_run + public :: drv_init, drv_run, drv_finalize !-------------------------------------------------------------------------- ! Private module data @@ -161,11 +162,13 @@ subroutine drv_run(gcomp, noahmp, rc) ! local variables logical, save :: first_time = .true. - integer :: i, is, step + integer :: i, is, localPet integer :: year, month, day, hour, minute, second real(r8) :: now_time - character(len=cl) :: filename + character(len=cl) :: filename, start_time_str, end_time_str logical :: restart_write + logical :: cpllnd = .false. + logical :: cpllnd2atm = .true. type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm @@ -190,6 +193,13 @@ subroutine drv_run(gcomp, noahmp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + !---------------------- + ! Query component + !---------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !---------------------- ! Query clock and set timestep, current time etc. !---------------------- @@ -216,50 +226,99 @@ subroutine drv_run(gcomp, noahmp, rc) ! use coupling time step and internal time step of model call ESMF_TimeIntervalGet(timeStep, s_r8=noahmp%static%delt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! init data structure that will be used to write history files + call write_tiled_file_init(noahmp, 'hist', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! init data structure that will be used to write restart files + call write_tiled_file_init(noahmp, 'rest', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! print out start and stop time for step + call ESMF_TimeGet(currTime, timeString=start_time_str, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currTime+timeStep, timeString=end_time_str, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' advance model: '//trim(start_time_str)//' --> '//trim(end_time_str), ESMF_LOGMSG_INFO) + !---------------------- ! initialize model variables !---------------------- - step = int((currTime-startTime)/timeStep) - if (.not. noahmp%nmlist%restart_run .and. step == 0) then - ! transfer common initial conditions for all configurations - do i = noahmp%domain%begl, noahmp%domain%endl - if (noahmp%domain%mask(i) == 1) then - noahmp%model%weasd(i) = noahmp%init%snow_water_equivalent(i) - noahmp%model%snwdph(i) = noahmp%init%snow_depth(i) - noahmp%model%canopy(i) = noahmp%init%canopy_water(i) - noahmp%model%tskin(i) = noahmp%init%skin_temperature(i) - noahmp%model%stc(i,:) = noahmp%init%soil_temperature(i,:) - noahmp%model%smc(i,:) = noahmp%init%soil_moisture(i,:) - noahmp%model%slc(i,:) = noahmp%init%soil_liquid(i,:) + if (first_time) then + if (.not. noahmp%nmlist%restart_run) then + ! transfer common initial conditions for all configurations + do i = noahmp%domain%begl, noahmp%domain%endl + if (noahmp%domain%mask(i) == 1) then + noahmp%model%weasd(i) = noahmp%init%snow_water_equivalent(i) + noahmp%model%snwdph(i) = noahmp%init%snow_depth(i) + noahmp%model%canopy(i) = noahmp%init%canopy_water(i) + noahmp%model%tskin(i) = noahmp%init%skin_temperature(i) + noahmp%model%stc(i,:) = noahmp%init%soil_temperature(i,:) + noahmp%model%smc(i,:) = noahmp%init%soil_moisture(i,:) + noahmp%model%slc(i,:) = noahmp%init%soil_liquid(i,:) + end if + end do + + ! transfer custom initial conditions based on selected configuration + if (trim(noahmp%nmlist%ic_type) == 'sfc') then + where(noahmp%domain%mask(:) == 1) + noahmp%model%zorl(:) = noahmp%init%surface_roughness(:) + noahmp%model%ustar1(:) = noahmp%init%friction_velocity(:) + end where + else if (trim(noahmp%nmlist%ic_type) == 'custom') then + ! get initial value of zorl from pre-defined table + where(noahmp%model%vegtype(:) > 0) noahmp%model%zorl(:) = z0_data(noahmp%model%vegtype(:))*100.0_r8 + ! additional unit conversion for datm configuration, noahmp driver requires mm + where(noahmp%domain%mask(:) > 1) noahmp%model%snwdph(:) = noahmp%model%snwdph(:)*1000.0_r8 + + ! following initial values are taken from ufs-land-driver + noahmp%model%pblh = 1000.0_r8 + noahmp%model%rmol1 = 1.0_r8 + noahmp%model%flhc1 = 0.0_r8 + noahmp%model%flqc1 = 0.0_r8 + noahmp%model%ustar1 = 0.1_r8 end if - end do - - ! transfer custom initial conditions based on selected configuration - if (trim(noahmp%nmlist%ic_type) == 'sfc') then - where(noahmp%domain%mask(:) == 1) - noahmp%model%zorl(:) = noahmp%init%surface_roughness(:) - noahmp%model%ustar1(:) = noahmp%init%friction_velocity(:) - end where - else if (trim(noahmp%nmlist%ic_type) == 'custom') then - ! get initial value of zorl from pre-defined table - where(noahmp%model%vegtype(:) > 0) noahmp%model%zorl(:) = z0_data(noahmp%model%vegtype(:))*100.0_r8 - ! additional unit conversion for datm configuration - where(noahmp%domain%mask(:) > 1) noahmp%model%snwdph(:) = noahmp%model%snwdph(:)*1000.0_r8 + + ! initialize model variables + call noahmp%InitializeStates(noahmp%nmlist, noahmp%static, month) end if + end if + + !---------------------- + ! interpolate monthly data, vegetation fraction and mean sfc diffuse sw albedo (NOT used) + !---------------------- - ! initialize model variables - call noahmp%InitializeStates(noahmp%nmlist, noahmp%static, month) + if (check_for_connected(fldsToLnd, fldsToLnd_num, 'Sa_vfrac')) then + where(noahmp%forc%vegfrac(:) < 0.01_r8) + noahmp%model%sigmaf(:) = 0.01_r8 + else where + noahmp%model%sigmaf(:) = noahmp%forc%vegfrac(:) + end where + else + call interpolate_monthly(currTime, noahmp%static%im, & + noahmp%model%gvf_monthly, noahmp%model%sigmaf, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! not used by the model but is set internally in the driver to albedo_total + ! sfalb is also used to calculate snet in datm configurations when calc_snet = T + call interpolate_monthly(currTime, noahmp%static%im, & + noahmp%model%alb_monthly, noahmp%model%sfalb, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !---------------------- ! set internal model variables from forcing !---------------------- ! set forcing height - noahmp%model%zf = noahmp%forc%hgt + if (check_for_connected(fldsToLnd, fldsToLnd_num, 'Sa_z')) then + noahmp%model%zf = noahmp%forc%hgt + else + noahmp%model%zf = noahmp%nmlist%forcing_height + end if ! set net shortwave radiation if (check_for_connected(fldsToLnd, fldsToLnd_num, 'Faxa_swnet')) then @@ -276,12 +335,13 @@ subroutine drv_run(gcomp, noahmp, rc) ! set air pressure at surface adjacent layer ! cdeps provides Sa_pbot but Sa_prsl is used for coupling with fv3 - if (check_for_connected(fldsToLnd, fldsToLnd_num, 'Sa_pbot') .or. & - check_for_connected(fldsToLnd, fldsToLnd_num, 'Sa_prsl')) then - noahmp%model%prsl1 = noahmp%forc%pbot - else - ! calculate it from surface pressure, height and temperature - noahmp%model%prsl1 = noahmp%forc%ps*exp(-1.0_r8*noahmp%model%zf/29.25_r8/noahmp%forc%t1) + ! calculate it from surface pressure, height and temperature + noahmp%model%prsl1 = noahmp%forc%ps*exp(-1.0_r8*noahmp%model%zf/29.25_r8/noahmp%forc%t1) + if (trim(noahmp%nmlist%ic_type) /= 'custom') then + if (check_for_connected(fldsToLnd, fldsToLnd_num, 'Sa_pbot') .or. & + check_for_connected(fldsToLnd, fldsToLnd_num, 'Sa_prsl')) then + noahmp%model%prsl1 = noahmp%forc%pbot + end if end if ! set dimensionless Exner function at surface adjacent layer @@ -291,16 +351,26 @@ subroutine drv_run(gcomp, noahmp, rc) ! calculate it based on bottom pressure noahmp%model%prslk1 = (noahmp%forc%pbot(:)/p0)**cappa ! following is used by ufs-land-driver - !noahmp%model%prslk1 = (exp(noahmp%model%zf/29.25_r8/noahmp%forc%t1))**(2.0_r8/7.0_r8) + if (trim(noahmp%nmlist%ic_type) == 'custom') then + noahmp%model%prslk1 = (exp(noahmp%model%zf/29.25_r8/noahmp%forc%t1))**(2.0_r8/7.0_r8) + end if end if ! set dimensionless Exner function at the ground surface - noahmp%model%prsik1 = (noahmp%forc%ps(:)/p0)**cappa + if (trim(noahmp%nmlist%ic_type) == 'custom') then + ! following is used by ufs-land-driver + noahmp%model%prsik1 = (exp(noahmp%model%zf/29.25_r8/noahmp%forc%t1))**(2.0_r8/7.0_r8) + else + noahmp%model%prsik1 = (noahmp%forc%ps(:)/p0)**cappa + end if ! set Exner function ratio between midlayer and interface - ! following is used by ufs-land-driver - !noahmp%model%prslki = (exp(noahmp%model%zf/29.25_r8/noahmp%forc%t1))**(2.0_r8/7.0_r8) - noahmp%model%prslki(:) = noahmp%model%prsik1(:)/noahmp%model%prslk1(:) + if (trim(noahmp%nmlist%ic_type) == 'custom') then + ! following is used by ufs-land-driver + noahmp%model%prslki = (exp(noahmp%model%zf/29.25_r8/noahmp%forc%t1))**(2.0_r8/7.0_r8) + else + noahmp%model%prslki(:) = noahmp%model%prsik1(:)/noahmp%model%prslk1(:) + end if ! set wind forcing to model internal variables noahmp%model%u1(:) = noahmp%forc%u1(:) @@ -309,7 +379,11 @@ subroutine drv_run(gcomp, noahmp, rc) ! NOTE: CCPP has addtional adjustment in wind speed which could lead to minor difference ! The modification is done in GFS_surface_generic_pre.F90 noahmp%forc%wind(:) = sqrt(noahmp%forc%u1(:)**2+noahmp%forc%v1(:)**2) - noahmp%forc%wind(:) = max(noahmp%forc%wind(:), 1.0_r8) + if (trim(noahmp%nmlist%ic_type) == 'custom') then + noahmp%forc%wind(:) = max(noahmp%forc%wind(:), 0.1_r8) + else + noahmp%forc%wind(:) = max(noahmp%forc%wind(:), 1.0_r8) + end if ! set snow precipitation if (check_for_connected(fldsToLnd, fldsToLnd_num, 'Faxa_snow')) then @@ -337,35 +411,13 @@ subroutine drv_run(gcomp, noahmp, rc) end if if (check_for_connected(fldsToLnd, fldsToLnd_num, 'Faxa_rain')) then noahmp%model%rainn_mp(:) = noahmp%forc%tprcp(:) - end if - - ! convert mm/s to m - noahmp%model%rainn_mp(:) = noahmp%model%rainn_mp(:)*noahmp%static%delt/1000.0_r8 - noahmp%model%rainc_mp(:) = noahmp%model%rainc_mp(:)*noahmp%static%delt/1000.0_r8 - - ! calculate total precipitation - noahmp%model%tprcp(:) = noahmp%model%rainn_mp(:)+noahmp%model%rainc_mp(:) - - !---------------------- - ! interpolate monthly data, vegetation fraction and mean sfc diffuse sw albedo (NOT used) - !---------------------- - - if (check_for_connected(fldsToLnd, fldsToLnd_num, 'vfrac')) then - where(noahmp%forc%vegfrac(:) < 0.01_r8) - noahmp%model%sigmaf(:) = 0.01_r8 - else where - noahmp%model%sigmaf(:) = noahmp%forc%vegfrac(:) - end where + ! convert mm/s to m, it will be converted to mm/s internally in noahmpdrv() call + noahmp%model%tprcp(:) = noahmp%forc%tprcp(:)*noahmp%static%delt/1000.0 else - call interpolate_monthly(currTime, noahmp%static%im, & - noahmp%model%gvf_monthly, noahmp%model%sigmaf, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + noahmp%model%tprcp(:) = noahmp%model%rainn_mp(:)+noahmp%model%rainc_mp(:) + ! convert mm/s to m, it will be converted to mm/s internally in noahmpdrv() call + noahmp%model%tprcp(:) = noahmp%model%tprcp(:)*noahmp%static%delt/1000.0 end if - - ! not used by the model but is set internally in the driver to albedo_total - call interpolate_monthly(currTime, noahmp%static%im, & - noahmp%model%alb_monthly, noahmp%model%sfalb, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- ! calculate solar zenith angle @@ -385,13 +437,6 @@ subroutine drv_run(gcomp, noahmp, rc) noahmp%model%srflag = 0.0_r8 where(noahmp%forc%t1 < tfreeze) noahmp%model%srflag = 1.0_r8 - ! unit conversion for precipitation - ! TODO: do we need for datm coupling? - ! convert mm/s to m - !noahmp%forc%tprcp(:) = noahmp%forc%tprcp(:)*noahmp%static%delt/1000.0_r8 - ! datm - !noahmp%model%rainn_mp = 1000.0_r8*noahmp%forc%tprcp/noahmp%static%delt - ! they are not defined as coupling fields but CCPP provides those fields noahmp%model%graupel_mp = 0.0_r8 noahmp%model%ice_mp = 0.0_r8 @@ -433,7 +478,7 @@ subroutine drv_run(gcomp, noahmp, rc) enddo else ! bexp <= 0.0 noahmp%model%smoiseq(i,:) = smcmax - endif + endif noahmp%model%smcwtdxy(i) = smcmax end if @@ -442,6 +487,7 @@ subroutine drv_run(gcomp, noahmp, rc) !---------------------- ! call stability !---------------------- + do i = noahmp%domain%begl, noahmp%domain%endl if (noahmp%domain%mask(i) == 1 .and. noahmp%model%flag_iter(i)) then ! set initial value for ztmax @@ -539,10 +585,10 @@ subroutine drv_run(gcomp, noahmp, rc) !---------------------- if (first_time) then - write(filename, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5)') & + write(filename, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5,a)') & trim(noahmp%nmlist%case_name)//'.lnd.ini.', & - year, '-', month, '-', day, '-', hour*60*60+minute*60+second - call write_mosaic_output(filename, noahmp, now_time, rc) + year, '-', month, '-', day, '-', hour*60*60+minute*60+second, '.tile*.nc' + call write_tiled_file(filename, noahmp, histflds, now_time, vm, localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return first_time = .false. end if @@ -579,7 +625,7 @@ subroutine drv_run(gcomp, noahmp, rc) con_hvap , con_cp , con_jcal , & rhoh2o , con_eps , con_epsm1 , & con_fvirt , con_rd , con_hfus , & - noahmp%model%thsfc_loc, & + noahmp%model%thsfc_loc, cpllnd , cpllnd2atm , & ! --- in/outs: noahmp%model%weasd , noahmp%model%snwdph , noahmp%model%tskin , & noahmp%model%tprcp , noahmp%model%srflag , noahmp%model%smc , & @@ -615,7 +661,7 @@ subroutine drv_run(gcomp, noahmp, rc) noahmp%model%snohf , noahmp%model%smcwlt2 , noahmp%model%smcref2 , & noahmp%model%wet1 , noahmp%model%t2mmp , noahmp%model%q2mp , & noahmp%model%zvfun , noahmp%model%ztmax , & - noahmp%static%errmsg , noahmp%static%errflg) + noahmp%static%errmsg , noahmp%static%errflg) !---------------------- ! unit conversions @@ -627,7 +673,8 @@ subroutine drv_run(gcomp, noahmp, rc) where(noahmp%forc%dswsfc>0.0_r8 .and. noahmp%model%sfalb<0.0_r8) noahmp%forc%dswsfc = 0.0_r8 !---------------------- - ! write output + ! write output and restart files + ! since component land is called after ccpp/radiation step, use time for one time step ahead !---------------------- ! return date to create file name @@ -641,13 +688,33 @@ subroutine drv_run(gcomp, noahmp, rc) ! check the output frequency before calling write method if (mod(int(now_time), noahmp%nmlist%output_freq) == 0) then - write(filename, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5)') & + write(filename, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5,a)') & trim(noahmp%nmlist%case_name)//'.lnd.out.', & - year, '-', month, '-', day, '-', hour*60*60+minute*60+second - call write_mosaic_output(filename, noahmp, now_time, rc) + year, '-', month, '-', day, '-', hour*60*60+minute*60+second, '.tile*.nc' + call write_tiled_file(filename, noahmp, histflds, now_time, vm, localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! check the restart frequency before calling write method + ! if restart frequency < 0 then skip writing restart file + if (noahmp%nmlist%restart_freq > 0) then + if (mod(int(now_time), noahmp%nmlist%restart_freq) == 0) then + write(filename, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5,a)') & + trim(noahmp%nmlist%case_name)//'.lnd.rst.', & + year, '-', month, '-', day, '-', hour*60*60+minute*60+second, '.tile*.nc' + call write_tiled_file(filename, noahmp, restflds, now_time, vm, localPet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + !---------------------- + ! apply unit conversions after writing the history + ! two way atm-lnd coupling expects units in K m s-1 and kg kg-1 m s-1 not W m-2 + !---------------------- + + noahmp%model%hflx = noahmp%model%hflx/(noahmp%model%rho*con_cp) + noahmp%model%evap = noahmp%model%evap/(noahmp%model%rho*con_hvap) + !---------------------- ! exit if there is an error !---------------------- @@ -665,6 +732,25 @@ subroutine drv_run(gcomp, noahmp, rc) end subroutine drv_run + !=============================================================================== + subroutine drv_finalize(gcomp, noahmp, rc) + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname = trim(modName)//':(drv_finalize) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine drv_finalize + !=============================================================================== subroutine interpolate_monthly(currTime, vector_length, monthly_var, interp_var, rc) diff --git a/drivers/nuopc/lnd_comp_import_export.F90 b/drivers/nuopc/lnd_comp_import_export.F90 index ed462bec..411034a8 100644 --- a/drivers/nuopc/lnd_comp_import_export.F90 +++ b/drivers/nuopc/lnd_comp_import_export.F90 @@ -65,9 +65,23 @@ subroutine advertise_fields(gcomp, rc) ! Advertise export fields !-------------------------------- - ! export to atm + ! export to med call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t') + + ! export to atm + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_sfrac') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_q') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_gflx') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_roff') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_soff') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_cmm') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_chh') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_zvfun') ! Now advertise above export fields do n = 1,fldsFrLnd_num @@ -92,8 +106,6 @@ subroutine advertise_fields(gcomp, rc) call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_qa') call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_u') call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_v') - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_ua') - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_va') call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_exner') call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_ustar') call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swdn') @@ -105,8 +117,8 @@ subroutine advertise_fields(gcomp, rc) call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snow') call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc') call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl') - call fldlist_add(fldsToLnd_num, fldsToLnd, 'vfrac') - call fldlist_add(fldsToLnd_num, fldsToLnd, 'zorl') + call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_vfrac') + call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_zorl') ! Now advertise import fields do n = 1,fldsToLnd_num @@ -301,12 +313,8 @@ subroutine import_fields(gcomp, noahmp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport_1d(importState, 'Sa_u' , noahmp%forc%u1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, 'Sa_ua' , noahmp%forc%u1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport_1d(importState, 'Sa_v' , noahmp%forc%v1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, 'Sa_va' , noahmp%forc%v1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport_1d(importState, 'Sa_exner' , noahmp%forc%prslk1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport_1d(importState, 'Sa_ustar' , noahmp%forc%ustar1, rc=rc) @@ -323,9 +331,9 @@ subroutine import_fields(gcomp, noahmp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport_1d(importState, 'Faxa_snowl', noahmp%forc%snowl, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, 'vfrac' , noahmp%forc%vegfrac, rc=rc) + call state_getimport_1d(importState, 'Sa_vfrac' , noahmp%forc%vegfrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, 'zorl' , noahmp%forc%zorl, rc=rc) + call state_getimport_1d(importState, 'Sa_zorl' , noahmp%forc%zorl, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -363,7 +371,31 @@ subroutine export_fields(gcomp, noahmp, rc) ! output to atm ! ----------------------- - call state_setexport_1d(exportState, 'Sl_t', noahmp%model%t2mmp, rc=rc) + call state_setexport_1d(exportState, 'Sl_sfrac', noahmp%model%sncovr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Fall_lat', noahmp%model%evap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Fall_sen', noahmp%model%hflx, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Fall_evap', noahmp%model%ep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Sl_tref', noahmp%model%t2mmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Sl_qref', noahmp%model%q2mp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Sl_q', noahmp%model%qsurf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Fall_gflx', noahmp%model%gflux, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Fall_roff', noahmp%model%runoff, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Fall_soff', noahmp%model%drain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Sl_cmm', noahmp%model%cmm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Sl_chh', noahmp%model%chh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, 'Sl_zvfun', noahmp%model%zvfun, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) diff --git a/drivers/nuopc/lnd_comp_io.F90 b/drivers/nuopc/lnd_comp_io.F90 index 353a13f3..dfa08d9a 100644 --- a/drivers/nuopc/lnd_comp_io.F90 +++ b/drivers/nuopc/lnd_comp_io.F90 @@ -1,66 +1,71 @@ -#define NC_ERR_STOP(status) \ - if (status /= nf90_noerr) write(0,*) "line ", __LINE__, trim(nf90_strerror(status)); \ - if (status /= nf90_noerr) call ESMF_Finalize(endflag=ESMF_END_ABORT) - module lnd_comp_io ! This file contains I/O routines for the NoahMP land surface model - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMGetCurrent - use ESMF , only : ESMF_TYPEKIND_R4, ESMF_KIND_R4, ESMF_INDEX_GLOBAL - use ESMF , only : ESMF_Grid, ESMF_Mesh, ESMF_MESHLOC_ELEMENT - use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy - use ESMF , only : ESMF_RouteHandle, ESMF_FieldRegridStore, ESMF_FieldRedist - use ESMF , only : ESMF_FieldWriteVTK, ESMF_STAGGERLOC_CENTER - use ESMF , only : ESMF_ArraySpec, ESMF_ArraySpecSet, ESMF_END_ABORT - use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LogWrite - use ESMF , only : ESMF_TYPEKIND_R8, ESMF_KIND_R8, ESMF_Finalize - - use mpp_mod , only : mpp_pe, mpp_error, mpp_sync, FATAL - use mpp_io_mod , only : mpp_get_info, mpp_get_fields, mpp_get_atts - use mpp_io_mod , only : mpp_def_dim, mpp_write, mpp_write_meta, axistype - use mpp_io_mod , only : fieldtype, mpp_open, mpp_read, mpp_close - use mpp_io_mod , only : MPP_RDONLY, MPP_NETCDF, MPP_SINGLE, MPP_MULTI, MPP_OVERWR - use mpp_domains_mod , only : mpp_get_compute_domain, mpp_get_domain_components, domain1D - use mpp_parameter_mod, only : MPP_FILL_DOUBLE - - use lnd_comp_types , only : noahmp_type - use lnd_comp_kind , only : cl => shr_kind_cl - use lnd_comp_kind , only : r8 => shr_kind_r8 - use lnd_comp_shr , only : chkerr + use ESMF , only : operator(==), operator(/=) + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd + use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleRead, ESMF_FieldBundleWrite + use ESMF , only : ESMF_FieldBundleRemove, ESMF_FieldBundleDestroy + use ESMF , only : ESMF_FieldBundleRedistStore, ESMF_FieldBundleRedist + use ESMF , only : ESMF_RouteHandleDestroy, ESMF_RouteHandle, ESMF_FieldWrite + use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet, ESMF_FieldWriteVTK + use ESMF , only : ESMF_FieldDestroy, ESMF_ArraySpec, ESMF_ArraySpecSet + use ESMF , only : ESMF_LogWrite, ESMF_FieldStatus_Flag, ESMF_GeomType_Flag + use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_FieldBundleAddReplace + use ESMF , only : ESMF_KIND_R8, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_KIND_R4, ESMF_TYPEKIND_R4 + use ESMF , only : ESMF_KIND_I4, ESMF_TYPEKIND_I4 + use ESMF , only : ESMF_STAGGERLOC_CENTER, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_INDEX_DELOCAL, ESMF_INDEX_GLOBAL + use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + use ESMF , only : ESMF_AttributeAdd, ESMF_AttributeSet, ESMF_Grid + use ESMF , only : ESMF_LocStream, ESMF_LocStreamCreate, ESMF_LocStreamDestroy + use ESMF , only : ESMF_GridCreate, ESMF_FILESTATUS_OLD, ESMF_TypeKind_Flag + use ESMF , only : ESMF_DistGrid, ESMF_DistGridCreate + use ESMF , only : ESMF_VMBarrier, ESMF_VM + + use lnd_comp_types, only : noahmp_type + use lnd_comp_types, only : field_type + use lnd_comp_types, only : fldsMaxIO, histflds, restflds + use lnd_comp_kind , only : cl => shr_kind_cl + use lnd_comp_kind , only : r4 => shr_kind_r4 + use lnd_comp_kind , only : r8 => shr_kind_r8 + use lnd_comp_kind , only : i4 => shr_kind_i4 + use lnd_comp_shr , only : chkerr + use lnd_comp_shr , only : chkerrnc + + use physcons , only : con_rd, con_fvirt use mpi implicit none private - type fields - character(len=cl) :: short_name = "" ! short name - character(len=cl) :: units = "" ! unit - character(len=cl) :: long_name = "" ! long name - character(len=cl) :: zaxis = "" ! name of z axis - integer :: nlev ! number of layers for 3d fields - end type fields - public :: read_initial public :: read_restart public :: read_static public :: read_tiled_file - public :: write_mosaic_output + public :: write_tiled_file + public :: write_tiled_file_init !-------------------------------------------------------------------------- ! Private module data !-------------------------------------------------------------------------- - integer, parameter :: dbug = 1 - integer, parameter :: iswater = 17 - integer, parameter :: max_num_variables = 200 - integer :: max_indx = 0 - type(fields) :: flds(max_num_variables) - character(*), parameter :: modName = "(lnd_comp_io)" + integer, parameter :: dbug = 0 + integer, parameter :: iswater = 17 + character(len=1024) :: msgString + + integer(ESMF_KIND_I4) :: missing_i4 = -999 + real(ESMF_KIND_R4) :: missing_r4 = 1.0e20 + real(ESMF_KIND_R8) :: missing_r8 = 1.0d20 + + type(ESMF_FieldBundle) :: FBgridO, FBmeshO - character(len=*) , parameter :: u_FILE_u = & - __FILE__ + character(*), parameter :: modName = "(lnd_comp_io)" + character(len=*) , parameter :: u_FILE_u = __FILE__ !=============================================================================== contains @@ -69,243 +74,184 @@ module lnd_comp_io subroutine read_initial(noahmp, rc) ! input/output variables - type(noahmp_type), intent(inout) :: noahmp - integer , intent(inout) :: rc + type(noahmp_type), target, intent(inout) :: noahmp + integer , intent(inout) :: rc ! local variables - integer :: nt character(len=cl) :: filename - real(ESMF_KIND_R8), pointer :: ptr(:,:,:) - type(ESMF_Field) :: field + type(field_type), allocatable :: flds(:) character(len=*), parameter :: subname=trim(modName)//':(read_initial) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (trim(noahmp%nmlist%ic_type) == 'sfc') then !---------------------- ! Set file name for initial conditions !---------------------- - filename = trim(noahmp%nmlist%input_dir)//'sfc_data.tile' + filename = trim(noahmp%nmlist%input_dir)//'sfc_data.tile*.nc' call ESMF_LogWrite(subname//' called for '//trim(filename), ESMF_LOGMSG_INFO) !---------------------- - ! Read snow water equivalent + ! Create field list !---------------------- - call read_tiled_file(filename, 'sheleg', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%snow_water_equivalent(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(flds(10)) !---------------------- - ! Read snow depth + ! Snow water equivalent !---------------------- - call read_tiled_file(filename, 'snwdph', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%snow_depth(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(1)%short_name = 'sheleg' + flds(1)%ptr1r8 => noahmp%init%snow_water_equivalent !---------------------- - ! Read canopy surface water + ! Snow depth !---------------------- - call read_tiled_file(filename, 'canopy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%canopy_water(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(2)%short_name = 'snwdph' + flds(2)%ptr1r8 => noahmp%init%snow_depth !---------------------- - ! Read surface skin temperature + ! Canopy surface water !---------------------- - call read_tiled_file(filename, 'tsea', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%skin_temperature(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(3)%short_name = 'canopy' + flds(3)%ptr1r8 => noahmp%init%canopy_water !---------------------- - ! Read surface soil temperature + ! Surface skin temperature !---------------------- - call read_tiled_file(filename, 'stc', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%soil_temperature(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(4)%short_name = 'tsea' + flds(4)%ptr1r8 => noahmp%init%skin_temperature !---------------------- - ! Read surface soil moisture + ! Surface soil temperature !---------------------- - call read_tiled_file(filename, 'smc', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%soil_moisture(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(5)%short_name = 'stc' + flds(5)%nrec = noahmp%nmlist%num_soil_levels + flds(5)%ptr2r8 => noahmp%init%soil_temperature !---------------------- - ! Read surface soil liquid + ! Surface soil moisture !---------------------- - call read_tiled_file(filename, 'slc', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%soil_liquid(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(6)%short_name = 'smc' + flds(6)%nrec = noahmp%nmlist%num_soil_levels + flds(6)%ptr2r8 => noahmp%init%soil_moisture !---------------------- - ! Read surface roughness length + ! Surface soil liquid !---------------------- - call read_tiled_file(filename, 'zorl', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%surface_roughness(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(7)%short_name = 'slc' + flds(7)%nrec = noahmp%nmlist%num_soil_levels + flds(7)%ptr2r8 => noahmp%init%soil_liquid !---------------------- - ! Read friction velocity + ! Surface roughness length !---------------------- - call read_tiled_file(filename, 'uustar', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%friction_velocity(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(8)%short_name = 'zorl' + flds(8)%ptr1r8 => noahmp%init%surface_roughness + + !---------------------- + ! Friction velocity + !---------------------- + + flds(9)%short_name = 'uustar' + flds(9)%ptr1r8 => noahmp%init%friction_velocity + + !---------------------- + ! Vegetation type + !---------------------- + + flds(10)%short_name = 'vtype' + flds(10)%ptr1i4 => noahmp%model%vegtype else !---------------------- ! Set file name for initial conditions !---------------------- - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.initial.tile' + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.initial.tile*.nc' call ESMF_LogWrite(subname//' called for '//trim(filename), ESMF_LOGMSG_INFO) !---------------------- - ! Read snow water equivalent + ! Create field list !---------------------- - call read_tiled_file(filename, 'snow_water_equivalent', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%snow_water_equivalent(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(flds(7)) !---------------------- - ! Read snow depth + ! Snow water equivalent !---------------------- - call read_tiled_file(filename, 'snow_depth', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%snow_depth(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(1)%short_name = 'snow_water_equivalent' + flds(1)%ptr1r8 => noahmp%init%snow_water_equivalent !---------------------- - ! Read canopy surface water + ! Snow depth !---------------------- - call read_tiled_file(filename, 'canopy_water', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%canopy_water(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(2)%short_name = 'snow_depth' + flds(2)%ptr1r8 => noahmp%init%snow_depth !---------------------- - ! Read surface skin temperature + ! Canopy surface water !---------------------- - call read_tiled_file(filename, 'skin_temperature', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%skin_temperature(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(3)%short_name = 'canopy_water' + flds(3)%ptr1r8 => noahmp%init%canopy_water !---------------------- - ! Read surface soil temperature + ! Surface skin temperature !---------------------- - call read_tiled_file(filename, 'soil_temperature', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%soil_temperature(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(4)%short_name = 'skin_temperature' + flds(4)%ptr1r8 => noahmp%init%skin_temperature !---------------------- - ! Read surface soil moisture + ! Surface soil temperature !---------------------- - call read_tiled_file(filename, 'soil_moisture', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%soil_moisture(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(5)%short_name = 'soil_temperature' + flds(5)%nrec = noahmp%nmlist%num_soil_levels + flds(5)%ptr2r8 => noahmp%init%soil_temperature !---------------------- - ! Read surface soil liquid + ! Surface soil moisture !---------------------- - call read_tiled_file(filename, 'soil_liquid', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%init%soil_liquid(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + flds(6)%short_name = 'soil_moisture' + flds(6)%nrec = noahmp%nmlist%num_soil_levels + flds(6)%ptr2r8 => noahmp%init%soil_moisture + + !---------------------- + ! Surface soil liquid + !---------------------- + + flds(7)%short_name = 'soil_liquid' + flds(7)%nrec = noahmp%nmlist%num_soil_levels + flds(7)%ptr2r8 => noahmp%init%soil_liquid end if + !---------------------- + ! Read file + !---------------------- + + call read_tiled_file(noahmp, filename, flds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Clean memory + !---------------------- + + if (allocated(flds)) deallocate(flds) + call ESMF_LogWrite(subname//' done for '//trim(filename), ESMF_LOGMSG_INFO) end subroutine read_initial @@ -314,18 +260,19 @@ end subroutine read_initial subroutine read_restart(noahmp, rc) ! input/output variables - type(noahmp_type), intent(inout) :: noahmp - integer , intent(inout) :: rc + type(noahmp_type), target, intent(inout) :: noahmp + integer , intent(inout) :: rc ! local variables - integer :: nt - character(len=cl) :: filename - real(ESMF_KIND_R8), pointer :: ptr(:,:,:) - type(ESMF_Field) :: field - character(len=*), parameter :: subname=trim(modName)//':(read_restart) ' + integer :: i + character(len=cl) :: filename + integer, target, allocatable :: tmpi4(:) + type(field_type), allocatable :: flds(:) + character(len=*), parameter :: subname=trim(modName)//':(read_restart) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------- ! Set file name for restart @@ -335,2033 +282,1474 @@ subroutine read_restart(noahmp, rc) call ESMF_LogWrite(subname//' called for '//trim(filename)//'*', ESMF_LOGMSG_INFO) !---------------------- - ! zonal wind at lowest model layer + ! allocate teemporary data structures !---------------------- - call read_tiled_file(filename, 'u1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%u1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + if (.not. allocated(tmpi4)) then + allocate(tmpi4(noahmp%domain%begl:noahmp%domain%endl)) + tmpi4(:) = 0 + end if !---------------------- - ! meridional wind at lowest model layer - !---------------------- + ! Create field list + !---------------------- + + i = 1 + allocate(flds(125)) + + ! 2d fields + flds(i)%short_name = 'albdnir' ; flds(i)%ptr1r8 => noahmp%model%albdnir(:) ; i=i+1 ! albedo - direct NIR + flds(i)%short_name = 'albdvis' ; flds(i)%ptr1r8 => noahmp%model%albdvis(:) ; i=i+1 ! albedo - direct visible + flds(i)%short_name = 'albinir' ; flds(i)%ptr1r8 => noahmp%model%albinir(:) ; i=i+1 ! albedo - diffuse NIR + flds(i)%short_name = 'albivis' ; flds(i)%ptr1r8 => noahmp%model%albivis(:) ; i=i+1 ! albedo - diffuse visible + flds(i)%short_name = 'alboldxy' ; flds(i)%ptr1r8 => noahmp%model%alboldxy(:) ; i=i+1 ! snow albedo at last time step + flds(i)%short_name = 'canicexy' ; flds(i)%ptr1r8 => noahmp%model%canicexy(:) ; i=i+1 ! canopy-intercepted ice + flds(i)%short_name = 'canliqxy' ; flds(i)%ptr1r8 => noahmp%model%canliqxy(:) ; i=i+1 ! canopy-intercepted liquid water + flds(i)%short_name = 'canopy' ; flds(i)%ptr1r8 => noahmp%model%canopy(:) ; i=i+1 ! canopy moisture content + flds(i)%short_name = 'ch' ; flds(i)%ptr1r8 => noahmp%model%ch(:) ; i=i+1 ! surface exchange coeff for heat and moisture + flds(i)%short_name = 'chh' ; flds(i)%ptr1r8 => noahmp%model%chh(:) ; i=i+1 ! ch * rho + flds(i)%short_name = 'chxy' ; flds(i)%ptr1r8 => noahmp%model%chxy(:) ; i=i+1 ! bulk sensible heat exchange coefficient + flds(i)%short_name = 'cm' ; flds(i)%ptr1r8 => noahmp%model%cm(:) ; i=i+1 ! surface exchange coeff for momentum + flds(i)%short_name = 'cmm' ; flds(i)%ptr1r8 => noahmp%model%cmm(:) ; i=i+1 ! cm * rho + flds(i)%short_name = 'cmxy' ; flds(i)%ptr1r8 => noahmp%model%cmxy(:) ; i=i+1 ! bulk momentum drag coefficient + flds(i)%short_name = 'deeprechxy'; flds(i)%ptr1r8 => noahmp%model%deeprechxy(:); i=i+1 ! recharge to the water table when deep + flds(i)%short_name = 'dlwflx' ; flds(i)%ptr1r8 => noahmp%forc%dlwflx(:) ; i=i+1 ! downward longwave radiation + flds(i)%short_name = 'drain' ; flds(i)%ptr1r8 => noahmp%model%drain(:) ; i=i+1 ! subsurface runoff + flds(i)%short_name = 'dswsfc' ; flds(i)%ptr1r8 => noahmp%forc%dswsfc(:) ; i=i+1 ! downward shortwave radiation + flds(i)%short_name = 'eahxy' ; flds(i)%ptr1r8 => noahmp%model%eahxy(:) ; i=i+1 ! canopy air vapor pressure + flds(i)%short_name = 'ecan' ; flds(i)%ptr1r8 => noahmp%model%ecan(:) ; i=i+1 ! evaporation of intercepted water + flds(i)%short_name = 'edir' ; flds(i)%ptr1r8 => noahmp%model%edir(:) ; i=i+1 ! soil surface evaporation rate + flds(i)%short_name = 'emiss' ; flds(i)%ptr1r8 => noahmp%model%emiss(:) ; i=i+1 ! surface emissivity + flds(i)%short_name = 'ep' ; flds(i)%ptr1r8 => noahmp%model%ep(:) ; i=i+1 ! potential evaporation + flds(i)%short_name = 'etran' ; flds(i)%ptr1r8 => noahmp%model%etran(:) ; i=i+1 ! transpiration rate + flds(i)%short_name = 'evap' ; flds(i)%ptr1r8 => noahmp%model%evap(:) ; i=i+1 ! evaporation from latent heat flux + flds(i)%short_name = 'evbs' ; flds(i)%ptr1r8 => noahmp%model%evbs(:) ; i=i+1 ! direct soil evaporation + flds(i)%short_name = 'evcw' ; flds(i)%ptr1r8 => noahmp%model%evcw(:) ; i=i+1 ! canopy water evaporation + flds(i)%short_name = 'fastcpxy' ; flds(i)%ptr1r8 => noahmp%model%fastcpxy(:) ; i=i+1 ! short-lived carbon, shallow soil + flds(i)%short_name = 'fh1' ; flds(i)%ptr1r8 => noahmp%model%fh1(:) ; i=i+1 ! Monin-Obukhov similarity function for heat over land + flds(i)%short_name = 'fh21' ; flds(i)%ptr1r8 => noahmp%model%fh21(:) ; i=i+1 ! Monin-Obukhov similarity parameter for heat at 2m over land + flds(i)%short_name = 'flhc1' ; flds(i)%ptr1r8 => noahmp%model%flhc1(:) ; i=i+1 ! Surface exchange coefficient for heat + flds(i)%short_name = 'flqc1' ; flds(i)%ptr1r8 => noahmp%model%flqc1(:) ; i=i+1 ! Surface exchange coefficient for moisture + flds(i)%short_name = 'fm101' ; flds(i)%ptr1r8 => noahmp%model%fm101(:) ; i=i+1 ! Monin-Obukhov similarity parameter for momentum at 10m over land + flds(i)%short_name = 'fm1' ; flds(i)%ptr1r8 => noahmp%model%fm1(:) ; i=i+1 ! Monin-Obukhov similarity function for momentum over land + flds(i)%short_name = 'fwetxy' ; flds(i)%ptr1r8 => noahmp%model%fwetxy(:) ; i=i+1 ! wetted or snowed fraction of the canopy + flds(i)%short_name = 'gflux' ; flds(i)%ptr1r8 => noahmp%model%gflux(:) ; i=i+1 ! soil heat flux + flds(i)%short_name = 'graupel_mp'; flds(i)%ptr1r8 => noahmp%model%graupel_mp(:); i=i+1 ! microphysics graupel + flds(i)%short_name = 'hflx' ; flds(i)%ptr1r8 => noahmp%model%hflx(:) ; i=i+1 ! sensible heat flux + flds(i)%short_name = 'hgt' ; flds(i)%ptr1r8 => noahmp%forc%hgt(:) ; i=i+1 ! forcing or lowest model layer height + flds(i)%short_name = 'ice_mp' ; flds(i)%ptr1r8 => noahmp%model%ice_mp(:) ; i=i+1 ! microphysics ice/hail + flds(i)%short_name = 'lfmassxy' ; flds(i)%ptr1r8 => noahmp%model%lfmassxy(:) ; i=i+1 ! leaf mass + flds(i)%short_name = 'mask' ; flds(i)%ptr1i4 => tmpi4(:) ; i=i+1 ! flag for a point with any land + flds(i)%short_name = 'pah' ; flds(i)%ptr1r8 => noahmp%model%pah(:) ; i=i+1 ! precipitation advected heat - total + flds(i)%short_name = 'pblh' ; flds(i)%ptr1r8 => noahmp%model%pblh(:) ; i=i+1 ! PBL thickness + flds(i)%short_name = 'prsik1' ; flds(i)%ptr1r8 => noahmp%model%prsik1(:) ; i=i+1 ! dimensionless Exner function at the ground surface + flds(i)%short_name = 'prsl1' ; flds(i)%ptr1r8 => noahmp%model%prsl1(:) ; i=i+1 ! mean pressure at lowest model layer + flds(i)%short_name = 'prslk1' ; flds(i)%ptr1r8 => noahmp%model%prslk1(:) ; i=i+1 ! dimensionless Exner function at the lowest model layer + flds(i)%short_name = 'prslki' ; flds(i)%ptr1r8 => noahmp%model%prslki(:) ; i=i+1 ! Exner function ratio bt midlayer and interface at 1st layer + flds(i)%short_name = 'ps' ; flds(i)%ptr1r8 => noahmp%forc%ps(:) ; i=i+1 ! surface pressure + flds(i)%short_name = 'q1' ; flds(i)%ptr1r8 => noahmp%forc%q1(:) ; i=i+1 ! mixing ratio + flds(i)%short_name = 'q2mp' ; flds(i)%ptr1r8 => noahmp%model%q2mp(:) ; i=i+1 ! combined q2m from tiles + flds(i)%short_name = 'qsnowxy' ; flds(i)%ptr1r8 => noahmp%model%qsnowxy(:) ; i=i+1 ! snowfall on the ground + flds(i)%short_name = 'qsurf' ; flds(i)%ptr1r8 => noahmp%model%qsurf(:) ; i=i+1 ! specific humidity at sfc + flds(i)%short_name = 'rainc_mp' ; flds(i)%ptr1r8 => noahmp%model%rainc_mp(:) ; i=i+1 ! microphysics convective precipitation + flds(i)%short_name = 'rainn_mp' ; flds(i)%ptr1r8 => noahmp%model%rainn_mp(:) ; i=i+1 ! microphysics non-convective precipitation + flds(i)%short_name = 'rb1' ; flds(i)%ptr1r8 => noahmp%model%rb1(:) ; i=i+1 ! bulk Richardson number at the surface over land + flds(i)%short_name = 'rechxy' ; flds(i)%ptr1r8 => noahmp%model%rechxy(:) ; i=i+1 ! recharge to the water table (diagnostic) + flds(i)%short_name = 'rho' ; flds(i)%ptr1r8 => noahmp%model%rho(:) ; i=i+1 ! density + flds(i)%short_name = 'rhonewsn1' ; flds(i)%ptr1r8 => noahmp%model%rhonewsn1(:) ; i=i+1 ! precipitation ice density + flds(i)%short_name = 'rmol1' ; flds(i)%ptr1r8 => noahmp%model%rmol1(:) ; i=i+1 ! One over obukhov length + flds(i)%short_name = 'rtmassxy' ; flds(i)%ptr1r8 => noahmp%model%rtmassxy(:) ; i=i+1 ! mass of fine roots + flds(i)%short_name = 'runoff' ; flds(i)%ptr1r8 => noahmp%model%runoff(:) ; i=i+1 ! surface runoff + flds(i)%short_name = 'sbsno' ; flds(i)%ptr1r8 => noahmp%model%sbsno(:) ; i=i+1 ! sublimation/deposit from snopack + flds(i)%short_name = 'sfalb' ; flds(i)%ptr1r8 => noahmp%model%sfalb(:) ; i=i+1 ! mean sfc diffuse sw albedo + flds(i)%short_name = 'shdmax' ; flds(i)%ptr1r8 => noahmp%model%shdmax(:) ; i=i+1 ! max fractional coverage of green veg + flds(i)%short_name = 'shdmin' ; flds(i)%ptr1r8 => noahmp%model%shdmin(:) ; i=i+1 ! min fractional coverage of green veg + flds(i)%short_name = 'sigmaf' ; flds(i)%ptr1r8 => noahmp%model%sigmaf(:) ; i=i+1 ! green vegetation fraction + flds(i)%short_name = 'slopetyp' ; flds(i)%ptr1i4 => noahmp%model%slopetyp(:) ; i=i+1 ! class of sfc slope + flds(i)%short_name = 'smcref2' ; flds(i)%ptr1r8 => noahmp%model%smcref2(:) ; i=i+1 ! soil moisture threshold + flds(i)%short_name = 'smcwlt2' ; flds(i)%ptr1r8 => noahmp%model%smcwlt2(:) ; i=i+1 ! dry soil moisture threshold + flds(i)%short_name = 'smcwtdxy' ; flds(i)%ptr1r8 => noahmp%model%smcwtdxy(:) ; i=i+1 ! soil moisture content in the layer to the water table when deep + flds(i)%short_name = 'sncovr1' ; flds(i)%ptr1r8 => noahmp%model%sncovr1(:) ; i=i+1 ! snow cover over land + flds(i)%short_name = 'sneqvoxy' ; flds(i)%ptr1r8 => noahmp%model%sneqvoxy(:) ; i=i+1 ! snow mass at last time step + flds(i)%short_name = 'snet' ; flds(i)%ptr1r8 => noahmp%model%snet(:) ; i=i+1 ! forcing net shortwave flux + flds(i)%short_name = 'snoalb' ; flds(i)%ptr1r8 => noahmp%model%snoalb(:) ; i=i+1 ! upper bound on max albedo over deep snow + flds(i)%short_name = 'snohf' ; flds(i)%ptr1r8 => noahmp%model%snohf(:) ; i=i+1 ! snow/freezing-rain latent heat flux + flds(i)%short_name = 'snowc' ; flds(i)%ptr1r8 => noahmp%model%snowc(:) ; i=i+1 ! fractional snow cover + flds(i)%short_name = 'snow_mp' ; flds(i)%ptr1r8 => noahmp%model%snow_mp(:) ; i=i+1 ! microphysics snow + flds(i)%short_name = 'snowxy' ; flds(i)%ptr1r8 => noahmp%model%snowxy(:) ; i=i+1 ! actual no. of snow layers + flds(i)%short_name = 'snwdph' ; flds(i)%ptr1r8 => noahmp%model%snwdph(:) ; i=i+1 ! snow depth (water equiv) over land + flds(i)%short_name = 'soiltyp' ; flds(i)%ptr1i4 => noahmp%model%soiltyp(:) ; i=i+1 ! soil type + flds(i)%short_name = 'srflag' ; flds(i)%ptr1r8 => noahmp%model%srflag(:) ; i=i+1 ! snow/rain flag for precipitation + flds(i)%short_name = 'stblcpxy' ; flds(i)%ptr1r8 => noahmp%model%stblcpxy(:) ; i=i+1 ! stable carbon in deep soil + flds(i)%short_name = 'stmassxy' ; flds(i)%ptr1r8 => noahmp%model%stmassxy(:) ; i=i+1 ! stem mass + flds(i)%short_name = 'stm' ; flds(i)%ptr1r8 => noahmp%model%stm(:) ; i=i+1 ! total soil column moisture content + flds(i)%short_name = 'stress1' ; flds(i)%ptr1r8 => noahmp%model%stress1(:) ; i=i+1 ! surface wind stress over land + flds(i)%short_name = 't1' ; flds(i)%ptr1r8 => noahmp%forc%t1(:) ; i=i+1 ! surface or lowest layer air temperature + flds(i)%short_name = 't2mmp' ; flds(i)%ptr1r8 => noahmp%model%t2mmp(:) ; i=i+1 ! combined T2m from tiles + flds(i)%short_name = 'tahxy' ; flds(i)%ptr1r8 => noahmp%model%tahxy(:) ; i=i+1 ! canopy air temperature + flds(i)%short_name = 'taussxy' ; flds(i)%ptr1r8 => noahmp%model%taussxy(:) ; i=i+1 ! snow age factor + flds(i)%short_name = 'tg3' ; flds(i)%ptr1r8 => noahmp%model%tg3(:) ; i=i+1 ! deep soil temperature + flds(i)%short_name = 'tgxy' ; flds(i)%ptr1r8 => noahmp%model%tgxy(:) ; i=i+1 ! bulk ground surface temperature + flds(i)%short_name = 'tprcp' ; flds(i)%ptr1r8 => noahmp%model%tprcp(:) ; i=i+1 ! total precipitation + flds(i)%short_name = 'trans' ; flds(i)%ptr1r8 => noahmp%model%trans(:) ; i=i+1 ! total plant transpiration + flds(i)%short_name = 'tskin' ; flds(i)%ptr1r8 => noahmp%model%tskin(:) ; i=i+1 ! ground surface skin temperature + flds(i)%short_name = 'tsurf' ; flds(i)%ptr1r8 => noahmp%model%tsurf(:) ; i=i+1 ! surface skin temperature (after iteration) + flds(i)%short_name = 'tvxy' ; flds(i)%ptr1r8 => noahmp%model%tvxy(:) ; i=i+1 ! vegetation leaf temperature + flds(i)%short_name = 'u1' ; flds(i)%ptr1r8 => noahmp%model%u1(:) ; i=i+1 ! zonal wind at lowest model layer + flds(i)%short_name = 'ustar1' ; flds(i)%ptr1r8 => noahmp%model%ustar1(:) ; i=i+1 ! surface friction velocity over land + flds(i)%short_name = 'v1' ; flds(i)%ptr1r8 => noahmp%model%v1(:) ; i=i+1 ! meridional wind at lowest model layer + flds(i)%short_name = 'vegtype' ; flds(i)%ptr1i4 => noahmp%model%vegtype(:) ; i=i+1 ! vegetation type + flds(i)%short_name = 'waxy' ; flds(i)%ptr1r8 => noahmp%model%waxy(:) ; i=i+1 ! water in the aquifer + flds(i)%short_name = 'weasd' ; flds(i)%ptr1r8 => noahmp%model%weasd(:) ; i=i+1 ! water equivalent accumulated snow depth + flds(i)%short_name = 'wet1' ; flds(i)%ptr1r8 => noahmp%model%wet1(:) ; i=i+1 ! normalized soil wetness + flds(i)%short_name = 'wind' ; flds(i)%ptr1r8 => noahmp%forc%wind(:) ; i=i+1 ! wind speed + flds(i)%short_name = 'woodxy' ; flds(i)%ptr1r8 => noahmp%model%woodxy(:) ; i=i+1 ! mass of wood incl woody roots + flds(i)%short_name = 'wslakexy' ; flds(i)%ptr1r8 => noahmp%model%wslakexy(:) ; i=i+1 ! lake water storage + flds(i)%short_name = 'wtxy' ; flds(i)%ptr1r8 => noahmp%model%wtxy(:) ; i=i+1 ! groundwater storage + flds(i)%short_name = 'xcoszin' ; flds(i)%ptr1r8 => noahmp%model%xcoszin(:) ; i=i+1 ! cosine of zenith angle + flds(i)%short_name = 'xlaixy' ; flds(i)%ptr1r8 => noahmp%model%xlaixy(:) ; i=i+1 ! leaf area index + flds(i)%short_name = 'xlatin' ; flds(i)%ptr1r8 => noahmp%model%xlatin(:) ; i=i+1 ! latitude + flds(i)%short_name = 'xsaixy' ; flds(i)%ptr1r8 => noahmp%model%xsaixy(:) ; i=i+1 ! stem area index + flds(i)%short_name = 'zf' ; flds(i)%ptr1r8 => noahmp%model%zf(:) ; i=i+1 ! height of bottom layer + flds(i)%short_name = 'zorl' ; flds(i)%ptr1r8 => noahmp%model%zorl(:) ; i=i+1 ! surface roughness + flds(i)%short_name = 'ztmax' ; flds(i)%ptr1r8 => noahmp%model%ztmax(:) ; i=i+1 ! bounded surface roughness length for heat over land + flds(i)%short_name = 'zvfun' ; flds(i)%ptr1r8 => noahmp%model%zvfun(:) ; i=i+1 ! function of surface roughness length and green vegetation fraction + flds(i)%short_name = 'zwtxy' ; flds(i)%ptr1r8 => noahmp%model%zwtxy(:) ; i=i+1 ! water table depth + + ! 3d fields + flds(i)%short_name = 'slc' ; flds(i)%ptr2r8 => noahmp%model%slc(:,:) ; flds(i)%nrec = noahmp%nmlist%num_soil_levels; i=i+1 ! liquid soil moisture + flds(i)%short_name = 'smc' ; flds(i)%ptr2r8 => noahmp%model%smc(:,:) ; flds(i)%nrec = noahmp%nmlist%num_soil_levels; i=i+1 ! total soil moisture content + flds(i)%short_name = 'smoiseq' ; flds(i)%ptr2r8 => noahmp%model%smoiseq(:,:) ; flds(i)%nrec = noahmp%nmlist%num_soil_levels; i=i+1 ! equilibrium soil water content + flds(i)%short_name = 'snicexy' ; flds(i)%ptr2r8 => noahmp%model%snicexy(:,:) ; flds(i)%nrec = abs(noahmp%static%lsnowl)+1 ; i=i+1 ! lwe thickness of ice in surface snow + flds(i)%short_name = 'snliqxy' ; flds(i)%ptr2r8 => noahmp%model%snliqxy(:,:) ; flds(i)%nrec = abs(noahmp%static%lsnowl)+1 ; i=i+1 ! snow layer liquid water + flds(i)%short_name = 'stc' ; flds(i)%ptr2r8 => noahmp%model%stc(:,:) ; flds(i)%nrec = noahmp%nmlist%num_soil_levels; i=i+1 ! soil temperature + flds(i)%short_name = 'tsnoxy' ; flds(i)%ptr2r8 => noahmp%model%tsnoxy(:,:) ; flds(i)%nrec = abs(noahmp%static%lsnowl)+1 ; i=i+1 ! temperature in surface snow + flds(i)%short_name = 'zsnsoxy' ; flds(i)%ptr2r8 => noahmp%model%zsnsoxy(:,:) ; flds(i)%nrec = abs(noahmp%static%lsnowl)+noahmp%nmlist%num_soil_levels+1; i=i+1 ! depth from the top of the snow surface at the bottom of the layer + + !---------------------- + ! Read file + !---------------------- + + call read_tiled_file(noahmp, filename, flds, maskflag=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Set additional variables + !---------------------- + + where(tmpi4(:) > 0) + noahmp%model%dry(:) = .true. + elsewhere + noahmp%model%dry(:) = .false. + end where - call read_tiled_file(filename, 'v1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%v1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%forc%tprcp(:) = noahmp%model%tprcp(:) + noahmp%forc%u1(:) = noahmp%model%u1(:) + noahmp%forc%v1(:) = noahmp%model%v1(:) !---------------------- - ! soil type + ! Clean memory !---------------------- - call read_tiled_file(filename, 'soiltyp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%soiltyp(:) = int(ptr(:,1,1)) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + if (allocated(flds)) deallocate(flds) - !---------------------- - ! vegetation type - !---------------------- + call ESMF_LogWrite(subname//' done for '//trim(filename), ESMF_LOGMSG_INFO) - call read_tiled_file(filename, 'vegtype', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%vegtype(:) = int(ptr(:,1,1)) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + end subroutine read_restart - !---------------------- - ! green vegetation fraction - !---------------------- + !=============================================================================== + subroutine read_static(noahmp, rc) - call read_tiled_file(filename, 'sigmaf', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%sigmaf(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + ! input/output variables + type(noahmp_type), target, intent(inout) :: noahmp + integer , intent(inout) :: rc - !---------------------- - ! forcing net shortwave flux - !---------------------- + ! local variables + type(field_type), allocatable :: flds(:) + real(r4), target, allocatable :: tmpr4(:) + real(r4), target, allocatable :: tmp2r4(:,:) + character(len=CL) :: filename + real(ESMF_KIND_R8), parameter :: pi_8 = 3.14159265358979323846_r8 + character(len=*), parameter :: subname=trim(modName)//':(read_static) ' + !------------------------------------------------------------------------------- - call read_tiled_file(filename, 'snet', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snet(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------- - ! deep soil temperature + ! allocate temporary data structures !---------------------- - call read_tiled_file(filename, 'tg3', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tg3(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + if (.not. allocated(tmpr4)) then + allocate(tmpr4(noahmp%domain%begl:noahmp%domain%endl)) + tmpr4(:) = 0.0 + end if + + if (.not. allocated(tmp2r4)) then + allocate(tmp2r4(noahmp%domain%begl:noahmp%domain%endl,12)) + tmp2r4(:,:) = 0.0 + end if !---------------------- - ! surface exchange coeff for momentum + ! Read latitude, we could also retrive from ESMF mesh object !---------------------- - call read_tiled_file(filename, 'cm', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + allocate(flds(1)) + filename = trim(noahmp%nmlist%input_dir)//'oro_data.tile*.nc' + flds(1)%short_name = 'geolat' + flds(1)%ptr1r8 => noahmp%model%xlatin if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%cm(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call read_tiled_file(noahmp, filename, flds, rc=rc) + deallocate(flds) + + ! convert it to radian + noahmp%model%xlatin(:) = noahmp%model%xlatin(:)*pi_8/180.0_r8 !---------------------- - ! surface exchange coeff for heat and moisture + ! Read soil type !---------------------- - call read_tiled_file(filename, 'ch', noahmp, field, numrec=1, rc=rc) + allocate(flds(1)) + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.soil_type.tile*.nc' + flds(1)%short_name = 'soil_type' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%ch(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%soiltyp = int(tmpr4) + deallocate(flds) !---------------------- - ! mean pressure at lowest model layer + ! Read vegetation type !---------------------- - call read_tiled_file(filename, 'prsl1', noahmp, field, numrec=1, rc=rc) + allocate(flds(1)) + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.vegetation_type.tile*.nc' + flds(1)%short_name = 'vegetation_type' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%prsl1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%vegtype = int(tmpr4) + deallocate(flds) !---------------------- - ! dimensionless Exner function at the lowest model layer + ! Read slope type !---------------------- - call read_tiled_file(filename, 'prslk1', noahmp, field, numrec=1, rc=rc) + allocate(flds(1)) + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.slope_type.tile*.nc' + flds(1)%short_name = 'slope_type' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%prslk1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%slopetyp = int(tmpr4) + deallocate(flds) !---------------------- - ! Exner function ratio bt midlayer and interface at 1st layer + ! Read deep soil temperature !---------------------- - call read_tiled_file(filename, 'prslki', noahmp, field, numrec=1, rc=rc) + allocate(flds(1)) + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.substrate_temperature.tile*.nc' + flds(1)%short_name = 'substrate_temperature' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%prslki(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%tg3 = dble(tmpr4) + deallocate(flds) !---------------------- - ! dimensionless Exner function at the ground surface + ! Read maximum snow albedo !---------------------- - call read_tiled_file(filename, 'prsik1', noahmp, field, numrec=1, rc=rc) + allocate(flds(1)) + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.maximum_snow_albedo.tile*.nc' + flds(1)%short_name = 'maximum_snow_albedo' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%prsik1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%snoalb = dble(tmpr4) + deallocate(flds) !---------------------- - ! height of bottom layer + ! Read vegetation greenness, monthly average !---------------------- - call read_tiled_file(filename, 'zf', noahmp, field, numrec=1, rc=rc) + allocate(flds(1)) + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.vegetation_greenness.tile*.nc' + flds(1)%short_name = 'vegetation_greenness' + flds(1)%nrec = 12; flds(1)%ptr2r4 => tmp2r4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%zf(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%gvf_monthly(:,:) = dble(tmp2r4) + noahmp%model%shdmin(:) = minval(noahmp%model%gvf_monthly(:,:), dim=2) + noahmp%model%shdmax(:) = maxval(noahmp%model%gvf_monthly(:,:), dim=2) + deallocate(flds) !---------------------- - ! flag for a point with any land + ! Soil color !---------------------- - call read_tiled_file(filename, 'dry', noahmp, field, numrec=1, rc=rc) + allocate(flds(1)) + write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.soil_color.tile*.nc' + flds(1)%short_name = 'soil_color' + flds(1)%ptr1r4 => tmpr4 + call read_tiled_file(noahmp, filename, flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - where(ptr(:,1,1) > 0.0) - noahmp%model%dry(:) = .true. - elsewhere - noahmp%model%dry(:) = .false. - end where - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%soilcol = int(tmpr4) + deallocate(flds) !---------------------- - ! class of sfc slope + ! Set land-sea mask (dry) !---------------------- - call read_tiled_file(filename, 'slopetyp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%slopetyp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + noahmp%model%dry(:) = .false. + where(noahmp%domain%mask(:) > 0) noahmp%model%dry(:) = .true. !---------------------- - ! min fractional coverage of green veg + ! clean memory !---------------------- - call read_tiled_file(filename, 'shdmin', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%shdmin(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + if (allocated(tmpr4)) deallocate(tmpr4) + if (allocated(tmp2r4)) deallocate(tmp2r4) - !---------------------- - ! max fractional coverage of green veg - !---------------------- + call ESMF_LogWrite(subname//' done for '//trim(filename), ESMF_LOGMSG_INFO) - call read_tiled_file(filename, 'shdmax', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%shdmax(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + end subroutine read_static - !---------------------- - ! upper bound on max albedo over deep snow - !---------------------- + !=============================================================================== + subroutine read_tiled_file(noahmp, filename, flds, maskflag, rh, rc) - call read_tiled_file(filename, 'snoalb', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snoalb(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + ! input/output variables + type(noahmp_type), intent(inout) :: noahmp + character(len=*), intent(in) :: filename + type(field_type), intent(in) :: flds(:) + logical, optional, intent(in) :: maskflag + type(ESMF_RouteHandle), optional, intent(in) :: rh + integer, optional, intent(inout) :: rc - !---------------------- - ! mean sfc diffuse sw albedo - !---------------------- + ! local variables + logical :: amask + integer :: i, j, k, rank, fieldCount + integer, pointer :: ptr1i4(:) + real(r4), pointer :: ptr1r4(:) + real(r8), pointer :: ptr1r8(:) + integer, pointer :: ptr2i4(:,:) + real(r4), pointer :: ptr2r4(:,:) + real(r8), pointer :: ptr2r8(:,:) + type(ESMF_RouteHandle) :: rh_local + type(ESMF_FieldBundle) :: FBgrid, FBmesh + type(ESMF_ArraySpec) :: arraySpec + type(ESMF_Field) :: fgrid, fmesh, ftmp + type(ESMF_TypeKind_Flag) :: typekind + character(len=cl) :: fname + character(len=cl), allocatable :: fieldNameList(:) + character(len=*), parameter :: subname = trim(modName)//': (read_tiled_file) ' + !------------------------------------------------------------------------------- - call read_tiled_file(filename, 'sfalb', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%sfalb(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called for '//trim(filename), ESMF_LOGMSG_INFO) !---------------------- - ! latitude + ! Check mask flag !---------------------- - call read_tiled_file(filename, 'xlatin', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%xlatin(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + if (.not. present(maskflag)) then + amask = .false. + else + amask = maskflag + end if + + if (.not. allocated(noahmp%domain%mask) .and. amask) then + call ESMF_LogWrite(trim(subname)//' maskflag = .true. but noahmp%domain%mask is not allocated yet! Skip applying mask ...', ESMF_LOGMSG_INFO) + end if !---------------------- - ! cosine of zenith angle + ! Create field bundles !---------------------- - call read_tiled_file(filename, 'xcoszin', noahmp, field, numrec=1, rc=rc) + ! create empty field bundle on grid + FBgrid = ESMF_FieldBundleCreate(name="fields_on_grid", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + + ! create empty field bundle on mesh + FBmesh = ESMF_FieldBundleCreate(name="fields_on_mesh", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%xcoszin(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) !---------------------- - ! microphysics non-convective precipitation - !---------------------- + ! Loop over fields and add them to the field bundles + !---------------------- + + do i = 1, size(flds) + ! 2d/r8 field (x,y) + if (associated(flds(i)%ptr1r8)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, flds(i)%ptr1r8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 2d/r4 field (x,y) + else if (associated(flds(i)%ptr1r4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R4, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, flds(i)%ptr1r4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 2d/i4 field (x,y) + else if (associated(flds(i)%ptr1i4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_I4, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, flds(i)%ptr1i4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/r8 field (x,y,rec) + else if (associated(flds(i)%ptr2r8)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/flds(i)%nrec/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, flds(i)%ptr2r8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/r4 field (x,y,rec) + else if (associated(flds(i)%ptr2r4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R4, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/flds(i)%nrec/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, flds(i)%ptr2r4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/i4 field (x,y,rec) + else if (associated(flds(i)%ptr2i4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_I4, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/flds(i)%nrec/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, flds(i)%ptr2i4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call read_tiled_file(filename, 'rainn_mp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%rainn_mp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + ! debug print + call ESMF_LogWrite(trim(subname)//' adding '//trim(flds(i)%short_name)//' to FB', ESMF_LOGMSG_INFO) + + ! add it to the field bundle on grid + call ESMF_FieldBundleAdd(FBgrid, [fgrid], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add it to the field bundle on mesh + call ESMF_FieldBundleAdd(FBmesh, [fmesh], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do !---------------------- - ! microphysics convective precipitation + ! Read data !---------------------- - call read_tiled_file(filename, 'rainc_mp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_FieldBundleRead(FBgrid, fileName=trim(filename), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%rainc_mp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) !---------------------- - ! microphysics snow + ! Create routehandle if it is not provided to transfer data from grid to mesh !---------------------- - call read_tiled_file(filename, 'snow_mp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snow_mp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + if (present(rh)) then + rh_local = rh + else + call ESMF_FieldBundleRedistStore(FBgrid, FBmesh, routehandle=rh_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !---------------------- - ! + ! Move data from ESMF grid to mesh !---------------------- - call read_tiled_file(filename, 'graupel_mp', noahmp, field, numrec=1, rc=rc) + call ESMF_FieldBundleRedist(FBgrid, FBmesh, rh_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%graupel_mp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + + !call FB_diagnose(FBmesh, trim(subname), rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! microphysics ice/hail + ! Apply masking !---------------------- - call read_tiled_file(filename, 'ice_mp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%ice_mp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + do i = 1, size(flds) + ! get field from FB + call ESMF_FieldBundleGet(FBmesh, fieldName=trim(flds(i)%short_name), field=fmesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! check its rank + call ESMF_FieldGet(fmesh, rank=rank, typekind=typekind, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! query pointer and apply mask + if (rank .eq. 1) then + if (amask .and. allocated(noahmp%domain%mask)) then + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fmesh, farrayPtr=ptr1r4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + where (noahmp%domain%mask < 1) ptr1r4 = 0.0_r4 + nullify(ptr1r4) + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fmesh, farrayPtr=ptr1r8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + where (noahmp%domain%mask < 1) ptr1r8 = 0.0_r8 + nullify(ptr1r8) + else if (typekind == ESMF_TYPEKIND_I4) then + call ESMF_FieldGet(fmesh, farrayPtr=ptr1i4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + where (noahmp%domain%mask < 1) ptr1i4 = 0 + nullify(ptr1i4) + end if + end if + + ! write field to VTK file + if (dbug > 0) then + call ESMF_FieldWriteVTK(fmesh, trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fmesh, farrayPtr=ptr2r4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (amask .and. allocated(noahmp%domain%mask)) then + do j = 1, flds(i)%nrec + where (noahmp%domain%mask < 1) ptr2r4(:,j) = 0.0_r4 + end do + end if + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fmesh, farrayPtr=ptr2r8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (amask .and. allocated(noahmp%domain%mask)) then + do j = 1, flds(i)%nrec + where (noahmp%domain%mask < 1) ptr2r8(:,j) = 0.0_r8 + end do + end if + else if (typekind == ESMF_TYPEKIND_I4) then + call ESMF_FieldGet(fmesh, farrayPtr=ptr2i4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (amask .and. allocated(noahmp%domain%mask)) then + do j = 1, flds(i)%nrec + where (noahmp%domain%mask < 1) ptr2i4(:,j) = 0 + end do + end if + end if + + ! write field to VTK file, each record seperate file + if (dbug > 0) then + do j = 1, flds(i)%nrec + ! file name + write(fname, fmt='(A,I2.2)') trim(flds(i)%short_name)//'_rec_', j + + ! 2d/r4 field (element,layer) + if (typekind == ESMF_TYPEKIND_R4) then + ! create temporary field and write it + ftmp = ESMF_FieldCreate(noahmp%domain%mesh, typekind=ESMF_TYPEKIND_R4, & + name=trim(flds(i)%short_name), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get pointer and fill it + call ESMF_FieldGet(ftmp, localDe=0, farrayPtr=ptr1r4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ptr1r4(:) = ptr2r4(:,j) + nullify(ptr1r4) + + ! 2d/r8 field (element,layer) + else if (typekind == ESMF_TYPEKIND_R8) then + ! create temporary field and write it + ftmp = ESMF_FieldCreate(noahmp%domain%mesh, typekind=ESMF_TYPEKIND_R8, & + name=trim(flds(i)%short_name), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get pointer and fill it + call ESMF_FieldGet(ftmp, localDe=0, farrayPtr=ptr1r8, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ptr1r8(:) = ptr2r8(:,j) + nullify(ptr1r8) + + ! 2d/i4 field (element,layer) + else if (typekind == ESMF_TYPEKIND_I4) then + ! create temporary field and write it + ftmp = ESMF_FieldCreate(noahmp%domain%mesh, typekind=ESMF_TYPEKIND_I4, & + name=trim(flds(i)%short_name), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get pointer and fill it + call ESMF_FieldGet(ftmp, localDe=0, farrayPtr=ptr1i4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ptr1i4(:) = ptr2i4(:,j) + nullify(ptr1i4) + + end if + + ! write + call ESMF_FieldWriteVTK(ftmp, trim(fname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! delete temporary field + call ESMF_FieldDestroy(ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + + ! nullify pointers + if (typekind == ESMF_TYPEKIND_R4) nullify(ptr2r4) + if (typekind == ESMF_TYPEKIND_R8) nullify(ptr2r8) + if (typekind == ESMF_TYPEKIND_I4) nullify(ptr2i4) + end if + end do !---------------------- - ! water equivalent accumulated snow depth + ! Empty FBs and destroy them !---------------------- - call read_tiled_file(filename, 'weasd', noahmp, field, numrec=1, rc=rc) + ! FB grid + call ESMF_FieldBundleGet(FBgrid, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBgrid, fieldNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%weasd(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - !---------------------- - ! snow depth (water equiv) over land - !---------------------- + do i = 1, fieldCount + ! pull field from FB + call ESMF_FieldBundleGet(FBgrid, fieldName=trim(fieldNameList(i)), field=ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call read_tiled_file(filename, 'snwdph', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + ! destroy field + call ESMF_FieldDestroy(ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! remove field from FB + call ESMF_FieldBundleRemove(FBgrid, fieldNameList=[trim(fieldNameList(i))], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + deallocate(fieldNameList) + + ! destroy grid FB + call ESMF_FieldBundleDestroy(FBgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snwdph(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - !---------------------- - ! ground surface skin temperature - !---------------------- + ! FB mesh + call ESMF_FieldBundleGet(FBmesh, fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call read_tiled_file(filename, 'tskin', noahmp, field, numrec=1, rc=rc) + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBmesh, fieldNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + + do i = 1, fieldCount + ! pull field from FB + call ESMF_FieldBundleGet(FBmesh, fieldName=trim(fieldNameList(i)), field=ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! destroy field + call ESMF_FieldDestroy(ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! remove field from FB + call ESMF_FieldBundleRemove(FBmesh, fieldNameList=[trim(fieldNameList(i))], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + deallocate(fieldNameList) + + ! destroy grid FB + call ESMF_FieldBundleDestroy(FBmesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tskin(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) !---------------------- - ! snow/rain flag for precipitation + ! Destroy route handle if it is created locally !---------------------- - call read_tiled_file(filename, 'srflag', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%srflag(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + if (.not. present(rh)) then + call ESMF_RouteHandleDestroy(rh_local, rc=rc) + end if + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine read_tiled_file + + !=============================================================================== + subroutine write_tiled_file(filename, noahmp, outflds, now_time, vm, localPet, rh, rc) + ! use statement + use netcdf + + ! input/output variables + character(len=*) , intent(in) :: filename + type(noahmp_type) , target, intent(inout) :: noahmp + type(field_type) , intent(in) :: outflds(:) + real(ESMF_KIND_R8), intent(in) :: now_time + integer , intent(in) :: localPet + type(ESMF_VM) , intent(in) :: vm + type(ESMF_RouteHandle), optional, intent(in) :: rh + integer , optional, intent(inout) :: rc + + ! local variables + integer :: i, j, k, rank, nlev, nfld, sub_str_indx + integer :: ncerr, ncid, varid, dimid, max_indx + real(r4), pointer :: ptr2r4(:,:) + real(r8), pointer :: ptr2r8(:,:) + integer , pointer :: ptr2i4(:,:) + integer , pointer :: ptrMask(:,:) + real(r4), pointer :: ptr3r4(:,:,:) + real(r8), pointer :: ptr3r8(:,:,:) + integer , pointer :: ptr3i4(:,:,:) + character(cl) :: zaxis_name + character(cl), allocatable :: fieldNameList(:) + character(cl) :: filename_tile + logical :: file_exists + logical :: flag_soil_levels + logical :: flag_snow_levels + logical :: flag_snso_levels + type(ESMF_RouteHandle) :: rh_local + type(ESMF_FieldBundle) :: FBgrid, FBmesh + type(ESMF_ArraySpec) :: arraySpecI4, arraySpecR4, arraySpecR8 + type(ESMF_Field) :: fgrid, fmesh + type(ESMF_TypeKind_Flag) :: typekind + type(ESMF_LocStream) :: locs + type(ESMF_Grid) :: grid + type(ESMF_DistGrid) :: distgrid + character(len=*), parameter :: subname = trim(modName)//': (write_tiled_file) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//' called for '//trim(filename), ESMF_LOGMSG_INFO) !---------------------- - ! canopy moisture content + ! Remove existing file !---------------------- - call read_tiled_file(filename, 'canopy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + if (localPet == 0) then + ! loop over tiles + do i = 1, noahmp%domain%ntiles + ! file name for tile + sub_str_indx = index(trim(filename), "*", .true.) + write(filename_tile, fmt='(a,i1,a)') trim(filename(:sub_str_indx-1)), i , trim(filename(sub_str_indx+1:)) + + ! check file and delete + inquire(file=trim(filename_tile), exist=file_exists) + if (file_exists) then + call ESMF_LogWrite(trim(subname)//' deleting '//trim(filename_tile), ESMF_LOGMSG_INFO) + call system('rm -f '//trim(filename_tile)) + end if + end do + end if + + call ESMF_VMBarrier(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%canopy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) !---------------------- - ! total plant transpiration + ! Create field bundles !---------------------- - call read_tiled_file(filename, 'trans', noahmp, field, numrec=1, rc=rc) + ! create empty field bundle on grid + FBgrid = ESMF_FieldBundleCreate(name="fields_on_grid", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + + ! create empty field bundle on mesh + FBmesh = ESMF_FieldBundleCreate(name="fields_on_mesh", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%trans(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) !---------------------- - ! surface skin temperature (after iteration) + ! Add metadata to grid !---------------------- - call read_tiled_file(filename, 'tsurf', noahmp, field, numrec=1, rc=rc) + ! add coordinate dimensions: grid_xt and grid_yt + call ESMF_AttributeAdd(noahmp%domain%grid, convention="NetCDF", purpose="NOAHMP", attrList=(/"ESMF:gridded_dim_labels"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(noahmp%domain%grid, convention="NetCDF", purpose="NOAHMP", name="ESMF:gridded_dim_labels", valueList=(/"grid_xt", "grid_yt"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tsurf(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) !---------------------- - ! surface roughness + ! Add coordinate variables (horizontal) !---------------------- - call read_tiled_file(filename, 'zorl', noahmp, field, numrec=1, rc=rc) + ! create field for x coordinate on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, farray=noahmp%domain%lont, indexflag=ESMF_INDEX_GLOBAL, & + staggerloc=ESMF_STAGGERLOC_CENTER, name="grid_xt", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%zorl(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! bulk Richardson number at the surface over land - !---------------------- - - call read_tiled_file(filename, 'rb1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%rb1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! Monin-Obukhov similarity function for momentum over land - !---------------------- - - call read_tiled_file(filename, 'fm1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%fm1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! Monin-Obukhov similarity function for heat over land - !---------------------- - - call read_tiled_file(filename, 'fh1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%fh1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! surface friction velocity over land - !---------------------- - - call read_tiled_file(filename, 'ustar1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%ustar1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! surface wind stress over land - !---------------------- - - call read_tiled_file(filename, 'stress1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%stress1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! Monin-Obukhov similarity parameter for momentum at 10m over land - !---------------------- - - call read_tiled_file(filename, 'fm101', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%fm101(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! Monin-Obukhov similarity parameter for heat at 2m over land - !---------------------- - - call read_tiled_file(filename, 'fh21', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%fh21(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! actual no. of snow layers - !---------------------- - - call read_tiled_file(filename, 'snowxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snowxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! vegetation leaf temperature - !---------------------- - - call read_tiled_file(filename, 'tvxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tvxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! bulk ground surface temperature - !---------------------- - - call read_tiled_file(filename, 'tgxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tgxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! canopy-intercepted ice - !---------------------- - - call read_tiled_file(filename, 'canicexy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%canicexy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! canopy-intercepted liquid water - !---------------------- - - call read_tiled_file(filename, 'canliqxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%canliqxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! canopy air vapor pressure - !---------------------- - - call read_tiled_file(filename, 'eahxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%eahxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! canopy air temperature - !---------------------- - - call read_tiled_file(filename, 'tahxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tahxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! bulk momentum drag coefficient - !---------------------- - - call read_tiled_file(filename, 'cmxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%cmxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! bulk sensible heat exchange coefficient - !---------------------- - - call read_tiled_file(filename, 'chxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%chxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! wetted or snowed fraction of the canopy - !---------------------- - - call read_tiled_file(filename, 'fwetxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%fwetxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! snow mass at last time step - !---------------------- - - call read_tiled_file(filename, 'sneqvoxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%sneqvoxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! snow albedo at last time step - !---------------------- - - call read_tiled_file(filename, 'alboldxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%alboldxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! snowfall on the ground - !---------------------- - - call read_tiled_file(filename, 'qsnowxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%qsnowxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! lake water storage - !---------------------- - - call read_tiled_file(filename, 'wslakexy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%wslakexy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! water table depth - !---------------------- - - call read_tiled_file(filename, 'zwtxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%zwtxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! water in the aquifer - !---------------------- - - call read_tiled_file(filename, 'waxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%waxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! groundwater storage - !---------------------- - - call read_tiled_file(filename, 'wtxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%wtxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! leaf mass - !---------------------- - - call read_tiled_file(filename, 'lfmassxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%lfmassxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! mass of fine roots - !---------------------- - - call read_tiled_file(filename, 'rtmassxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%rtmassxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! stem mas - !---------------------- - - call read_tiled_file(filename, 'stmassxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%stmassxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! mass of wood incl woody roots - !---------------------- - - call read_tiled_file(filename, 'woodxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%woodxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! stable carbon in deep soil - !---------------------- - - call read_tiled_file(filename, 'stblcpxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%stblcpxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! short-lived carbon, shallow soil - !---------------------- - - call read_tiled_file(filename, 'fastcpxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%fastcpxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! leaf area index - !---------------------- - - call read_tiled_file(filename, 'xlaixy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%xlaixy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! stem area index - !---------------------- - - call read_tiled_file(filename, 'xsaixy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%xsaixy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! snow age factor - !---------------------- - - call read_tiled_file(filename, 'taussxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%taussxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! soil moisture content in the layer to the water table when deep - !---------------------- - - call read_tiled_file(filename, 'smcwtdxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%smcwtdxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! recharge to the water table when deep - !---------------------- - - call read_tiled_file(filename, 'deeprechxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%deeprechxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! recharge to the water table (diagnostic) - !---------------------- - - call read_tiled_file(filename, 'rechxy', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%rechxy(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! albedo - direct visible - !---------------------- - - call read_tiled_file(filename, 'albdvis', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%albdvis(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! albedo - direct NIR - !---------------------- - - call read_tiled_file(filename, 'albdnir', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%albdnir(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! albedo - diffuse visible - !---------------------- - - call read_tiled_file(filename, 'albivis', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%albivis(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! albedo - diffuse NIR - !---------------------- - - call read_tiled_file(filename, 'albinir', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%albinir(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! surface emissivity - !---------------------- - - call read_tiled_file(filename, 'emiss', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%emiss(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! snow cover over land - !---------------------- - - call read_tiled_file(filename, 'sncovr1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%sncovr1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! specific humidity at sfc - !---------------------- - - call read_tiled_file(filename, 'qsurf', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%qsurf(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! soil heat flux - !---------------------- - - call read_tiled_file(filename, 'gflux', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%gflux(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! subsurface runoff - !---------------------- - - call read_tiled_file(filename, 'drain', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%drain(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! evaporation from latent heat flux - !---------------------- - - call read_tiled_file(filename, 'evap', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%evap(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! sensible heat flux - !---------------------- - - call read_tiled_file(filename, 'hflx', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%hflx(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! potential evaporation - !---------------------- - - call read_tiled_file(filename, 'ep', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%ep(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! surface runoff - !---------------------- - - call read_tiled_file(filename, 'runoff', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%runoff(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! cm * rho - !---------------------- - - call read_tiled_file(filename, 'cmm', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%cmm(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! ch * rho - !---------------------- - - call read_tiled_file(filename, 'chh', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%chh(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! direct soil evaporation - !---------------------- - - call read_tiled_file(filename, 'evbs', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%evbs(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! canopy water evaporation - !---------------------- - - call read_tiled_file(filename, 'evcw', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%evcw(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! sublimation/deposit from snopack - !---------------------- - - call read_tiled_file(filename, 'sbsno', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%sbsno(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! precipitation advected heat - total - !---------------------- - - call read_tiled_file(filename, 'pah', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%pah(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! evaporation of intercepted water - !---------------------- - - call read_tiled_file(filename, 'ecan', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%ecan(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! transpiration rate - !---------------------- - - call read_tiled_file(filename, 'etran', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%etran(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! soil surface evaporation rate - !---------------------- - - call read_tiled_file(filename, 'edir', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%edir(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! fractional snow cover - !---------------------- - - call read_tiled_file(filename, 'snowc', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snowc(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! total soil column moisture content - !---------------------- - - call read_tiled_file(filename, 'stm', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%stm(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! snow/freezing-rain latent heat flux - !---------------------- - - call read_tiled_file(filename, 'snohf', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snohf(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! dry soil moisture threshold - !---------------------- - - call read_tiled_file(filename, 'smcwlt2', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%smcwlt2(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! soil moisture threshold - !---------------------- - - call read_tiled_file(filename, 'smcref2', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%smcref2(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! normalized soil wetness - !---------------------- - - call read_tiled_file(filename, 'wet1', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%wet1(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! combined T2m from tiles - !---------------------- - - call read_tiled_file(filename, 't2mmp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%t2mmp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! combined q2m from tiles - !---------------------- - - call read_tiled_file(filename, 'q2mp', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%q2mp(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! function of surface roughness length and green vegetation fraction - !---------------------- - - call read_tiled_file(filename, 'zvfun', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%zvfun(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - - !---------------------- - ! total soil moisture content - !---------------------- - - call read_tiled_file(filename, 'smc', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%smc(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! soil temperature - !---------------------- - call read_tiled_file(filename, 'stc', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) + ! add coordinate attributes to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/"cartesian_axis"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name="cartesian_axis", value="X", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%stc(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/"long_name"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! liquid soil moisture - !---------------------- - - call read_tiled_file(filename, 'slc', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name="long_name", value="T-cell longitude", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/"units"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%slc(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name="units", value="degrees_E", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- - ! equilibrium soil water content - !---------------------- - - call read_tiled_file(filename, 'smoiseq', noahmp, field, numrec=1, numlev=noahmp%nmlist%num_soil_levels, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + ! write to the file + call ESMF_FieldWrite(fgrid, fileName=trim(filename), convention="NetCDF", purpose="NOAHMP", overwrite=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%smoiseq(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + + ! destroy field + call ESMF_FieldDestroy(fgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- - ! temperature in surface snow - !---------------------- + ! create field for y coordinate on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, farray=noahmp%domain%latt, indexflag=ESMF_INDEX_GLOBAL, & + staggerloc=ESMF_STAGGERLOC_CENTER, name="grid_yt", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call read_tiled_file(filename, 'tsnoxy', noahmp, field, numrec=1, numlev=abs(noahmp%static%lsnowl)+1, rc=rc) + ! add coordinate attributes to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/"cartesian_axis"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name="cartesian_axis", value="Y", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tsnoxy(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/"long_name"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! lwe thickness of ice in surface snow - !---------------------- - - call read_tiled_file(filename, 'snicexy', noahmp, field, numrec=1, numlev=abs(noahmp%static%lsnowl)+1, rc=rc) + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name="long_name", value="T-cell latitude", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/"units"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snicexy(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name="units", value="degrees_N", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- - ! snow layer liquid water - !---------------------- - - call read_tiled_file(filename, 'snliqxy', noahmp, field, numrec=1, numlev=abs(noahmp%static%lsnowl)+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + ! write to the file + call ESMF_FieldWrite(fgrid, fileName=trim(filename), convention="NetCDF", purpose="NOAHMP", & + status=ESMF_FILESTATUS_OLD, overwrite=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snliqxy(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + + ! destroy field + call ESMF_FieldDestroy(fgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! depth from the top of the snow surface at the bottom of the layer + ! Loop over fields and add them to the field bundles !---------------------- - call read_tiled_file(filename, 'zsnsoxy', noahmp, field, numrec=1, numlev=abs(noahmp%static%lsnowl)+noahmp%nmlist%num_soil_levels+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%zsnsoxy(:,:) = ptr(:,:,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine read_restart + ! init flags + flag_soil_levels = .false. + flag_snow_levels = .false. + flag_snso_levels = .false. - !=============================================================================== - subroutine read_static(noahmp, rc) + ! get number of fields + max_indx = count(outflds(:)%id /= -999, 1) - ! input/output variables - type(noahmp_type), intent(inout) :: noahmp - integer , intent(inout) :: rc + do i = 1, max_indx + ! debug information + if (dbug > 0) then + call ESMF_LogWrite(trim(subname)//' adding '//trim(outflds(i)%short_name), ESMF_LOGMSG_INFO) + end if - ! local variables - integer :: nt - character(len=CL) :: filename - real(ESMF_KIND_R8), pointer :: ptr(:,:,:) - type(ESMF_Field) :: field - real(ESMF_KIND_R8), parameter :: pi_8 = 3.14159265358979323846_r8 - character(len=*), parameter :: subname=trim(modName)//':(read_static) ' - !------------------------------------------------------------------------------- + ! set size and name of z-axis + nlev = 0 + if (trim(outflds(i)%zaxis) == "z") then + nlev = size(noahmp%nmlist%soil_level_nodes) + zaxis_name = "soil_levels" + flag_soil_levels = .true. + else if (trim(outflds(i)%zaxis) == "z1") then + nlev = abs(noahmp%static%lsnowl)+1 + zaxis_name = "snow_levels" + flag_snow_levels = .true. + else if (trim(outflds(i)%zaxis) == "z2") then + nlev = size(noahmp%nmlist%soil_level_nodes)+abs(noahmp%static%lsnowl)+1 + zaxis_name = "snso_levels" + flag_snso_levels = .true. + end if - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! 2d/r8 field (x,y) + if (associated(outflds(i)%ptr1r8)) then + ! set field type + call ESMF_ArraySpecSet(arraySpecR8, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpecR8, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(outflds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add missing value attribute to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'missing_value'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='missing_value', value=missing_r8, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, outflds(i)%ptr1r8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(outflds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 2d/r4 field (x,y) + else if (associated(outflds(i)%ptr1r4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpecR4, typekind=ESMF_TYPEKIND_R4, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpecR4, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(outflds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add missing value attribute to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'missing_value'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='missing_value', value=missing_r4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, outflds(i)%ptr1r4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(outflds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 2d/i4 field (x,y) + else if (associated(outflds(i)%ptr1i4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpecI4, typekind=ESMF_TYPEKIND_I4, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpecI4, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(outflds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add missing value attribute to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'missing_value'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='missing_value', value=missing_i4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, outflds(i)%ptr1i4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(outflds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/r8 field (x,y,z) + else if (associated(outflds(i)%ptr2r8)) then + ! set field type + call ESMF_ArraySpecSet(arraySpecR8, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpecR8, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(outflds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/nlev/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add missing value attribute to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'missing_value'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='missing_value', value=missing_r8, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, outflds(i)%ptr2r8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(outflds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/r4 field (x,y,z) + else if (associated(outflds(i)%ptr2r4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpecR4, typekind=ESMF_TYPEKIND_R4, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpecR4, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(outflds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/nlev/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add missing value attribute to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'missing_value'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='missing_value', value=missing_r4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, outflds(i)%ptr2r4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(outflds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/i4 field (x,y,z) + else if (associated(outflds(i)%ptr2i4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpecI4, typekind=ESMF_TYPEKIND_I4, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(noahmp%domain%grid, arraySpecI4, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(outflds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/nlev/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add missing value attribute to the field + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'missing_value'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='missing_value', value=missing_i4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(noahmp%domain%mesh, outflds(i)%ptr2i4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(outflds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !---------------------- - ! Read latitude, we could also retrive from ESMF mesh object - !---------------------- + ! add long_name and units attributes to the field on grid + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'long_name'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='long_name', value=trim(outflds(i)%long_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - filename = trim(noahmp%nmlist%input_dir)//'oro_data.tile' - call read_tiled_file(filename, 'geolat', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%xlatin(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/'units'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name='units', value=trim(outflds(i)%units), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! convert it to radian - noahmp%model%xlatin(:) = noahmp%model%xlatin(:)*pi_8/180.0_r8 + ! add vertical dimension name to the field on grid if it has ungridded dimension + if (nlev > 0) then + call ESMF_AttributeAdd(fgrid, convention="NetCDF", purpose="NOAHMP", attrList=(/"ESMF:ungridded_dim_labels"/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(fgrid, convention="NetCDF", purpose="NOAHMP", name="ESMF:ungridded_dim_labels", valueList=(/trim(zaxis_name)/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !---------------------- - ! Read soil type - !---------------------- + ! add it to the field bundle on grid + call ESMF_FieldBundleAdd(FBgrid, [fgrid], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.soil_type.tile' - call read_tiled_file(filename, 'soil_type', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%soiltyp(:) = int(ptr(:,1,1)) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! add it to the field bundle on mesh + call ESMF_FieldBundleAdd(FBmesh, [fmesh], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do !---------------------- - ! Read vegetation type + ! Add metadata to FB, global attributes !---------------------- - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.vegetation_type.tile' - call read_tiled_file(filename, 'vegetation_type', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeAdd(FBgrid, convention="NetCDF", purpose="NOAHMP", & + attrList=(/ "delt ", & + "idveg ", & + "iopt_crs ", & + "iopt_btr ", & + "iopt_run ", & + "iopt_sfc ", & + "iopt_frz ", & + "iopt_inf ", & + "iopt_rad ", & + "iopt_alb ", & + "iopt_snf ", & + "iopt_tbot", & + "iopt_stc ", & + "iopt_trs " /), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%vegtype(:) = int(ptr(:,1,1)) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Read slope type - !---------------------- - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.slope_type.tile' - call read_tiled_file(filename, 'slope_type', noahmp, field, numrec=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="delt" , value=noahmp%static%delt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%slopetyp(:) = int(ptr(:,1,1)) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="idveg" , value=noahmp%static%idveg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Read deep soil temperature - !---------------------- - - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.substrate_temperature.tile' - call read_tiled_file(filename, 'substrate_temperature', noahmp, field, numrec=1, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_crs" , value=noahmp%static%iopt_crs, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_btr" , value=noahmp%static%iopt_btr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%tg3(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_run" , value=noahmp%static%iopt_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Read maximum snow albedo - !---------------------- - - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.maximum_snow_albedo.tile' - call read_tiled_file(filename, 'maximum_snow_albedo', noahmp, field, numrec=1, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_sfc" , value=noahmp%static%iopt_sfc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_frz" , value=noahmp%static%iopt_frz, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%snoalb(:) = ptr(:,1,1) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_inf" , value=noahmp%static%iopt_inf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Read vegetation greenness, monthly average - !---------------------- - - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.vegetation_greenness.tile' - call read_tiled_file(filename, 'vegetation_greenness', noahmp, field, numrec=12, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_rad" , value=noahmp%static%iopt_rad, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_alb" , value=noahmp%static%iopt_alb, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%gvf_monthly(:,:) = ptr(:,1,:) - noahmp%model%shdmin(:) = minval(ptr(:,1,:), dim=2) - noahmp%model%shdmax(:) = maxval(ptr(:,1,:), dim=2) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_snf" , value=noahmp%static%iopt_snf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------- - ! Soil color - !---------------------- - - write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', maxval(noahmp%domain%nit), '.soil_color.tile' - call read_tiled_file(filename, 'soil_color', noahmp, field, numrec=1, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_tbot", value=noahmp%static%iopt_tbot, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_stc" , value=noahmp%static%iopt_stc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - noahmp%model%soilcol(:) = int(ptr(:,1,1)) - nullify(ptr) - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_AttributeSet(FBgrid, convention="NetCDF", purpose="NOAHMP", name="iopt_trs" , value=noahmp%static%iopt_trs, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Set land-sea mask (dry) - !---------------------- - - noahmp%model%dry(:) = .false. - where(noahmp%domain%mask(:) > 0) noahmp%model%dry(:) = .true. - - end subroutine read_static - - !=============================================================================== - subroutine read_tiled_file(filename, varname, noahmp, field, numrec, numlev, rc) - - ! input/output variables - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - type(noahmp_type), intent(inout) :: noahmp - type(ESMF_Field), intent(inout) :: field - integer, intent(in), optional :: numrec - integer, intent(in), optional :: numlev - integer, intent(inout), optional :: rc - - ! local variables - integer :: funit, my_tile, n, i, j, nt, nl - integer :: ndim, nvar, natt, ntime - integer :: isc, iec, jsc, jec - logical :: not_found, is_root_pe - integer, allocatable :: dimsizes(:) - character(len=CL) :: cname, fname - real(ESMF_KIND_R8), pointer :: ptr(:), ptr3d(:,:,:), ptr4d(:,:,:,:) - real(ESMF_KIND_R8), allocatable :: rdata(:,:,:,:) - type(fieldtype), allocatable :: vars(:) - type(ESMF_Field) :: field_src, field_tmp - type(ESMF_ArraySpec) :: arraySpec - character(len=*), parameter :: subname=trim(modName)//': (read_tiled_file) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called for '//trim(varname), ESMF_LOGMSG_INFO) - - !---------------------- - ! Define required variables + ! Create routehandle if it is not provided to transfer data from mesh to grid !---------------------- - if (present(numrec)) then - nt = numrec - else - nt = 1 - end if - - if (present(numlev)) then - nl = numlev + if (present(rh)) then + rh_local = rh else - nl = 1 + call ESMF_FieldBundleRedistStore(FBmesh, FBgrid, routehandle=rh_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - my_tile = int(mpp_pe()/(noahmp%domain%layout(1)*noahmp%domain%layout(2)))+1 - - is_root_pe = .false. - if (mpp_pe() == (my_tile-1)*(noahmp%domain%layout(1)*noahmp%domain%layout(2))) is_root_pe = .true. - !---------------------- - ! Open file and query file attributes + ! Move data from ESMF grid to mesh !---------------------- - - write(cname, fmt='(A,I1,A)') trim(filename), my_tile, '.nc' - call mpp_open(funit, trim(cname), action=MPP_RDONLY, form=MPP_NETCDF, & - threading=MPP_MULTI, fileset=MPP_SINGLE, is_root_pe=is_root_pe) - call mpp_get_info(funit, ndim, nvar, natt, ntime) - allocate(vars(nvar)) - call mpp_get_fields(funit, vars(:)) + + call ESMF_FieldBundleRedist(FBmesh, FBgrid, rh_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Read requested variable + ! Loop over fields on grid and apply mask !---------------------- - not_found = .true. - do n = 1, nvar - ! get variable name - call mpp_get_atts(vars(n), name=cname) - - ! check variable name - if (trim(cname) == trim(varname)) then - ! get array bounds or domain - call mpp_get_compute_domain(noahmp%domain%mosaic_domain, isc, iec, jsc, jec) + ! query mask information + call ESMF_FieldBundleGet(FBgrid, fieldName="mask", field=fgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! allocate data array and set initial value - allocate(rdata(isc:iec,jsc:jec,nl,nt)) - rdata(:,:,:,:) = 0.0_r8 + call ESMF_FieldGet(fgrid, farrayPtr=ptrMask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! read data - do i = 1, nt - call mpp_read(funit, vars(n), noahmp%domain%mosaic_domain, rdata, 1) - end do - - ! set missing values to zero - where (rdata == 1.0d20) - rdata(:,:,:,:) = 0.0_r8 - end where + ! apply mask + do i = 1, max_indx + ! get field from FB + call ESMF_FieldBundleGet(FBgrid, fieldName=trim(outflds(i)%short_name), field=fgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! query type of the field + call ESMF_FieldGet(fgrid, rank=rank, typekind=typekind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! query pointer and apply mask + if (rank .eq. 2) then + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fgrid, farrayPtr=ptr2r4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + where(ptrMask < 1) ptr2r4 = missing_r4 + nullify(ptr2r4) + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fgrid, farrayPtr=ptr2r8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + where(ptrMask < 1) ptr2r8 = missing_r8 + nullify(ptr2r8) + else if (typekind == ESMF_TYPEKIND_I4) then + call ESMF_FieldGet(fgrid, farrayPtr=ptr2i4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + where(ptrMask < 1) ptr2i4 = missing_i4 + nullify(ptr2i4) + end if + else if (rank .eq. 3) then + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fgrid, farrayPtr=ptr3r4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do k = 1, ubound(ptr3r4, dim=3) + where(ptrMask < 1) ptr3r4(:,:,k) = missing_r4 + end do + nullify(ptr3r4) + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fgrid, farrayPtr=ptr3r8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do k = 1, ubound(ptr3r8, dim=3) + where(ptrMask < 1) ptr3r8(:,:,k) = missing_r8 + end do + nullify(ptr3r8) + else if (typekind == ESMF_TYPEKIND_I4) then + call ESMF_FieldGet(fgrid, farrayPtr=ptr3i4, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do k = 1, ubound(ptr3i4, dim=3) + where(ptrMask < 1) ptr3i4(:,:,k) = missing_i4 + end do + nullify(ptr3i4) + end if end if - - not_found = .false. end do - if (not_found) then - call mpp_error(FATAL, 'File being read is not the expected one. '//trim(varname)//' is not found.') - end if - !---------------------- - ! Move data from ESMF grid to mesh + ! Append fields to file !---------------------- - ! set type and rank for ESMF arrayspec - call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=4, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create source field - field_src = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & - indexflag=ESMF_INDEX_GLOBAL, ungriddedLBound=(/1,1/), ungriddedUBound=(/nl,nt/), & - gridToFieldMap=(/1,2/), name=trim(varname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! get pointer and fill it - call ESMF_FieldGet(field_src, localDe=0, farrayPtr=ptr4d, rc=rc) + call ESMF_FieldBundleWrite(FBgrid, fileName=trim(filename), convention="NetCDF", purpose="NOAHMP", timeslice=1, overwrite=.true., status=ESMF_FILESTATUS_OLD, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ptr4d(:,:,:,:) = rdata(:,:,:,:) - nullify(ptr4d) - if (allocated(rdata)) deallocate(rdata) - ! create destination field - field = ESMF_FieldCreate(noahmp%domain%mesh, ESMF_TYPEKIND_R8, name=trim(varname), & - meshloc=ESMF_MESHLOC_ELEMENT, ungriddedLbound=(/1,1/), & - ungriddedUbound=(/nl,nt/), gridToFieldMap=(/1/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create routehandle from grid to mesh - call ESMF_FieldRegridStore(field_src, field, routehandle=noahmp%domain%rh_grid2mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! redist field from ESMF Grid to Mesh - call ESMF_FieldRedist(field_src, field, noahmp%domain%rh_grid2mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! clean memory - call ESMF_FieldDestroy(field_src, rc=rc) + call ESMF_VMBarrier(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Output result field for debugging purpose + ! Append coordinate variables (vertical and time) + ! TODO: It uses serial netcdf library, once ESMF I/O layer extended to support + ! adding coordinate variables and their attributes, this part will be removed. !---------------------- - if (dbug > 1) then - ! TODO: ESMF_FieldWriteVTK() call does not support ungridded dimension - ! The workaround is implemented in here but it would be nice to extend - ! ESMF_FieldWriteVTK() call to handle it. - field_tmp = ESMF_FieldCreate(noahmp%domain%mesh, ESMF_TYPEKIND_R8, & - name=trim(varname), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(field_tmp, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(field, localDe=0, farrayPtr=ptr3d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! write to different file along ungridded dimension - do i = 1, nl - do j = 1, nt - ptr(:) = ptr3d(:,i,j) - write(fname, fmt='(A,I2.2,A,I2.2)') trim(varname)//'_lev', i, '_time', j - call ESMF_FieldWriteVTK(field_tmp, trim(fname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - end do - - ! clean memory - nullify(ptr) - nullify(ptr3d) - call ESMF_FieldDestroy(field_tmp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! only on the root pet + if (localPet == 0) then + ! loop over tiles + do i = 1, noahmp%domain%ntiles + ! file name for tile + sub_str_indx = index(trim(filename), "*", .true.) + write(filename_tile, fmt='(a,i1,a)') trim(filename(:sub_str_indx-1)), i , trim(filename(sub_str_indx+1:)) + + ! open file + ncerr = nf90_open(trim(filename_tile), NF90_WRITE, ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + !---------------------- - end subroutine read_tiled_file + ! enter define mode + ncerr = nf90_redef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return - !=============================================================================== - subroutine write_mosaic_output(filename, noahmp, now_time, rc) + ! check time dimension + ncerr = nf90_inq_dimid(ncid, "time", dimid=dimid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return - ! input/output variables - character(len=*) , intent(in) :: filename - type(noahmp_type) , intent(inout) :: noahmp - real(ESMF_KIND_R8), intent(in) :: now_time - integer , intent(inout) :: rc + ! if the time dimension does not exist, add it + if (ncerr /= NF90_NOERR) then + ncerr = nf90_def_dim(ncid, "time", NF90_UNLIMITED, dimid=dimid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + end if - ! local variables - logical, save :: first_time = .true. - integer :: i, j, id, fid, my_tile - integer :: nx, ny, nz, max_level - logical :: fopen, is_root_pe - character(len=cl) :: output_filename, prevar - real*8, allocatable, save :: data3d(:,:,:) - real*8, allocatable, save :: data4d(:,:,:,:) - type(axistype) :: x, y, z, z1, z2, t - type(fieldtype) :: f, f1, f2 - type(domain1D) :: xdom, ydom - type(ESMF_ArraySpec) :: arraySpec - type(ESMF_Field), save :: field_grid, field_mesh - real(ESMF_KIND_R8), pointer :: ptr2d(:,:) - real(ESMF_KIND_R8), pointer :: ptr3d(:,:,:) - character(len=*), parameter :: subname=trim(modName)//':(write_mosaic_output) ' - !------------------------------------------------------------------------------- + ! define variable + ncerr = nf90_def_var(ncid, "time", NF90_DOUBLE, dimids=(/dimid/), varid=varid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add attributes + ncerr = nf90_put_att(ncid, varid, "long_name", "valid time") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + ncerr = nf90_put_att(ncid, varid, "units", "seconds since "//trim(noahmp%model%reference_date)) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + ncerr = nf90_put_att(ncid, varid, "calendar", "gregorian") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + ncerr = nf90_put_att(ncid, varid, "cartesian_axis", "T") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! exit from define mode + ncerr = nf90_enddef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add value to time + ncerr = nf90_put_var(ncid, varid, values=[now_time]) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + !---------------------- + + if (flag_soil_levels) then + ! enter define mode + ncerr = nf90_redef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! check soil_levels dimension + ncerr = nf90_inq_dimid(ncid, "soil_levels", dimid=dimid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! define variable + ncerr = nf90_def_var(ncid, "soil_levels", NF90_DOUBLE, dimids=(/dimid/), varid=varid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add attributes + ncerr = nf90_put_att(ncid, varid, "long_name", "soil levels") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + ncerr = nf90_put_att(ncid, varid, "units", "meters") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! exit from define mode + ncerr = nf90_enddef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add value to soil levels + ncerr = nf90_put_var(ncid, varid, values=noahmp%nmlist%soil_level_nodes) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + end if - !---------------------- - ! Define required variables - !---------------------- + !---------------------- - my_tile = int(mpp_pe()/(noahmp%domain%layout(1)*noahmp%domain%layout(2)))+1 + if (flag_snow_levels) then + ! enter define mode + ncerr = nf90_redef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return - is_root_pe = .false. - if (mpp_pe() == (my_tile-1)*(noahmp%domain%layout(1)*noahmp%domain%layout(2))) is_root_pe = .true. + ! check snow_levels dimension + ncerr = nf90_inq_dimid(ncid, "snow_levels", dimid=dimid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return - !---------------------- - ! open file - !---------------------- + ! define variable + ncerr = nf90_def_var(ncid, "snow_levels", NF90_DOUBLE, dimids=(/dimid/), varid=varid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add attributes + ncerr = nf90_put_att(ncid, varid, "long_name", "snow levels") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + ncerr = nf90_put_att(ncid, varid, "units", "unitless") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! exit from define mode + ncerr = nf90_enddef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add value to snow levels + ncerr = nf90_put_var(ncid, varid, values=(/(j*1.0d0,j=noahmp%static%lsnowl,0)/)) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + end if - ! check unit - fid = 7 - do - inquire(unit=fid, opened=fopen) - if (.not. fopen) exit - fid = fid+1 - if (fid .eq. 100) call mpp_error(FATAL, 'Unable to locate unit number.') - end do + !---------------------- - ! open file - write(output_filename, fmt='(a,i1)') trim(filename)//'.tile', my_tile - call mpp_open(fid, output_filename, action=MPP_OVERWR, form=MPP_NETCDF, & - threading=MPP_SINGLE, domain=noahmp%domain%mosaic_domain, & - is_root_pe=is_root_pe) + if (flag_snso_levels) then + ! enter define mode + ncerr = nf90_redef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return - !---------------------- - ! add global attributes to file, provenance information - !---------------------- + ! check snso_levels dimension + ncerr = nf90_inq_dimid(ncid, "snso_levels", dimid=dimid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! define variable + ncerr = nf90_def_var(ncid, "snso_levels", NF90_DOUBLE, dimids=(/dimid/), varid=varid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add attributes + ncerr = nf90_put_att(ncid, varid, "long_name", "snow soil levels") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + ncerr = nf90_put_att(ncid, varid, "units", "unitless") + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! exit from define mode + ncerr = nf90_enddef(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + + ! add value to snow levels + ncerr = nf90_put_var(ncid, varid, values=(/(j*1.0d0,j=noahmp%static%lsnowl,noahmp%nmlist%num_soil_levels)/)) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + end if - call mpp_write_meta(fid, 'delt' , noahmp%static%delt) - call mpp_write_meta(fid, 'idveg' , ival=noahmp%static%idveg) - call mpp_write_meta(fid, 'iopt_crs' , ival=noahmp%static%iopt_crs) - call mpp_write_meta(fid, 'iopt_btr' , ival=noahmp%static%iopt_btr) - call mpp_write_meta(fid, 'iopt_run' , ival=noahmp%static%iopt_run) - call mpp_write_meta(fid, 'iopt_sfc' , ival=noahmp%static%iopt_sfc) - call mpp_write_meta(fid, 'iopt_frz' , ival=noahmp%static%iopt_frz) - call mpp_write_meta(fid, 'iopt_inf' , ival=noahmp%static%iopt_inf) - call mpp_write_meta(fid, 'iopt_rad' , ival=noahmp%static%iopt_rad) - call mpp_write_meta(fid, 'iopt_alb' , ival=noahmp%static%iopt_alb) - call mpp_write_meta(fid, 'iopt_snf' , ival=noahmp%static%iopt_snf) - call mpp_write_meta(fid, 'iopt_tbot', ival=noahmp%static%iopt_tbot) - call mpp_write_meta(fid, 'iopt_stc' , ival=noahmp%static%iopt_stc) - call mpp_write_meta(fid, 'iopt_trs' , ival=noahmp%static%iopt_trs) + ! close file + ncerr = nf90_close(ncid=ncid) + if (ChkErrNc(ncerr,__LINE__,u_FILE_u)) return + end do + end if !---------------------- - ! define dimensions + ! Empty FBs and destroy them !---------------------- - ! query domain to get x and y components - call mpp_get_domain_components(noahmp%domain%mosaic_domain, xdom, ydom) - - ! x-axis - nx = noahmp%domain%nit(my_tile) - call mpp_write_meta(fid, x, 'xc', 'unitless', 'x-coordinate', cartesian='X', domain=xdom, data=(/(i*1.0d0,i=1,nx)/)) - - ! y-axis - ny = noahmp%domain%njt(my_tile) - call mpp_write_meta(fid, y, 'yc', 'unitless', 'y-coordinate', cartesian='Y', domain=ydom, data=(/(i*1.0d0,i=1,ny)/)) - - ! z-axises, soil and snow layers - call mpp_write_meta(fid, z, 'soil_levels', 'meters', 'soil levels', data=noahmp%nmlist%soil_level_nodes*1.0d0) - call mpp_write_meta(fid, z1,'snow_levels', 'unitless', 'snow_levels', data=(/(i*1.0d0,i=noahmp%static%lsnowl,0)/)) - call mpp_write_meta(fid, z2,'snso_levels', 'unitless', 'snso_levels', data=(/(i*1.0d0,i=noahmp%static%lsnowl,noahmp%nmlist%num_soil_levels)/)) - - ! time axis - call mpp_write_meta(fid, t, 'time', "seconds since "//noahmp%model%reference_date, 'time', cartesian='T') - - ! write them to the file - call mpp_write(fid, x) - call mpp_write(fid, y) - call mpp_write(fid, z) - call mpp_write(fid, z1) - call mpp_write(fid, z2) + ! loop over FB and remove fields + call ESMF_FieldBundleGet(FBgrid, fieldCount=nfld, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- - ! define fixed variables - !---------------------- + ! allocate field list + allocate(fieldNameList(nfld)) - call mpp_write_meta(fid, f, (/x,y/), 'grid_xt', 'degrees_E', 'T-cell longitude', pack=1) - call mpp_write(fid, f, noahmp%domain%mosaic_domain, noahmp%domain%lont) - call mpp_write_meta(fid, f, (/x,y/), 'grid_yt', 'degrees_N', 'T-cell latitude', pack=1) - call mpp_write(fid, f, noahmp%domain%mosaic_domain, noahmp%domain%latt) + ! get field names + call ESMF_FieldBundleGet(FBgrid, fieldNameList=fieldNameList, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- - ! create routehandle to redist selected fields from mesh to mosaic grid - !---------------------- + do i = 1, nfld + ! debug information + if (dbug > 0) then + call ESMF_LogWrite(trim(subname)//' removing '//trim(fieldNameList(i))//' from FBgrid and FBmesh', ESMF_LOGMSG_INFO) + end if - if (first_time) then - ! set field type - call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc) + ! get field on grid + call ESMF_FieldBundleGet(FBgrid, fieldName=trim(fieldNameList(i)), field=fgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! create field in mesh side - field_mesh = ESMF_FieldCreate(noahmp%domain%mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - ungriddedLbound=(/1/), ungriddedUbound=(/max_num_variables/), gridToFieldMap=(/1/), rc=rc) + ! destroy it + call ESMF_FieldDestroy(fgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! create field in grid side - field_grid = ESMF_FieldCreate(noahmp%domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & - indexflag=ESMF_INDEX_GLOBAL, ungriddedLBound=(/1/), ungriddedUBound=(/max_num_variables/), gridToFieldMap=(/1,2/), rc=rc) + ! get field on mesh + call ESMF_FieldBundleGet(FBmesh, fieldName=trim(fieldNameList(i)), field=fmesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! create routehandle from mesh to grid - call ESMF_FieldRegridStore(field_mesh, field_grid, routehandle=noahmp%domain%rh_mesh2grid_r8, rc=rc) + ! destroy it + call ESMF_FieldDestroy(fmesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - !---------------------- - ! get pionter from field and construct table for fields - !---------------------- - - call ESMF_FieldGet(field_mesh, localDe=0, farrayPtr=ptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call fld_add("ps" ,"surface pressure" ,"Pa" ,ptr2d=ptr2d, v1r8=noahmp%forc%ps) - call fld_add("u1" ,"u-component of wind" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%u1) - call fld_add("v1" ,"v-component of wind" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%v1) - call fld_add("t1" ,"forcing air temperature" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%forc%t1) - call fld_add("q1" ,"forcing specific humidity" ,"kg/kg" ,ptr2d=ptr2d, v1r8=noahmp%forc%q1) - call fld_add("soiltyp" ,"soil type" ,"1" ,ptr2d=ptr2d, v1i4=noahmp%model%soiltyp) - call fld_add("soilcol" ,"soil color" ,"1" ,ptr2d=ptr2d, v1i4=noahmp%model%soilcol) - call fld_add("vegtype" ,"vegetation type" ,"1" ,ptr2d=ptr2d, v1i4=noahmp%model%vegtype) - call fld_add("sigmaf" ,"green vegetation fraction" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%sigmaf) - call fld_add("dlwflx" ,"forcing longwave downward flux" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%forc%dlwflx) - call fld_add("dswsfc" ,"forcing shortwave downward flux" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%forc%dswsfc) - call fld_add("snet" ,"forcing net shortwave flux" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%snet) - call fld_add("tg3" ,"deep soil temperature" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%model%tg3) - call fld_add("cm" ,"surface exchange coeff for momentum" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%cm) - call fld_add("ch" ,"surface exchange coeff for heat and moisture" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%ch) - call fld_add("prsl1" ,"mean pressure at lowest model layer" ,"Pa" ,ptr2d=ptr2d, v1r8=noahmp%model%prsl1) - call fld_add("prslk1" ,"dimensionless Exner function at the lowest model layer" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%prslk1) - call fld_add("prslki" ,"Exner function ratio bt midlayer and interface at 1st layer" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%prslki) - call fld_add("prsik1" ,"dimensionless Exner function at the ground surface" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%prsik1) - call fld_add("zf" ,"height of bottom layer" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%zf) - call fld_add("dry" ,"flag for a point with any land" ,"1" ,ptr2d=ptr2d, v1l =noahmp%model%dry) - call fld_add("wind" ,"wind speed" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%forc%wind) - call fld_add("slopetyp" ,"class of sfc slope" ,"1" ,ptr2d=ptr2d, v1i4=noahmp%model%slopetyp) - call fld_add("shdmin" ,"min fractional coverage of green veg" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%shdmin) - call fld_add("shdmax" ,"max fractional coverage of green veg" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%shdmax) - call fld_add("snoalb" ,"upper bound on max albedo over deep snow" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%snoalb) - call fld_add("sfalb" ,"mean sfc diffuse sw albedo" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%sfalb) - call fld_add("xlatin" ,"latitude" ,"radian" ,ptr2d=ptr2d, v1r8=noahmp%model%xlatin) - call fld_add("xcoszin" ,"cosine of zenith angle" ,"degree" ,ptr2d=ptr2d, v1r8=noahmp%model%xcoszin) - call fld_add("garea" ,"area of the grid cell" ,"m2" ,ptr2d=ptr2d, v1r8=noahmp%domain%garea) - call fld_add("rainn_mp" ,"microphysics non-convective precipitation" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%rainn_mp) - call fld_add("rainc_mp" ,"microphysics convective precipitation" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%rainc_mp) - call fld_add("snow_mp" ,"microphysics snow" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%snow_mp) - call fld_add("graupel_mp","microphysics graupel" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%graupel_mp) - call fld_add("ice_mp" ,"microphysics ice/hail" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%ice_mp) - call fld_add("weasd" ,"water equivalent accumulated snow depth" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%weasd) - call fld_add("snwdph" ,"snow depth (water equiv) over land" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%snwdph) - call fld_add("tskin" ,"ground surface skin temperature" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%model%tskin) - call fld_add("tprcp" ,"total precipitation" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%tprcp) - call fld_add("srflag" ,"snow/rain flag for precipitation" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%srflag) - call fld_add("smc" ,"total soil moisture content" ,"m3/m3" ,ptr2d=ptr2d, v2r8=noahmp%model%smc, zaxis="z") - call fld_add("stc" ,"soil temperature" ,"K" ,ptr2d=ptr2d, v2r8=noahmp%model%stc, zaxis="z") - call fld_add("slc" ,"liquid soil moisture" ,"m3/m3" ,ptr2d=ptr2d, v2r8=noahmp%model%slc, zaxis="z") - call fld_add("canopy" ,"canopy moisture content" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%canopy) - call fld_add("trans" ,"total plant transpiration" ,"m/2" ,ptr2d=ptr2d, v1r8=noahmp%model%trans) - call fld_add("tsurf" ,"surface skin temperature (after iteration)" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%model%tsurf) - call fld_add("zorl" ,"surface roughness" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%zorl) - call fld_add("rb1" ,"bulk Richardson number at the surface over land" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%rb1) - call fld_add("fm1" ,"Monin-Obukhov similarity function for momentum over land" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%fm1) - call fld_add("fh1" ,"Monin-Obukhov similarity function for heat over land" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%fh1) - call fld_add("ustar1" ,"surface friction velocity over land" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%ustar1) - call fld_add("stress1" ,"surface wind stress over land" ,"m2/s2" ,ptr2d=ptr2d, v1r8=noahmp%model%stress1) - call fld_add("fm101" ,"Monin-Obukhov similarity parameter for momentum at 10m over land" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%fm101) - call fld_add("fh21" ,"Monin-Obukhov similarity parameter for heat at 2m over land" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%fh21) - call fld_add("snowxy" ,"actual no. of snow layers" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%snowxy) - call fld_add("tvxy" ,"vegetation leaf temperature" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%model%tvxy) - call fld_add("tgxy" ,"bulk ground surface temperature" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%model%tgxy) - call fld_add("canicexy" ,"canopy-intercepted ice" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%canicexy) - call fld_add("canliqxy" ,"canopy-intercepted liquid water" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%canliqxy) - call fld_add("eahxy" ,"canopy air vapor pressure" ,"Pa" ,ptr2d=ptr2d, v1r8=noahmp%model%eahxy) - call fld_add("tahxy" ,"canopy air temperature" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%model%tahxy) - call fld_add("cmxy" ,"bulk momentum drag coefficient" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%cmxy) - call fld_add("chxy" ,"bulk sensible heat exchange coefficient" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%chxy) - call fld_add("fwetxy" ,"wetted or snowed fraction of the canopy" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%fwetxy) - call fld_add("sneqvoxy" ,"snow mass at last time step" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%sneqvoxy) - call fld_add("alboldxy" ,"snow albedo at last time step" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%alboldxy) - call fld_add("qsnowxy" ,"snowfall on the ground" ,"mm/s" ,ptr2d=ptr2d, v1r8=noahmp%model%qsnowxy) - call fld_add("wslakexy" ,"lake water storage" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%wslakexy) - call fld_add("zwtxy" ,"water table depth" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%zwtxy) - call fld_add("waxy" ,"water in the aquifer" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%waxy) - call fld_add("wtxy" ,"groundwater storage" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%wtxy) - call fld_add("tsnoxy" ,"temperature in surface snow" ,"K" ,ptr2d=ptr2d, v2r8=noahmp%model%tsnoxy , zaxis="z1") - call fld_add("zsnsoxy" ,"depth from the top of the snow surface at the bottom of the layer" ,"m" ,ptr2d=ptr2d, v2r8=noahmp%model%zsnsoxy, zaxis="z2") - call fld_add("snicexy" ,"lwe thickness of ice in surface snow" ,"mm" ,ptr2d=ptr2d, v2r8=noahmp%model%snicexy, zaxis="z1") - call fld_add("snliqxy" ,"snow layer liquid water" ,"mm" ,ptr2d=ptr2d, v2r8=noahmp%model%snliqxy, zaxis="z1") - call fld_add("lfmassxy" ,"leaf mass" ,"g/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%lfmassxy) - call fld_add("rtmassxy" ,"mass of fine roots" ,"g/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%rtmassxy) - call fld_add("stmassxy" ,"stem mas" ,"g/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%stmassxy) - call fld_add("woodxy" ,"mass of wood incl woody roots" ,"g/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%woodxy) - call fld_add("stblcpxy" ,"stable carbon in deep soil" ,"g/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%stblcpxy) - call fld_add("fastcpxy" ,"short-lived carbon, shallow soil" ,"g/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%fastcpxy) - call fld_add("xlaixy" ,"leaf area index" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%xlaixy) - call fld_add("xsaixy" ,"stem area index" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%xsaixy) - call fld_add("taussxy" ,"snow age factor" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%taussxy) - call fld_add("smoiseq" ,"equilibrium soil water content" ,"m3/m3" ,ptr2d=ptr2d, v2r8=noahmp%model%smoiseq, zaxis="z") - call fld_add("smcwtdxy" ,"soil moisture content in the layer to the water table when deep" ,"mm" ,ptr2d=ptr2d, v1r8=noahmp%model%smcwtdxy) - call fld_add("deeprechxy","recharge to the water table when deep" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%deeprechxy) - call fld_add("rechxy" ,"recharge to the water table (diagnostic)" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%rechxy) - call fld_add("albdvis" ,"albedo - direct visible" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%albdvis) - call fld_add("albdnir" ,"albedo - direct NIR" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%albdnir) - call fld_add("albivis" ,"albedo - diffuse visible" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%albivis) - call fld_add("albinir" ,"albedo - diffuse NIR" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%albinir) - call fld_add("emiss" ,"surface emissivity" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%emiss) - call fld_add("sncovr1" ,"snow cover over land" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%sncovr1) - call fld_add("qsurf" ,"specific humidity at sfc" ,"kg/kg" ,ptr2d=ptr2d, v1r8=noahmp%model%qsurf) - call fld_add("gflux" ,"soil heat flux" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%gflux) - call fld_add("drain" ,"subsurface runoff" ,"mm/s" ,ptr2d=ptr2d, v1r8=noahmp%model%drain) - call fld_add("evap" ,"evaporation from latent heat flux" ,"mm/s" ,ptr2d=ptr2d, v1r8=noahmp%model%evap) - call fld_add("hflx" ,"sensible heat flux" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%hflx) - call fld_add("ep" ,"potential evaporation" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%ep) - call fld_add("runoff" ,"surface runoff" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%runoff) - call fld_add("cmm" ,"cm * rho" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%cmm) - call fld_add("chh" ,"ch * rho" ,"kg/m2/s",ptr2d=ptr2d, v1r8=noahmp%model%chh) - call fld_add("evbs" ,"direct soil evaporation" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%evbs) - call fld_add("evcw" ,"canopy water evaporation" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%evcw) - call fld_add("sbsno" ,"sublimation/deposit from snopack" ,"m/s" ,ptr2d=ptr2d, v1r8=noahmp%model%sbsno) - call fld_add("pah" ,"precipitation advected heat - total" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%pah) - call fld_add("ecan" ,"evaporation of intercepted water" ,"kg/m2/s",ptr2d=ptr2d, v1r8=noahmp%model%ecan) - call fld_add("etran" ,"transpiration rate" ,"kg/m2/s",ptr2d=ptr2d, v1r8=noahmp%model%etran) - call fld_add("edir" ,"soil surface evaporation rate" ,"kg/m2/s",ptr2d=ptr2d, v1r8=noahmp%model%edir) - call fld_add("snowc" ,"fractional snow cover" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%snowc) - call fld_add("stm" ,"total soil column moisture content" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%stm) - call fld_add("snohf" ,"snow/freezing-rain latent heat flux" ,"W/m2" ,ptr2d=ptr2d, v1r8=noahmp%model%snohf) - call fld_add("smcwlt2" ,"dry soil moisture threshold" ,"m3/m3" ,ptr2d=ptr2d, v1r8=noahmp%model%smcwlt2) - call fld_add("smcref2" ,"soil moisture threshold" ,"m3/m3" ,ptr2d=ptr2d, v1r8=noahmp%model%smcref2) - call fld_add("wet1" ,"normalized soil wetness" ,"1" ,ptr2d=ptr2d, v1r8=noahmp%model%wet1) - call fld_add("t2mmp" ,"combined T2m from tiles" ,"K" ,ptr2d=ptr2d, v1r8=noahmp%model%t2mmp) - call fld_add("q2mp" ,"combined q2m from tiles" ,"kg/kg" ,ptr2d=ptr2d, v1r8=noahmp%model%q2mp) - call fld_add("zvfun" ,"function of surface roughness length and green vegetation fraction","1" ,ptr2d=ptr2d, v1r8=noahmp%model%zvfun) - call fld_add("rho" ,"density" ,"kg/m3" ,ptr2d=ptr2d, v1r8=noahmp%model%rho) - call fld_add("hgt" ,"forcing height" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%forc%hgt) - call fld_add("pblh" ,"height of pbl" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%pblh) - call fld_add("ztmax" ,"surface roughness length for heat over land" ,"m" ,ptr2d=ptr2d, v1r8=noahmp%model%ztmax) - - !---------------------- - ! masked out data over ocean/inland water/lake - !---------------------- - - do i = 1, max_indx - where(noahmp%domain%mask < 1) ptr2d(:,i) = 1.0d20 end do - nullify(ptr2d) - !---------------------- - ! redist from mesh to grid and extract pointer to write out - !---------------------- + ! deallocate temporrary field name array + deallocate(fieldNameList) - call ESMF_FieldRedist(field_mesh, field_grid, noahmp%domain%rh_mesh2grid_r8, rc=rc) + ! destroy field bundles + call ESMF_FieldBundleDestroy(FBgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_grid, localDe=0, farrayPtr=ptr3d, rc=rc) + call ESMF_FieldBundleDestroy(FBmesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- - ! define temporal variables that will be used to write data through FMS interface - !---------------------- - - if (first_time) then - ! this is one time allocate, no need to deallocate it - allocate(data3d(lbound(ptr3d, dim=1):ubound(ptr3d, dim=1),lbound(ptr3d, dim=2):ubound(ptr3d, dim=2),1)) - max_level = noahmp%nmlist%num_soil_levels-noahmp%static%lsnowl+1 - allocate(data4d(lbound(ptr3d, dim=1):ubound(ptr3d, dim=1),lbound(ptr3d, dim=2):ubound(ptr3d, dim=2),max_level,1)) - first_time = .false. + ! destroy routehandle if it is created locally + if (.not. present(rh)) then + call ESMF_RouteHandleDestroy(rh_local, rc=rc) end if - prevar = "" - do i = 1, max_indx - ! 2d fields with x, y - if (flds(i)%nlev == 0) then - ! define variable - ! TODO: pack = 1 writes double. without pack is writes float by default. make it configurable. - call mpp_write_meta(fid, f1, (/y,x,t/), trim(flds(i)%short_name), trim(flds(i)%units), trim(flds(i)%long_name), missing=1.0d20, pack=1) - ! put data to temporary variable - data3d(:,:,1) = ptr3d(:,:,i) - ! write to file - call mpp_write(fid, f1, noahmp%domain%mosaic_domain, data3d, now_time) - ! 3d fields with x, y, z/z1/z2 - else - ! control to skip writing data multiple times - if (trim(prevar) /= trim(flds(i)%short_name)) then - ! define variable - if (trim(flds(i)%zaxis) == "z") then - call mpp_write_meta(fid, f2, (/y,x,z,t/), trim(flds(i)%short_name), trim(flds(i)%units), trim(flds(i)%long_name), missing=1.0d20, pack=1) - else if (trim(flds(i)%zaxis) == "z1") then - call mpp_write_meta(fid, f2, (/y,x,z1,t/), trim(flds(i)%short_name), trim(flds(i)%units), trim(flds(i)%long_name), missing=1.0d20, pack=1) - else if (trim(flds(i)%zaxis) == "z2") then - call mpp_write_meta(fid, f2, (/y,x,z2,t/), trim(flds(i)%short_name), trim(flds(i)%units), trim(flds(i)%long_name), missing=1.0d20, pack=1) - else - call mpp_error(FATAL, 'zaxis can be z, z1 or z2. '//trim(flds(i)%zaxis)//' not recognized for '//trim(flds(i)%short_name)) - end if - ! put data to temporary variable - data4d(:,:,1:flds(i)%nlev,1) = ptr3d(:,:,i:i+flds(i)%nlev-1) - ! write to file - call mpp_write(fid, f2, noahmp%domain%mosaic_domain, data4d(:,:,1:flds(i)%nlev,1), now_time) - end if - end if - prevar = trim(flds(i)%short_name) - end do - nullify(ptr3d) - - !---------------------- - ! close file and sync - !---------------------- - - call mpp_close(fid) - call mpp_sync() - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end subroutine write_mosaic_output + end subroutine write_tiled_file !=============================================================================== - subroutine fld_add(short_name, variable_unit, long_name, ptr2d, v1r8, v1i4, v1l, v2r8, zaxis) + subroutine fld_add(varName, varLName, varUnit, outflds, ptr1r4, ptr1r8, ptr1i4, ptr2r4, ptr2r8, ptr2i4, zAxis) ! input/output variables - character(len=*), intent(in) :: short_name - character(len=*), intent(in) :: variable_unit - character(len=*), intent(in) :: long_name - real(r8), pointer, optional, intent(inout) :: ptr2d(:,:) - real(r8), optional, intent(in) :: v1r8(:) - integer, optional, intent(in) :: v1i4(:) - logical, optional, intent(in) :: v1l(:) - real(r8), optional, intent(in) :: v2r8(:,:) - character(len=*), optional, intent(in) :: zaxis + character(len=*) , intent(in) :: varName + character(len=*) , intent(in) :: varUnit + character(len=*) , intent(in) :: varLName + type(field_type) , intent(inout) :: outflds(:) + real(r4), optional, pointer , intent(in) :: ptr1r4(:) + real(r8), optional, pointer , intent(in) :: ptr1r8(:) + integer , optional, pointer , intent(in) :: ptr1i4(:) + real(r4), optional, pointer , intent(in) :: ptr2r4(:,:) + real(r8), optional, pointer , intent(in) :: ptr2r8(:,:) + integer , optional, pointer , intent(in) :: ptr2i4(:,:) + character(len=*) , optional, intent(in) :: zAxis ! local variables - integer :: i, indx + integer :: i, max_indx, indx logical :: found, restart character(len=*), parameter :: subname=trim(modName)//': (fld_add) ' !------------------------------------------------------------------------------- + call ESMF_LogWrite(trim(subname)//": called for "//trim(varName), ESMF_LOGMSG_INFO) + ! find out indices indx = 0 found = .false. - do i = 1, max_num_variables - if (trim(flds(i)%short_name) == trim(short_name)) then + do i = 1, fldsMaxIO + ! do not add to the list if it is found + if (trim(outflds(i)%short_name) == trim(varName)) then indx = i found = .true. exit @@ -2370,52 +1758,466 @@ subroutine fld_add(short_name, variable_unit, long_name, ptr2d, v1r8, v1i4, v1l, ! if it is a new entry, increment max_indx if (.not. found) then + max_indx = count(outflds(:)%id /= -999, 1) indx = max_indx+1 - if (present(v2r8)) then - ! variables with vertical dimension, add each layer as a seperate variable - max_indx = max_indx+size(v2r8, dim=2) - else - ! variables without vertical dimension - max_indx = max_indx+1 - end if - if (max_indx > max_num_variables) then - print*, "max_indx > max_num_variables could not add more variable! increase max_num_variables ..." + max_indx = max_indx+1 + if (max_indx > fldsMaxIO) then + call ESMF_LogWrite(trim(subname)//": max_indx > fldsMaxIO could not add more variable! increase fldsMaxIO!", ESMF_LOGMSG_INFO) return end if end if - ! add field metadata and fill pointer with data - ! NOTE: if data is not allocated then all present statements return .false. and does not set flds(indx) - ! 2d variables - if (present(v1r8) .or. present(v1i4) .or. present(v1l)) then - flds(indx)%short_name = trim(short_name) - flds(indx)%units = trim(variable_unit) - flds(indx)%long_name = trim(long_name) - flds(indx)%nlev = 0 - if (present(v1r8)) then - ptr2d(:,indx) = v1r8(:) - else if (present(v1i4)) then - ptr2d(:,indx) = dble(v1i4(:)) - else if (present(v1l)) then - where(v1l(:)) - ptr2d(:,indx) = 1.0 - elsewhere - ptr2d(:,indx) = 0.0 - end where - end if - ! 3d variables - else if (present(v2r8)) then - ! add each level as seperate variable - do i = 1, size(v2r8, dim=2) - flds(indx+i-1)%short_name = trim(short_name) - flds(indx+i-1)%units = trim(variable_unit) - flds(indx+i-1)%long_name = trim(long_name) - flds(indx+i-1)%zaxis = trim(zaxis) - flds(indx+i-1)%nlev = size(v2r8, dim=2) - ptr2d(:,indx+i-1) = v2r8(:,lbound(v2r8, dim=2)+i-1) - end do + ! add field metadata + outflds(indx)%id = indx + outflds(indx)%short_name = trim(varName) + outflds(indx)%units = trim(varUnit) + outflds(indx)%long_name = trim(varLName) + + ! assign pointers + if (present(ptr1r4)) then + outflds(indx)%ptr1r4 => ptr1r4 + else if (present(ptr1r8)) then + outflds(indx)%ptr1r8 => ptr1r8 + else if (present(ptr1i4)) then + outflds(indx)%ptr1i4 => ptr1i4 + else if (present(ptr2r4)) then + outflds(indx)%ptr2r4 => ptr2r4 + else if (present(ptr2r8)) then + outflds(indx)%ptr2r8 => ptr2r8 + else if (present(ptr2i4)) then + outflds(indx)%ptr2i4 => ptr2i4 end if - - end subroutine fld_add + + ! add extra metadata for the fields with z-axis + if (present(zAxis)) then + if (present(ptr2r4)) then + outflds(indx)%zaxis = trim(zAxis) + outflds(indx)%nlev = size(ptr2r4, dim=2) + else if (present(ptr2r8)) then + outflds(indx)%zaxis = trim(zAxis) + outflds(indx)%nlev = size(ptr2r8, dim=2) + else if (present(ptr2i4)) then + outflds(indx)%zaxis = trim(zAxis) + outflds(indx)%nlev = size(ptr2i4, dim=2) + end if + end if + + call ESMF_LogWrite(trim(subname)//' done for '//trim(varName), ESMF_LOGMSG_INFO) + + end subroutine fld_add + + !============================================================================= + + subroutine write_tiled_file_init(noahmp, outtype, rc) + + ! input/output variables + type(noahmp_type) , target, intent(inout) :: noahmp + character(len=*) , intent(in) :: outtype + integer , optional, intent(inout) :: rc + + ! local variables + character(len=*), parameter :: subname = trim(modName)//': (fld_link) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//' called ', ESMF_LOGMSG_INFO) + + !---------------------- + ! Prepare data structure to write the data + !---------------------- + + + ! history + if (trim(outtype) == 'hist') then + ! mask variable needs to be included to all output types and modes + call fld_add("mask" , "land-sea mask" , "1" , histflds, ptr1i4=noahmp%domain%mask) + + ! mode = all + if (trim(noahmp%nmlist%output_mode) == 'all') then + call fld_add("albdnir" , "albedo - direct NIR" , "1" , histflds, ptr1r8=noahmp%model%albdnir) + call fld_add("albdvis" , "albedo - direct visible" , "1" , histflds, ptr1r8=noahmp%model%albdvis) + call fld_add("albinir" , "albedo - diffuse NIR" , "1" , histflds, ptr1r8=noahmp%model%albinir) + call fld_add("albivis" , "albedo - diffuse visible" , "1" , histflds, ptr1r8=noahmp%model%albivis) + call fld_add("alboldxy" , "snow albedo at last time step" , "1" , histflds, ptr1r8=noahmp%model%alboldxy) + call fld_add("canicexy" , "canopy-intercepted ice" , "mm" , histflds, ptr1r8=noahmp%model%canicexy) + call fld_add("canliqxy" , "canopy-intercepted liquid water" , "mm" , histflds, ptr1r8=noahmp%model%canliqxy) + call fld_add("canopy" , "canopy moisture content" , "m" , histflds, ptr1r8=noahmp%model%canopy) + call fld_add("chh" , "ch * rho" , "kg/m2/s", histflds, ptr1r8=noahmp%model%chh) + call fld_add("ch" , "surface exchange coeff for heat and moisture" , "m/s" , histflds, ptr1r8=noahmp%model%ch) + call fld_add("chxy" , "bulk sensible heat exchange coefficient" , "m/s" , histflds, ptr1r8=noahmp%model%chxy) + call fld_add("cmm" , "cm * rho" , "m/s" , histflds, ptr1r8=noahmp%model%cmm) + call fld_add("cm" , "surface exchange coeff for momentum" , "m/s" , histflds, ptr1r8=noahmp%model%cm) + call fld_add("cmxy" , "bulk momentum drag coefficient" , "m/s" , histflds, ptr1r8=noahmp%model%cmxy) + call fld_add("deeprechxy", "recharge to the water table when deep" , "1" , histflds, ptr1r8=noahmp%model%deeprechxy) + call fld_add("dlwflx" , "forcing longwave downward flux" , "W/m2" , histflds, ptr1r8=noahmp%forc%dlwflx) + call fld_add("drain" , "subsurface runoff" , "mm/s" , histflds, ptr1r8=noahmp%model%drain) + call fld_add("dswsfc" , "forcing shortwave downward flux" , "W/m2" , histflds, ptr1r8=noahmp%forc%dswsfc) + call fld_add("eahxy" , "canopy air vapor pressure" , "Pa" , histflds, ptr1r8=noahmp%model%eahxy) + call fld_add("ecan" , "evaporation of intercepted water" , "kg/m2/s", histflds, ptr1r8=noahmp%model%ecan) + call fld_add("edir" , "soil surface evaporation rate" , "kg/m2/s", histflds, ptr1r8=noahmp%model%edir) + call fld_add("emiss" , "surface emissivity" , "1" , histflds, ptr1r8=noahmp%model%emiss) + call fld_add("ep" , "potential evaporation" , "W/m2" , histflds, ptr1r8=noahmp%model%ep) + call fld_add("etran" , "transpiration rate" , "kg/m2/s", histflds, ptr1r8=noahmp%model%etran) + call fld_add("evap" , "evaporation from latent heat flux" , "mm/s" , histflds, ptr1r8=noahmp%model%evap) + call fld_add("evbs" , "direct soil evaporation" , "m/s" , histflds, ptr1r8=noahmp%model%evbs) + call fld_add("evcw" , "canopy water evaporation" , "m/s" , histflds, ptr1r8=noahmp%model%evcw) + call fld_add("fastcpxy" , "short-lived carbon, shallow soil" , "g/m2" , histflds, ptr1r8=noahmp%model%fastcpxy) + call fld_add("fh1" , "Monin-Obukhov similarity function for heat over land" , "1" , histflds, ptr1r8=noahmp%model%fh1) + call fld_add("fh21" , "Monin-Obukhov similarity parameter for heat at 2m over land" , "1" , histflds, ptr1r8=noahmp%model%fh21) + call fld_add("flhc1" , "Surface exchange coefficient for heat" , "1" , histflds, ptr1r8=noahmp%model%flhc1) + call fld_add("flqc1" , "Surface exchange coefficient for moisture" , "1" , histflds, ptr1r8=noahmp%model%flqc1) + call fld_add("fm101" , "Monin-Obukhov similarity parameter for momentum at 10m over land" , "1" , histflds, ptr1r8=noahmp%model%fm101) + call fld_add("fm1" , "Monin-Obukhov similarity function for momentum over land" , "1" , histflds, ptr1r8=noahmp%model%fm1) + call fld_add("fwetxy" , "wetted or snowed fraction of the canopy" , "1" , histflds, ptr1r8=noahmp%model%fwetxy) + call fld_add("garea" , "area of the grid cell" , "m2" , histflds, ptr1r8=noahmp%domain%garea) + call fld_add("gflux" , "soil heat flux" , "W/m2" , histflds, ptr1r8=noahmp%model%gflux) + call fld_add("graupel_mp", "microphysics graupel" , "mm" , histflds, ptr1r8=noahmp%model%graupel_mp) + call fld_add("hflx" , "sensible heat flux" , "W/m2" , histflds, ptr1r8=noahmp%model%hflx) + call fld_add("hgt" , "forcing height" , "m" , histflds, ptr1r8=noahmp%forc%hgt) + call fld_add("ice_mp" , "microphysics ice/hail" , "mm" , histflds, ptr1r8=noahmp%model%ice_mp) + call fld_add("lfmassxy" , "leaf mass" , "g/m2" , histflds, ptr1r8=noahmp%model%lfmassxy) + call fld_add("pah" , "precipitation advected heat - total" , "W/m2" , histflds, ptr1r8=noahmp%model%pah) + call fld_add("pblh" , "height of pbl" , "m" , histflds, ptr1r8=noahmp%model%pblh) + call fld_add("prsik1" , "dimensionless Exner function at the ground surface" , "1" , histflds, ptr1r8=noahmp%model%prsik1) + call fld_add("prsl1" , "mean pressure at lowest model layer" , "Pa" , histflds, ptr1r8=noahmp%model%prsl1) + call fld_add("prslk1" , "dimensionless Exner function at the lowest model layer" , "1" , histflds, ptr1r8=noahmp%model%prslk1) + call fld_add("prslki" , "Exner function ratio bt midlayer and interface at 1st layer" , "1" , histflds, ptr1r8=noahmp%model%prslki) + call fld_add("ps" , "surface pressure" , "Pa" , histflds, ptr1r8=noahmp%forc%ps) + call fld_add("q1" , "forcing specific humidity" , "kg/kg" , histflds, ptr1r8=noahmp%forc%q1) + call fld_add("q2mp" , "combined q2m from tiles" , "kg/kg" , histflds, ptr1r8=noahmp%model%q2mp) + call fld_add("qsnowxy" , "snowfall on the ground" , "mm/s" , histflds, ptr1r8=noahmp%model%qsnowxy) + call fld_add("qsurf" , "specific humidity at sfc" , "kg/kg" , histflds, ptr1r8=noahmp%model%qsurf) + call fld_add("rainc_mp" , "microphysics convective precipitation" , "mm" , histflds, ptr1r8=noahmp%model%rainc_mp) + call fld_add("rainn_mp" , "microphysics non-convective precipitation" , "mm" , histflds, ptr1r8=noahmp%model%rainn_mp) + call fld_add("rb1" , "bulk Richardson number at the surface over land" , "1" , histflds, ptr1r8=noahmp%model%rb1) + call fld_add("rechxy" , "recharge to the water table (diagnostic)" , "1" , histflds, ptr1r8=noahmp%model%rechxy) + call fld_add("rho" , "density" , "kg/m3" , histflds, ptr1r8=noahmp%model%rho) + call fld_add("rhonewsn1" , "density of precipitation ice" , "kg/m3" , histflds, ptr1r8=noahmp%model%rhonewsn1) + call fld_add("rmol1" , "One over obukhov length" , "1" , histflds, ptr1r8=noahmp%model%rmol1) + call fld_add("rtmassxy" , "mass of fine roots" , "g/m2" , histflds, ptr1r8=noahmp%model%rtmassxy) + call fld_add("runoff" , "surface runoff" , "m/s" , histflds, ptr1r8=noahmp%model%runoff) + call fld_add("sbsno" , "sublimation/deposit from snopack" , "m/s" , histflds, ptr1r8=noahmp%model%sbsno) + call fld_add("sfalb" , "mean sfc diffuse sw albedo" , "1" , histflds, ptr1r8=noahmp%model%sfalb) + call fld_add("shdmax" , "max fractional coverage of green veg" , "1" , histflds, ptr1r8=noahmp%model%shdmax) + call fld_add("shdmin" , "min fractional coverage of green veg" , "1" , histflds, ptr1r8=noahmp%model%shdmin) + call fld_add("sigmaf" , "green vegetation fraction" , "1" , histflds, ptr1r8=noahmp%model%sigmaf) + call fld_add("slc" , "liquid soil moisture" , "m3/m3" , histflds, ptr2r8=noahmp%model%slc, zaxis="z") + call fld_add("slopetyp" , "class of sfc slope" , "1" , histflds, ptr1i4=noahmp%model%slopetyp) + call fld_add("smcref2" , "soil moisture threshold" , "m3/m3" , histflds, ptr1r8=noahmp%model%smcref2) + call fld_add("smc" , "total soil moisture content" , "m3/m3" , histflds, ptr2r8=noahmp%model%smc, zaxis="z") + call fld_add("smcwlt2" , "dry soil moisture threshold" , "m3/m3" , histflds, ptr1r8=noahmp%model%smcwlt2) + call fld_add("smcwtdxy" , "soil moisture content in the layer to the water table when deep" , "mm" , histflds, ptr1r8=noahmp%model%smcwtdxy) + call fld_add("smoiseq" , "equilibrium soil water content" , "m3/m3" , histflds, ptr2r8=noahmp%model%smoiseq, zaxis="z") + call fld_add("sncovr1" , "snow cover over land" , "1" , histflds, ptr1r8=noahmp%model%sncovr1) + call fld_add("sneqvoxy" , "snow mass at last time step" , "mm" , histflds, ptr1r8=noahmp%model%sneqvoxy) + call fld_add("snet" , "forcing net shortwave flux" , "W/m2" , histflds, ptr1r8=noahmp%model%snet) + call fld_add("snicexy" , "lwe thickness of ice in surface snow" , "mm" , histflds, ptr2r8=noahmp%model%snicexy, zaxis="z1") + call fld_add("snliqxy" , "snow layer liquid water" , "mm" , histflds, ptr2r8=noahmp%model%snliqxy, zaxis="z1") + call fld_add("snoalb" , "upper bound on max albedo over deep snow" , "1" , histflds, ptr1r8=noahmp%model%snoalb) + call fld_add("snohf" , "snow/freezing-rain latent heat flux" , "W/m2" , histflds, ptr1r8=noahmp%model%snohf) + call fld_add("snowc" , "fractional snow cover" , "1" , histflds, ptr1r8=noahmp%model%snowc) + call fld_add("snow_mp" , "microphysics snow" , "mm" , histflds, ptr1r8=noahmp%model%snow_mp) + call fld_add("snowxy" , "actual no. of snow layers" , "1" , histflds, ptr1r8=noahmp%model%snowxy) + call fld_add("snwdph" , "snow depth (water equiv) over land" , "m" , histflds, ptr1r8=noahmp%model%snwdph) + call fld_add("soiltyp" , "soil type" , "1" , histflds, ptr1i4=noahmp%model%soiltyp) + call fld_add("soilcol" , "soil color" , "1" , histflds, ptr1i4=noahmp%model%soilcol) + call fld_add("srflag" , "snow/rain flag for precipitation" , "1" , histflds, ptr1r8=noahmp%model%srflag) + call fld_add("stblcpxy" , "stable carbon in deep soil" , "g/m2" , histflds, ptr1r8=noahmp%model%stblcpxy) + call fld_add("stc" , "soil temperature" , "K" , histflds, ptr2r8=noahmp%model%stc, zaxis="z") + call fld_add("stmassxy" , "stem mas" , "g/m2" , histflds, ptr1r8=noahmp%model%stmassxy) + call fld_add("stm" , "total soil column moisture content" , "m" , histflds, ptr1r8=noahmp%model%stm) + call fld_add("stress1" , "surface wind stress over land" , "m2/s2" , histflds, ptr1r8=noahmp%model%stress1) + call fld_add("t1" , "forcing air temperature" , "K" , histflds, ptr1r8=noahmp%forc%t1) + call fld_add("t2mmp" , "combined T2m from tiles" , "K" , histflds, ptr1r8=noahmp%model%t2mmp) + call fld_add("tahxy" , "canopy air temperature" , "K" , histflds, ptr1r8=noahmp%model%tahxy) + call fld_add("taussxy" , "snow age factor" , "1" , histflds, ptr1r8=noahmp%model%taussxy) + call fld_add("tg3" , "deep soil temperature" , "K" , histflds, ptr1r8=noahmp%model%tg3) + call fld_add("tgxy" , "bulk ground surface temperature" , "K" , histflds, ptr1r8=noahmp%model%tgxy) + call fld_add("tprcp" , "total precipitation" , "mm" , histflds, ptr1r8=noahmp%forc%tprcp) + call fld_add("trans" , "total plant transpiration" , "m/2" , histflds, ptr1r8=noahmp%model%trans) + call fld_add("tskin" , "ground surface skin temperature" , "K" , histflds, ptr1r8=noahmp%model%tskin) + call fld_add("tsnoxy" , "temperature in surface snow" , "K" , histflds, ptr2r8=noahmp%model%tsnoxy, zaxis="z1") + call fld_add("tsurf" , "surface skin temperature (after iteration)" , "K" , histflds, ptr1r8=noahmp%model%tsurf) + call fld_add("tvxy" , "vegetation leaf temperature" , "K" , histflds, ptr1r8=noahmp%model%tvxy) + call fld_add("u1" , "u-component of wind" , "m/s" , histflds, ptr1r8=noahmp%model%u1) + call fld_add("ustar1" , "surface friction velocity over land" , "m/s" , histflds, ptr1r8=noahmp%model%ustar1) + call fld_add("v1" , "v-component of wind" , "m/s" , histflds, ptr1r8=noahmp%model%v1) + call fld_add("vegtype" , "vegetation type" , "1" , histflds, ptr1i4=noahmp%model%vegtype) + call fld_add("waxy" , "water in the aquifer" , "mm" , histflds, ptr1r8=noahmp%model%waxy) + call fld_add("weasd" , "water equivalent accumulated snow depth" , "mm" , histflds, ptr1r8=noahmp%model%weasd) + call fld_add("wet1" , "normalized soil wetness" , "1" , histflds, ptr1r8=noahmp%model%wet1) + call fld_add("wind" , "wind speed" , "m/s" , histflds, ptr1r8=noahmp%forc%wind) + call fld_add("woodxy" , "mass of wood incl woody roots" , "g/m2" , histflds, ptr1r8=noahmp%model%woodxy) + call fld_add("wslakexy" , "lake water storage" , "mm" , histflds, ptr1r8=noahmp%model%wslakexy) + call fld_add("wtxy" , "groundwater storage" , "mm" , histflds, ptr1r8=noahmp%model%wtxy) + call fld_add("xcoszin" , "cosine of zenith angle" , "degree" , histflds, ptr1r8=noahmp%model%xcoszin) + call fld_add("xlaixy" , "leaf area index" , "1" , histflds, ptr1r8=noahmp%model%xlaixy) + call fld_add("xlatin" , "latitude" , "radian" , histflds, ptr1r8=noahmp%model%xlatin) + call fld_add("xsaixy" , "stem area index" , "1" , histflds, ptr1r8=noahmp%model%xsaixy) + call fld_add("zf" , "height of bottom layer" , "m" , histflds, ptr1r8=noahmp%model%zf) + call fld_add("zorl" , "surface roughness" , "m" , histflds, ptr1r8=noahmp%model%zorl) + call fld_add("zsnsoxy" , "depth from the top of the snow surface at the bottom of the layer" , "m" , histflds, ptr2r8=noahmp%model%zsnsoxy, zaxis="z2") + call fld_add("ztmax" , "surface roughness length for heat over land" , "m" , histflds, ptr1r8=noahmp%model%ztmax) + call fld_add("zvfun" , "function of surface roughness length and green vegetation fraction", "1" , histflds, ptr1r8=noahmp%model%zvfun) + call fld_add("zwtxy" , "water table depth" , "m" , histflds, ptr1r8=noahmp%model%zwtxy) + ! mode = mid + else if (trim(noahmp%nmlist%output_mode) == 'mid') then + call fld_add("chh" , "ch * rho" , "kg/m2/s", histflds, ptr1r8=noahmp%model%chh) + call fld_add("cmm" , "cm * rho" , "m/s" , histflds, ptr1r8=noahmp%model%cmm) + call fld_add("ep" , "potential evaporation" , "W/m2" , histflds, ptr1r8=noahmp%model%ep) + call fld_add("evap" , "evaporation from latent heat flux" , "mm/s" , histflds, ptr1r8=noahmp%model%evap) + call fld_add("hflx" , "sensible heat flux" , "W/m2" , histflds, ptr1r8=noahmp%model%hflx) + call fld_add("q2mp" , "combined q2m from tiles" , "kg/kg" , histflds, ptr1r8=noahmp%model%q2mp) + call fld_add("runoff" , "surface runoff" , "m/s" , histflds, ptr1r8=noahmp%model%runoff) + call fld_add("slc" , "liquid soil moisture" , "m3/m3" , histflds, ptr2r8=noahmp%model%slc, zaxis="z") + call fld_add("smc" , "total soil moisture content" , "m3/m3" , histflds, ptr2r8=noahmp%model%smc, zaxis="z") + call fld_add("smoiseq" , "equilibrium soil water content" , "m3/m3" , histflds, ptr2r8=noahmp%model%smoiseq, zaxis="z") + call fld_add("snicexy" , "lwe thickness of ice in surface snow" , "mm" , histflds, ptr2r8=noahmp%model%snicexy, zaxis="z1") + call fld_add("snliqxy" , "snow layer liquid water" , "mm" , histflds, ptr2r8=noahmp%model%snliqxy, zaxis="z1") + call fld_add("stc" , "soil temperature" , "K" , histflds, ptr2r8=noahmp%model%stc, zaxis="z") + call fld_add("t2mmp" , "combined T2m from tiles" , "K" , histflds, ptr1r8=noahmp%model%t2mmp) + call fld_add("tsnoxy" , "temperature in surface snow" , "K" , histflds, ptr2r8=noahmp%model%tsnoxy , zaxis="z1") + call fld_add("zsnsoxy" , "depth from the top of the snow surface at the bottom of the layer" , "m" , histflds, ptr2r8=noahmp%model%zsnsoxy, zaxis="z2") + ! mode = low + else if (trim(noahmp%nmlist%output_mode) == 'low') then + call fld_add("evap" , "evaporation from latent heat flux" , "mm/s" , histflds, ptr1r8=noahmp%model%evap) + call fld_add("hflx" , "sensible heat flux" , "W/m2" , histflds, ptr1r8=noahmp%model%hflx) + call fld_add("q2mp" , "combined q2m from tiles" , "kg/kg" , histflds, ptr1r8=noahmp%model%q2mp) + call fld_add("slc" , "liquid soil moisture" , "m3/m3" , histflds, ptr2r8=noahmp%model%slc, zaxis="z") + call fld_add("smc" , "total soil moisture content" , "m3/m3" , histflds, ptr2r8=noahmp%model%smc, zaxis="z") + call fld_add("stc" , "soil temperature" , "K" , histflds, ptr2r8=noahmp%model%stc, zaxis="z") + call fld_add("t2mmp" , "combined T2m from tiles" , "K" , histflds, ptr1r8=noahmp%model%t2mmp) + end if + + ! restart + else if (trim(outtype) == 'rest') then + call fld_add("alboldxy" , "snow albedo at last time step" , "1" , restflds, ptr1r8=noahmp%model%alboldxy) + call fld_add("canicexy" , "canopy-intercepted ice" , "mm" , restflds, ptr1r8=noahmp%model%canicexy) + call fld_add("canliqxy" , "canopy-intercepted liquid water" , "mm" , restflds, ptr1r8=noahmp%model%canliqxy) + call fld_add("eahxy" , "canopy air vapor pressure" , "Pa" , restflds, ptr1r8=noahmp%model%eahxy) + call fld_add("mask" , "land-sea mask" , "1" , restflds, ptr1i4=noahmp%domain%mask) + call fld_add("qsnowxy" , "snowfall on the ground" , "mm/s" , restflds, ptr1r8=noahmp%model%qsnowxy) + call fld_add("slc" , "liquid soil moisture" , "m3/m3" , restflds, ptr2r8=noahmp%model%slc, zaxis="z") + call fld_add("smc" , "total soil moisture content" , "m3/m3" , restflds, ptr2r8=noahmp%model%smc, zaxis="z") + call fld_add("snicexy" , "lwe thickness of ice in surface snow" , "mm" , restflds, ptr2r8=noahmp%model%snicexy, zaxis="z1") + call fld_add("snliqxy" , "snow layer liquid water" , "mm" , restflds, ptr2r8=noahmp%model%snliqxy, zaxis="z1") + call fld_add("snowxy" , "actual no. of snow layers" , "1" , restflds, ptr1r8=noahmp%model%snowxy) + call fld_add("snwdph" , "snow depth (water equiv) over land" , "m" , restflds, ptr1r8=noahmp%model%snwdph) + call fld_add("stc" , "soil temperature" , "K" , restflds, ptr2r8=noahmp%model%stc, zaxis="z") + call fld_add("tahxy" , "canopy air temperature" , "K" , restflds, ptr1r8=noahmp%model%tahxy) + call fld_add("tgxy" , "bulk ground surface temperature" , "K" , restflds, ptr1r8=noahmp%model%tgxy) + call fld_add("tsnoxy" , "temperature in surface snow" , "K" , restflds, ptr2r8=noahmp%model%tsnoxy, zaxis="z1") + call fld_add("tvxy" , "vegetation leaf temperature" , "K" , restflds, ptr1r8=noahmp%model%tvxy) + call fld_add("ustar1" , "surface friction velocity over land" , "m/s" , restflds, ptr1r8=noahmp%model%ustar1) + call fld_add("waxy" , "water in the aquifer" , "mm" , restflds, ptr1r8=noahmp%model%waxy) + call fld_add("weasd" , "water equivalent accumulated snow depth" , "mm" , restflds, ptr1r8=noahmp%model%weasd) + call fld_add("wtxy" , "groundwater storage" , "mm" , restflds, ptr1r8=noahmp%model%wtxy) + call fld_add("zsnsoxy" , "depth from the top of the snow surface at the bottom of the layer" , "m" , restflds, ptr2r8=noahmp%model%zsnsoxy, zaxis="z2") + call fld_add("zwtxy" , "water table depth" , "m" , restflds, ptr1r8=noahmp%model%zwtxy) + endif + + call ESMF_LogWrite(trim(subname)//' done ', ESMF_LOGMSG_INFO) + + end subroutine write_tiled_file_init + + !============================================================================= + subroutine FB_diagnose(FB, string, rc) + + ! input/output variables + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + type(ESMF_Field) :: lfield + character(len=*), parameter :: subname='(FB_diagnose)' + !--------------------------------------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) // ' ' + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call Field_GetFldPtr(lfield, fldptr1=dataptr1d, fldptr2=dataptr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + enddo + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine FB_diagnose + + !============================================================================= + subroutine Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) + + ! ---------------------------------------------- + ! for a field, determine rank and return fldptr1 or fldptr2 + ! abort is true by default and will abort if fldptr is not yet allocated in field + ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(R8), pointer , intent(inout), optional :: fldptr1(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + character(len=*), parameter :: subname='(Field_GetFldPtr)' + !--------------------------------------------------------------------------- + + if (dbug > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + ESMF_LOGMSG_INFO) + + elseif (lrank == 1) then + if (.not.present(fldptr1)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + elseif (lrank == 2) then + if (.not.present(fldptr2)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + if (dbug > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine Field_GetFldPtr end module lnd_comp_io diff --git a/drivers/nuopc/lnd_comp_nuopc.F90 b/drivers/nuopc/lnd_comp_nuopc.F90 index 4a71d9da..b191d20c 100644 --- a/drivers/nuopc/lnd_comp_nuopc.F90 +++ b/drivers/nuopc/lnd_comp_nuopc.F90 @@ -13,7 +13,7 @@ module lnd_comp_nuopc use ESMF , only : ESMF_Array, ESMF_ArrayRead, ESMF_ArrayGet, ESMF_ArrayDestroy use ESMF , only : ESMF_TimeInterval, ESMF_Alarm, ESMF_ClockGet use ESMF , only : ESMF_ClockGetAlarmList, ESMF_Clock, ESMF_Time - use ESMF , only : ESMF_ClockSet, ESMF_TimeInterval, ESMF_ALARMLIST_ALL + use ESMF , only : ESMF_ClockSet, ESMF_TimeIntervalGet, ESMF_ALARMLIST_ALL use ESMF , only : ESMF_AlarmSet, ESMF_ClockAdvance use ESMF , only : ESMF_TimeGet, ESMF_TimeInterval use ESMF , only : ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH @@ -27,18 +27,17 @@ module lnd_comp_nuopc use NUOPC_Model , only : SetVM use NUOPC_Model , only : model_label_Advance => label_Advance use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock - - use fms_mod , only : fms_init - use fms_io_mod , only : read_data + use NUOPC_Model , only : model_label_Finalize => label_Finalize use lnd_comp_types , only : noahmp_type use lnd_comp_kind , only : cl => shr_kind_cl + use lnd_comp_kind , only : r8 => shr_kind_r8 use lnd_comp_shr , only : chkerr, alarm_init use lnd_comp_shr , only : shr_string_listGetName, read_namelist use lnd_comp_domain , only : lnd_set_decomp_and_domain_from_mosaic use lnd_comp_import_export, only : advertise_fields, realize_fields use lnd_comp_import_export, only : import_fields, export_fields, state_diagnose - use lnd_comp_driver , only : drv_init, drv_run + use lnd_comp_driver , only : drv_init, drv_run, drv_finalize implicit none private ! except @@ -108,6 +107,12 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelSetRunClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ModelFinalize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end subroutine SetServices !=============================================================================== @@ -157,18 +162,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call advertise_fields(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! --------------------- - ! Initialize FMS - ! --------------------- - - call ESMF_VMGetCurrent(vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm=vm, mpiCommunicator=lnd_mpi_comm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call fms_init(lnd_mpi_comm) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeAdvertise @@ -185,7 +178,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - integer :: n + integer :: n, suffix_sec + real(r8) :: dt integer, pointer :: ptr(:) character(len=CL) :: cvalue, cname, msg character(len=CL) :: meshfile_mask @@ -288,16 +282,27 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - noahmp%nmlist%restart_file = trim(cvalue) + noahmp%nmlist%restart_file = trim(cvalue)//'.tile*.nc' else call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + + call ESMF_TimeIntervalGet(timeStep, s_r8=dt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! update day if it is required + ! coupling time (dt) needs to be same in case of restart run + suffix_sec = int(hour*60*60+minute*60+second) + if (suffix_sec < 0) then + day = day-1 + suffix_sec = 86400-abs(suffix_sec) + end if + write(noahmp%nmlist%restart_file, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5,a)') & - trim(noahmp%nmlist%case_name)//'.lnd.out.', year, '-', month, '-', day, '-', hour*60*60+minute*60+second, '.tile' + trim(noahmp%nmlist%case_name)//'.lnd.out.', year, '-', month, '-', day, '-', suffix_sec, '.tile*.nc' end if call ESMF_LogWrite(trim(subname)//': restart_file = '//trim(noahmp%nmlist%restart_file), ESMF_LOGMSG_INFO) @@ -596,4 +601,24 @@ subroutine ModelSetRunClock(gcomp, rc) end subroutine ModelSetRunClock + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! call model finalize routine + call drv_finalize(gcomp, noahmp, rc) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine ModelFinalize + end module lnd_comp_nuopc diff --git a/drivers/nuopc/lnd_comp_shr.F90 b/drivers/nuopc/lnd_comp_shr.F90 index 70eb046b..62295688 100644 --- a/drivers/nuopc/lnd_comp_shr.F90 +++ b/drivers/nuopc/lnd_comp_shr.F90 @@ -23,7 +23,8 @@ module lnd_comp_shr use ESMF, only : ESMF_KIND_I4, ESMF_GRIDITEM_MASK, ESMF_STAGGERLOC_CENTER use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER use ESMF, only : ESMF_FieldWriteVTK, ESMF_FieldWrite, ESMF_Decomp_Flag, ESMF_DECOMP_SYMMEDGEMAX - use ESMF, only : ESMF_INDEX_GLOBAL, ESMF_KIND_R4, ESMF_Field, ESMF_FieldGet, ESMF_ArraySpec, ESMF_ArraySpecSet, ESMF_TYPEKIND_R4 + use ESMF, only : ESMF_INDEX_GLOBAL, ESMF_KIND_R4, ESMF_Field, ESMF_FieldGet + use ESMF, only : ESMF_LogFoundNetCDFError, ESMF_ArraySpec, ESMF_ArraySpecSet, ESMF_TYPEKIND_R4 use ESMF, only : ESMF_RouteHandle, ESMF_FieldRegridStore, ESMF_FieldRedist use NUOPC, only : NUOPC_CompAttributeGet @@ -36,6 +37,7 @@ module lnd_comp_shr public :: alarm_init public :: chkerr + public :: chkerrnc public :: read_namelist public :: shr_string_listGetName public :: shr_string_listGetNum @@ -97,6 +99,22 @@ logical function ChkErr(rc, line, file) endif end function ChkErr + !=============================================================================== + logical function ChkErrNc(rc, line, file) + + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + + integer :: lrc + + ChkErrNc = .false. + lrc = rc + if (ESMF_LogFoundNetCDFError(lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + ChkErrNc = .true. + endif + end function ChkErrNc + !=============================================================================== subroutine alarm_init( clock, alarm, option, & opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) @@ -540,6 +558,16 @@ subroutine read_namelist(gcomp, noahmp, rc) noahmp%nmlist%case_name = 'ufs' end if + ! forcing height + call NUOPC_CompAttributeGet(gcomp, name='forcing_height', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) noahmp%nmlist%forcing_height + else + noahmp%nmlist%forcing_height = -999 + end if + call ESMF_LogWrite(trim(subname)//' : forcing_height = '//trim(cvalue), ESMF_LOGMSG_INFO) + ! get num_soil_levels call NUOPC_CompAttributeGet(gcomp, name='num_soil_levels', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -774,10 +802,38 @@ subroutine read_namelist(gcomp, noahmp, rc) if (isPresent .and. isSet) then read(cvalue,*) noahmp%nmlist%output_freq else - noahmp%nmlist%output_freq = 6 + noahmp%nmlist%output_freq = 21600 end if call ESMF_LogWrite(trim(subname)//' : output_freq = '//trim(cvalue), ESMF_LOGMSG_INFO) + ! output mode (high, low, debug) + call NUOPC_CompAttributeGet(gcomp, name='output_mode', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) noahmp%nmlist%output_mode + if (trim(noahmp%nmlist%output_mode) == 'all' .or. & + trim(noahmp%nmlist%output_mode) == 'mid' .or. & + trim(noahmp%nmlist%output_mode) == 'low') then + else + call ESMF_LogWrite(trim(subname)//": ERROR in output_mode. Only 'all', 'mid' and 'low' are allowed!", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + else + noahmp%nmlist%output_mode = 'all' + end if + + ! restart frequency + call NUOPC_CompAttributeGet(gcomp, name='restart_freq', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) noahmp%nmlist%restart_freq + else + noahmp%nmlist%restart_freq = noahmp%nmlist%output_freq + end if + write(msg, fmt='(A,I6)') trim(subname)//': restart_freq = ', noahmp%nmlist%restart_freq + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + ! MYNN-EDMF call NUOPC_CompAttributeGet(gcomp, name='do_mynnedmf', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -796,6 +852,7 @@ subroutine read_namelist(gcomp, noahmp, rc) if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') noahmp%model%do_mynnsfclay = .true. end if noahmp%model%do_mynnsfclay = noahmp%static%do_mynnsfclay + if (noahmp%static%iopt_sfc == 4) noahmp%model%do_mynnsfclay = .true. write(msg, fmt='(A,L)') trim(subname)//': do_mynnsfclay = ', noahmp%static%do_mynnsfclay call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) diff --git a/drivers/nuopc/lnd_comp_types.F90 b/drivers/nuopc/lnd_comp_types.F90 index 77e31df3..d2633226 100644 --- a/drivers/nuopc/lnd_comp_types.F90 +++ b/drivers/nuopc/lnd_comp_types.F90 @@ -1,8 +1,9 @@ module lnd_comp_types use ESMF , only : ESMF_Grid, ESMF_Mesh, ESMF_RouteHandle - use machine , only : kp => kind_phys - use mpp_domains_mod, only : domain2d + use lnd_comp_kind , only : r8 => shr_kind_r8 + use lnd_comp_kind , only : r4 => shr_kind_r4 + use lnd_comp_kind , only : i4 => shr_kind_i4 !---------------------------------------------------------------------------- ! Land component specific data types @@ -11,41 +12,41 @@ module lnd_comp_types ! data type for initial conditions type initial_type - real(kind=kp), allocatable :: snow_water_equivalent(:) - real(kind=kp), allocatable :: snow_depth(:) - real(kind=kp), allocatable :: canopy_water(:) - real(kind=kp), allocatable :: skin_temperature(:) - real(kind=kp), allocatable :: soil_temperature(:,:) - real(kind=kp), allocatable :: soil_moisture(:,:) - real(kind=kp), allocatable :: soil_liquid(:,:) - real(kind=kp), allocatable :: surface_roughness(:) - real(kind=kp), allocatable :: friction_velocity(:) + real(kind=r8), allocatable :: snow_water_equivalent(:) + real(kind=r8), allocatable :: snow_depth(:) + real(kind=r8), allocatable :: canopy_water(:) + real(kind=r8), allocatable :: skin_temperature(:) + real(kind=r8), allocatable :: soil_temperature(:,:) + real(kind=r8), allocatable :: soil_moisture(:,:) + real(kind=r8), allocatable :: soil_liquid(:,:) + real(kind=r8), allocatable :: surface_roughness(:) + real(kind=r8), allocatable :: friction_velocity(:) end type initial_type ! data type for forcing type forcing_type - real(kind=kp), allocatable :: t1 (:) ! air temperature (K) - real(kind=kp), allocatable :: q1 (:) ! mixing ratio/specific humidty at lowest model layer (kg/kg) - real(kind=kp), allocatable :: u1 (:) ! u-component of wind (m/s) - real(kind=kp), allocatable :: v1 (:) ! v-component of wind (m/s) - real(kind=kp), allocatable :: ps (:) ! surface pressure (Pa) - real(kind=kp), allocatable :: pbot (:) ! bottom layer pressure (Pa) - real(kind=kp), allocatable :: tskin (:) ! skin temperature (K) - real(kind=kp), allocatable :: dlwflx (:) ! downward longwave radiation (W/m2) - real(kind=kp), allocatable :: dswsfc (:) ! downward shortwave radiation (W/m2) - real(kind=kp), allocatable :: snet (:) ! net shortwave radiation (W/m2) - real(kind=kp), allocatable :: wind (:) ! wind speed (m/s) - real(kind=kp), allocatable :: tprcp (:) ! total precipitation (mm/s) - real(kind=kp), allocatable :: tprcpc (:) ! convective component of precipitation (mm/s) - real(kind=kp), allocatable :: tprcpl (:) ! large-scale component of precipitation (mm/s) - real(kind=kp), allocatable :: snow (:) ! snow fall (mm/s) - real(kind=kp), allocatable :: snowc (:) ! convective component of snow fall (mm/s) - real(kind=kp), allocatable :: snowl (:) ! large-scale component of snow fall (mm/s) - real(kind=kp), allocatable :: vegfrac (:) ! vegetation fraction (unitless, 0-1) - real(kind=kp), allocatable :: hgt (:) ! forcing height (m) - real(kind=kp), allocatable :: prslk1 (:) ! dimensionless Exner function at the lowest model layer - real(kind=kp), allocatable :: ustar1 (:) ! friction velocity (m/s) - real(kind=kp), allocatable :: zorl (:) ! surface roughness (m) + real(kind=r8), allocatable :: t1 (:) ! air temperature (K) + real(kind=r8), allocatable :: q1 (:) ! mixing ratio/specific humidty at lowest model layer (kg/kg) + real(kind=r8), allocatable :: u1 (:) ! u-component of wind (m/s) + real(kind=r8), allocatable :: v1 (:) ! v-component of wind (m/s) + real(kind=r8), allocatable :: ps (:) ! surface pressure (Pa) + real(kind=r8), allocatable :: pbot (:) ! bottom layer pressure (Pa) + real(kind=r8), allocatable :: tskin (:) ! skin temperature (K) + real(kind=r8), allocatable :: dlwflx (:) ! downward longwave radiation (W/m2) + real(kind=r8), allocatable :: dswsfc (:) ! downward shortwave radiation (W/m2) + real(kind=r8), allocatable :: snet (:) ! net shortwave radiation (W/m2) + real(kind=r8), allocatable :: wind (:) ! wind speed (m/s) + real(kind=r8), allocatable :: tprcp (:) ! total precipitation (mm/s) + real(kind=r8), allocatable :: tprcpc (:) ! convective component of precipitation (mm/s) + real(kind=r8), allocatable :: tprcpl (:) ! large-scale component of precipitation (mm/s) + real(kind=r8), allocatable :: snow (:) ! snow fall (mm/s) + real(kind=r8), allocatable :: snowc (:) ! convective component of snow fall (mm/s) + real(kind=r8), allocatable :: snowl (:) ! large-scale component of snow fall (mm/s) + real(kind=r8), allocatable :: vegfrac (:) ! vegetation fraction (unitless, 0-1) + real(kind=r8), allocatable :: hgt (:) ! forcing height (m) + real(kind=r8), allocatable :: prslk1 (:) ! dimensionless Exner function at the lowest model layer + real(kind=r8), allocatable :: ustar1 (:) ! friction velocity (m/s) + real(kind=r8), allocatable :: zorl (:) ! surface roughness (m) end type forcing_type ! data type for static information provided by nems.configure @@ -57,7 +58,7 @@ module lnd_comp_types integer :: isot ! sfc soil type data source zobler or statsgo integer :: ivegsrc ! sfc veg type data source umd or igbp integer :: idveg ! option for dynamic vegetation - real(kind=kp) :: delt ! time interval (s) + real(kind=r8) :: delt ! time interval (s) integer :: iopt_crs ! option for canopy stomatal resistance integer :: iopt_btr ! option for soil moisture factor for stomatal resistance integer :: iopt_run ! option for runoff and groundwater @@ -83,136 +84,136 @@ module lnd_comp_types type model_type ! scalar variables integer :: iyrlen ! year length - real(kind=kp) :: julian ! julian day of year + real(kind=r8) :: julian ! julian day of year character(len=19) :: reference_date ! reference date logical :: thsfc_loc ! flag for reference pressure theta ! variables in dimension im - real(kind=kp), allocatable :: u1 (:) ! u-component of wind (m/s) - real(kind=kp), allocatable :: v1 (:) ! v-component of wind (m/s) + real(kind=r8), allocatable :: u1 (:) ! u-component of wind (m/s) + real(kind=r8), allocatable :: v1 (:) ! v-component of wind (m/s) integer , allocatable :: soiltyp (:) ! soil type (integer index) integer , allocatable :: soilcol (:) ! soil color (integer index) integer , allocatable :: vegtype (:) ! vegetation type (integer index) - real(kind=kp), allocatable :: sigmaf (:) ! areal fractional cover of green vegetation - real(kind=kp), allocatable :: emiss (:) ! sfc lw emissivity (fraction) - real(kind=kp), allocatable :: albdvis (:) ! albedo - direct visible (fraction) - real(kind=kp), allocatable :: albdnir (:) ! albedo - direct NIR (fraction) - real(kind=kp), allocatable :: albivis (:) ! albedo - diffuse visible (fraction) - real(kind=kp), allocatable :: albinir (:) ! albedo - diffuse NIR (fraction) - real(kind=kp), allocatable :: snet (:) ! total sky sfc netsw flx into ground (W/m^2) NOT USED - real(kind=kp), allocatable :: tg3 (:) ! deep soil temperature (K) - real(kind=kp), allocatable :: cm (:) ! surface exchange coeff for momentum (m/s) - real(kind=kp), allocatable :: ch (:) ! surface exchange coeff heat & moisture (m/s) - real(kind=kp), allocatable :: prsl1 (:) ! sfc layer 1 mean pressure (Pa) - real(kind=kp), allocatable :: prslki (:) ! ? - real(kind=kp), allocatable :: prslk1 (:) ! dimensionless exner function at surface adjacent layer - real(kind=kp), allocatable :: prsik1 (:) ! surface dimensionless exner function - real(kind=kp), allocatable :: zf (:) ! height of bottom layer (m) - real(kind=kp), allocatable :: pblh (:) ! PBL thickness (m) + real(kind=r8), allocatable :: sigmaf (:) ! areal fractional cover of green vegetation + real(kind=r8), allocatable :: emiss (:) ! sfc lw emissivity (fraction) + real(kind=r8), allocatable :: albdvis (:) ! albedo - direct visible (fraction) + real(kind=r8), allocatable :: albdnir (:) ! albedo - direct NIR (fraction) + real(kind=r8), allocatable :: albivis (:) ! albedo - diffuse visible (fraction) + real(kind=r8), allocatable :: albinir (:) ! albedo - diffuse NIR (fraction) + real(kind=r8), allocatable :: snet (:) ! total sky sfc netsw flx into ground (W/m^2) NOT USED + real(kind=r8), allocatable :: tg3 (:) ! deep soil temperature (K) + real(kind=r8), allocatable :: cm (:) ! surface exchange coeff for momentum (m/s) + real(kind=r8), allocatable :: ch (:) ! surface exchange coeff heat & moisture (m/s) + real(kind=r8), allocatable :: prsl1 (:) ! sfc layer 1 mean pressure (Pa) + real(kind=r8), allocatable :: prslki (:) ! ? + real(kind=r8), allocatable :: prslk1 (:) ! dimensionless exner function at surface adjacent layer + real(kind=r8), allocatable :: prsik1 (:) ! surface dimensionless exner function + real(kind=r8), allocatable :: zf (:) ! height of bottom layer (m) + real(kind=r8), allocatable :: pblh (:) ! PBL thickness (m) logical , allocatable :: dry (:) ! = T if a point with any land integer , allocatable :: slopetyp (:) ! class of sfc slope (integer index) - real(kind=kp), allocatable :: alb_monthly(:,:) ! surface albedo - real(kind=kp), allocatable :: gvf_monthly(:,:) ! fractional coverage of green veg - real(kind=kp), allocatable :: shdmin (:) ! min fractional coverage of green veg NOT USED - real(kind=kp), allocatable :: shdmax (:) ! max fractnl cover of green veg NOT USED - real(kind=kp), allocatable :: snoalb (:) ! upper bound on max albedo over deep snow NOT USED - real(kind=kp), allocatable :: sfalb (:) ! mean sfc diffused sw albedo (fractional) NOT USED + real(kind=r8), allocatable :: alb_monthly(:,:) ! surface albedo + real(kind=r8), allocatable :: gvf_monthly(:,:) ! fractional coverage of green veg + real(kind=r8), allocatable :: shdmin (:) ! min fractional coverage of green veg NOT USED + real(kind=r8), allocatable :: shdmax (:) ! max fractnl cover of green veg NOT USED + real(kind=r8), allocatable :: snoalb (:) ! upper bound on max albedo over deep snow NOT USED + real(kind=r8), allocatable :: sfalb (:) ! mean sfc diffused sw albedo (fractional) NOT USED logical , allocatable :: flag_iter (:) ! ? - real(kind=kp), allocatable :: xlatin (:) ! latitude - real(kind=kp), allocatable :: xcoszin (:) ! cosine of zenith angle - real(kind=kp), allocatable :: rainn_mp (:) ! microphysics non-convective precipitation (mm) - real(kind=kp), allocatable :: rainc_mp (:) ! microphysics convective precipitation (mm) - real(kind=kp), allocatable :: snow_mp (:) ! microphysics snow (mm) - real(kind=kp), allocatable :: graupel_mp (:) ! microphysics graupel (mm) - real(kind=kp), allocatable :: ice_mp (:) ! microphysics ice/hail (mm) - real(kind=kp), allocatable :: tprcp (:) ! total precipitation (mm/s) - real(kind=kp), allocatable :: weasd (:) ! water equivalent accumulated snow depth (mm) - real(kind=kp), allocatable :: snwdph (:) ! snow depth (water equiv) over land - real(kind=kp), allocatable :: tskin (:) ! ground surface skin temperature (K) - real(kind=kp), allocatable :: srflag (:) ! snow/rain flag for precipitation - real(kind=kp), allocatable :: canopy (:) ! canopy moisture content (m) - real(kind=kp), allocatable :: trans (:) ! total plant transpiration (m/s) - real(kind=kp), allocatable :: tsurf (:) ! surface skin temperature (after iteration) - real(kind=kp), allocatable :: zorl (:) ! surface roughness - real(kind=kp), allocatable :: rb1 (:) ! composite bulk richardson number - real(kind=kp), allocatable :: fm1 (:) ! composite momemtum stability - real(kind=kp), allocatable :: fh1 (:) ! composite heat/moisture stability - real(kind=kp), allocatable :: ustar1 (:) ! composite friction velocity - real(kind=kp), allocatable :: stress1 (:) ! composite surface stress - real(kind=kp), allocatable :: fm101 (:) ! composite 2-meter momemtum stability - real(kind=kp), allocatable :: fh21 (:) ! composite 10-meter heat/moisture stability - real(kind=kp), allocatable :: rmol1 (:) ! one over obukhov length - real(kind=kp), allocatable :: flhc1 (:) ! surface exchange coefficient for heat - real(kind=kp), allocatable :: flqc1 (:) ! surface exchange coefficient for moisture + real(kind=r8), allocatable :: xlatin (:) ! latitude + real(kind=r8), allocatable :: xcoszin (:) ! cosine of zenith angle + real(kind=r8), allocatable :: rainn_mp (:) ! microphysics non-convective precipitation (mm) + real(kind=r8), allocatable :: rainc_mp (:) ! microphysics convective precipitation (mm) + real(kind=r8), allocatable :: snow_mp (:) ! microphysics snow (mm) + real(kind=r8), allocatable :: graupel_mp (:) ! microphysics graupel (mm) + real(kind=r8), allocatable :: ice_mp (:) ! microphysics ice/hail (mm) + real(kind=r8), allocatable :: tprcp (:) ! total precipitation (mm/s) + real(kind=r8), allocatable :: weasd (:) ! water equivalent accumulated snow depth (mm) + real(kind=r8), allocatable :: snwdph (:) ! snow depth (water equiv) over land + real(kind=r8), allocatable :: tskin (:) ! ground surface skin temperature (K) + real(kind=r8), allocatable :: srflag (:) ! snow/rain flag for precipitation + real(kind=r8), allocatable :: canopy (:) ! canopy moisture content (m) + real(kind=r8), allocatable :: trans (:) ! total plant transpiration (m/s) + real(kind=r8), allocatable :: tsurf (:) ! surface skin temperature (after iteration) + real(kind=r8), allocatable :: zorl (:) ! surface roughness + real(kind=r8), allocatable :: rb1 (:) ! composite bulk richardson number + real(kind=r8), allocatable :: fm1 (:) ! composite momemtum stability + real(kind=r8), allocatable :: fh1 (:) ! composite heat/moisture stability + real(kind=r8), allocatable :: ustar1 (:) ! composite friction velocity + real(kind=r8), allocatable :: stress1 (:) ! composite surface stress + real(kind=r8), allocatable :: fm101 (:) ! composite 2-meter momemtum stability + real(kind=r8), allocatable :: fh21 (:) ! composite 10-meter heat/moisture stability + real(kind=r8), allocatable :: rmol1 (:) ! one over obukhov length + real(kind=r8), allocatable :: flhc1 (:) ! surface exchange coefficient for heat + real(kind=r8), allocatable :: flqc1 (:) ! surface exchange coefficient for moisture logical :: do_mynnsfclay ! flag to activate MYNN surface layer - real(kind=kp), allocatable :: snowxy (:) ! actual no. of snow layers - real(kind=kp), allocatable :: tvxy (:) ! vegetation leaf temperature (K) - real(kind=kp), allocatable :: tgxy (:) ! bulk ground surface temperature (K) - real(kind=kp), allocatable :: canicexy (:) ! canopy-intercepted ice (mm) - real(kind=kp), allocatable :: canliqxy (:) ! canopy-intercepted liquid water (mm) - real(kind=kp), allocatable :: eahxy (:) ! canopy air vapor pressure (Pa) - real(kind=kp), allocatable :: tahxy (:) ! canopy air temperature (K) - real(kind=kp), allocatable :: cmxy (:) ! bulk momentum drag coefficient (m/s) - real(kind=kp), allocatable :: chxy (:) ! bulk sensible heat exchange coefficient (m/s( - real(kind=kp), allocatable :: fwetxy (:) ! wetted or snowed fraction of the canopy (fractional) - real(kind=kp), allocatable :: sneqvoxy (:) ! snow mass at last time step (mm h2o) - real(kind=kp), allocatable :: alboldxy (:) ! snow albedo at last time step (fractional) - real(kind=kp), allocatable :: qsnowxy (:) ! snowfall on the ground (mm/s) - real(kind=kp), allocatable :: wslakexy (:) ! lake water storage (mm) - real(kind=kp), allocatable :: zwtxy (:) ! water table depth (m) - real(kind=kp), allocatable :: waxy (:) ! water in the "aquifer" (mm) - real(kind=kp), allocatable :: wtxy (:) ! groundwater storage (mm) - real(kind=kp), allocatable :: lfmassxy (:) ! leaf mass (g/m^2) - real(kind=kp), allocatable :: rtmassxy (:) ! mass of fine roots (g/m^2) - real(kind=kp), allocatable :: stmassxy (:) ! stem mass (g/m^2) - real(kind=kp), allocatable :: woodxy (:) ! mass of wood (incl. woody roots) (g/m^2) - real(kind=kp), allocatable :: stblcpxy (:) ! stable carbon in deep soil (g/m^2) - real(kind=kp), allocatable :: fastcpxy (:) ! short-lived carbon, shallow soil (g/m^2) - real(kind=kp), allocatable :: xlaixy (:) ! leaf area index - real(kind=kp), allocatable :: xsaixy (:) ! stem area index - real(kind=kp), allocatable :: taussxy (:) ! snow age factor - real(kind=kp), allocatable :: smcwtdxy (:) ! soil moisture content in the layer to the water table when deep - real(kind=kp), allocatable :: deeprechxy (:) ! recharge to the water table when deep - real(kind=kp), allocatable :: rechxy (:) ! recharge to the water table (diagnostic) - real(kind=kp), allocatable :: sncovr1 (:) ! snow cover over land (fractional) - real(kind=kp), allocatable :: qsurf (:) ! specific humidity at sfc - real(kind=kp), allocatable :: gflux (:) ! soil heat flux (W/m^2) - real(kind=kp), allocatable :: drain (:) ! subsurface runoff (mm/s) - real(kind=kp), allocatable :: evap (:) ! evaperation from latent heat flux - real(kind=kp), allocatable :: hflx (:) ! sensible heat flux - real(kind=kp), allocatable :: ep (:) ! potential evaporation - real(kind=kp), allocatable :: runoff (:) ! surface runoff (m/s) - real(kind=kp), allocatable :: cmm (:) ! ? - real(kind=kp), allocatable :: chh (:) ! ? - real(kind=kp), allocatable :: evbs (:) ! direct soil evaporation (m/s) - real(kind=kp), allocatable :: evcw (:) ! canopy water evaporation (m/s) - real(kind=kp), allocatable :: sbsno (:) ! sublimation/deposit from snopack (m/s) - real(kind=kp), allocatable :: pah (:) ! precipitation advected heat - total (W/m2) - real(kind=kp), allocatable :: ecan (:) ! canopy evaporation (mm/s) - real(kind=kp), allocatable :: etran (:) ! transpiration (mm/s) - real(kind=kp), allocatable :: edir (:) ! soil surface evaporation (mm/s) - real(kind=kp), allocatable :: snowc (:) ! fractional snow cover - real(kind=kp), allocatable :: stm (:) ! total soil column moisture content (m) - real(kind=kp), allocatable :: rhonewsn1 (:) ! precipitation ice density (kg/m^3) - real(kind=kp), allocatable :: snohf (:) ! snow/freezing-rain latent heat flux (W/m^2) - real(kind=kp), allocatable :: smcwlt2 (:) ! dry soil moisture threshold - real(kind=kp), allocatable :: smcref2 (:) ! soil moisture threshold - real(kind=kp), allocatable :: wet1 (:) ! normalized soil wetness - real(kind=kp), allocatable :: t2mmp (:) ! combined T2m from tiles - real(kind=kp), allocatable :: q2mp (:) ! combined q2m from tiles - real(kind=kp), allocatable :: zvfun (:) ! some function of vegetation used for gfs stability - real(kind=kp), allocatable :: ztmax (:) ! bounded surface roughness length for heat over land - real(kind=kp), allocatable :: rho (:) ! air density - real(kind=kp), allocatable :: pores (:) ! max soil moisture for a given soil type for land surface model - real(kind=kp), allocatable :: resid (:) ! min soil moisture for a given soil type for land surface model + real(kind=r8), allocatable :: snowxy (:) ! actual no. of snow layers + real(kind=r8), allocatable :: tvxy (:) ! vegetation leaf temperature (K) + real(kind=r8), allocatable :: tgxy (:) ! bulk ground surface temperature (K) + real(kind=r8), allocatable :: canicexy (:) ! canopy-intercepted ice (mm) + real(kind=r8), allocatable :: canliqxy (:) ! canopy-intercepted liquid water (mm) + real(kind=r8), allocatable :: eahxy (:) ! canopy air vapor pressure (Pa) + real(kind=r8), allocatable :: tahxy (:) ! canopy air temperature (K) + real(kind=r8), allocatable :: cmxy (:) ! bulk momentum drag coefficient (m/s) + real(kind=r8), allocatable :: chxy (:) ! bulk sensible heat exchange coefficient (m/s( + real(kind=r8), allocatable :: fwetxy (:) ! wetted or snowed fraction of the canopy (fractional) + real(kind=r8), allocatable :: sneqvoxy (:) ! snow mass at last time step (mm h2o) + real(kind=r8), allocatable :: alboldxy (:) ! snow albedo at last time step (fractional) + real(kind=r8), allocatable :: qsnowxy (:) ! snowfall on the ground (mm/s) + real(kind=r8), allocatable :: wslakexy (:) ! lake water storage (mm) + real(kind=r8), allocatable :: zwtxy (:) ! water table depth (m) + real(kind=r8), allocatable :: waxy (:) ! water in the "aquifer" (mm) + real(kind=r8), allocatable :: wtxy (:) ! groundwater storage (mm) + real(kind=r8), allocatable :: lfmassxy (:) ! leaf mass (g/m^2) + real(kind=r8), allocatable :: rtmassxy (:) ! mass of fine roots (g/m^2) + real(kind=r8), allocatable :: stmassxy (:) ! stem mass (g/m^2) + real(kind=r8), allocatable :: woodxy (:) ! mass of wood (incl. woody roots) (g/m^2) + real(kind=r8), allocatable :: stblcpxy (:) ! stable carbon in deep soil (g/m^2) + real(kind=r8), allocatable :: fastcpxy (:) ! short-lived carbon, shallow soil (g/m^2) + real(kind=r8), allocatable :: xlaixy (:) ! leaf area index + real(kind=r8), allocatable :: xsaixy (:) ! stem area index + real(kind=r8), allocatable :: taussxy (:) ! snow age factor + real(kind=r8), allocatable :: smcwtdxy (:) ! soil moisture content in the layer to the water table when deep + real(kind=r8), allocatable :: deeprechxy (:) ! recharge to the water table when deep + real(kind=r8), allocatable :: rechxy (:) ! recharge to the water table (diagnostic) + real(kind=r8), allocatable :: sncovr1 (:) ! snow cover over land (fractional) + real(kind=r8), allocatable :: qsurf (:) ! specific humidity at sfc + real(kind=r8), allocatable :: gflux (:) ! soil heat flux (W/m^2) + real(kind=r8), allocatable :: drain (:) ! subsurface runoff (mm/s) + real(kind=r8), allocatable :: evap (:) ! evaperation from latent heat flux + real(kind=r8), allocatable :: hflx (:) ! sensible heat flux + real(kind=r8), allocatable :: ep (:) ! potential evaporation + real(kind=r8), allocatable :: runoff (:) ! surface runoff (m/s) + real(kind=r8), allocatable :: cmm (:) ! ? + real(kind=r8), allocatable :: chh (:) ! ? + real(kind=r8), allocatable :: evbs (:) ! direct soil evaporation (m/s) + real(kind=r8), allocatable :: evcw (:) ! canopy water evaporation (m/s) + real(kind=r8), allocatable :: sbsno (:) ! sublimation/deposit from snopack (m/s) + real(kind=r8), allocatable :: pah (:) ! precipitation advected heat - total (W/m2) + real(kind=r8), allocatable :: ecan (:) ! canopy evaporation (mm/s) + real(kind=r8), allocatable :: etran (:) ! transpiration (mm/s) + real(kind=r8), allocatable :: edir (:) ! soil surface evaporation (mm/s) + real(kind=r8), allocatable :: snowc (:) ! fractional snow cover + real(kind=r8), allocatable :: stm (:) ! total soil column moisture content (m) + real(kind=r8), allocatable :: rhonewsn1 (:) ! precipitation ice density (kg/m^3) + real(kind=r8), allocatable :: snohf (:) ! snow/freezing-rain latent heat flux (W/m^2) + real(kind=r8), allocatable :: smcwlt2 (:) ! dry soil moisture threshold + real(kind=r8), allocatable :: smcref2 (:) ! soil moisture threshold + real(kind=r8), allocatable :: wet1 (:) ! normalized soil wetness + real(kind=r8), allocatable :: t2mmp (:) ! combined T2m from tiles + real(kind=r8), allocatable :: q2mp (:) ! combined q2m from tiles + real(kind=r8), allocatable :: zvfun (:) ! some function of vegetation used for gfs stability + real(kind=r8), allocatable :: ztmax (:) ! bounded surface roughness length for heat over land + real(kind=r8), allocatable :: rho (:) ! air density + real(kind=r8), allocatable :: pores (:) ! max soil moisture for a given soil type for land surface model + real(kind=r8), allocatable :: resid (:) ! min soil moisture for a given soil type for land surface model ! variables in dimensions im and km - real(kind=kp), allocatable :: smc (:,:) ! total soil moisture content (fractional) - real(kind=kp), allocatable :: stc (:,:) ! soil temp (K) - real(kind=kp), allocatable :: slc (:,:) ! liquid soil moisture (?) - real(kind=kp), allocatable :: tsnoxy (:,:) ! snow temperature (K) - real(kind=kp), allocatable :: zsnsoxy (:,:) ! snow layer depth (m) - real(kind=kp), allocatable :: snicexy (:,:) ! snow layer ice (mm) - real(kind=kp), allocatable :: snliqxy (:,:) ! snow layer liquid water (mm) - real(kind=kp), allocatable :: smoiseq (:,:) ! eq volumetric soil moisture (m^3/m^3) + real(kind=r8), allocatable :: smc (:,:) ! total soil moisture content (fractional) + real(kind=r8), allocatable :: stc (:,:) ! soil temp (K) + real(kind=r8), allocatable :: slc (:,:) ! liquid soil moisture (?) + real(kind=r8), allocatable :: tsnoxy (:,:) ! snow temperature (K) + real(kind=r8), allocatable :: zsnsoxy (:,:) ! snow layer depth (m) + real(kind=r8), allocatable :: snicexy (:,:) ! snow layer ice (mm) + real(kind=r8), allocatable :: snliqxy (:,:) ! snow layer liquid water (mm) + real(kind=r8), allocatable :: smoiseq (:,:) ! eq volumetric soil moisture (m^3/m^3) end type model_type ! data type for domain related variables @@ -221,35 +222,21 @@ module lnd_comp_types type(ESMF_Mesh) :: mesh ! ESMF mesh object type(ESMF_RouteHandle) :: rh_grid2mesh ! ESMF RouteHandle for redist from grid to mesh type(ESMF_RouteHandle) :: rh_mesh2grid_r8! ESMF RouteHandle for redist from mesh to grid - type(domain2d) :: mosaic_domain ! domain object created by FMS logical :: global ! flag for global vs. regional domain integer :: ntiles ! number of tiles in case of having CS grid - integer :: ncontacts ! number of contacts in case of having CS grid - integer , allocatable :: tile1 (:) ! list of tile numbers in tile 1 of each contact - integer , allocatable :: tile2 (:) ! list of tile numbers in tile 2 of each contact - integer , allocatable :: istart1 (:) ! list of starting i-index in tile 1 of each contact - integer , allocatable :: iend1 (:) ! list of ending i-index in tile 1 of each contact - integer , allocatable :: jstart1 (:) ! list of starting j-index in tile 1 of each contact - integer , allocatable :: jend1 (:) ! list of ending j-index in tile 1 of each contact - integer , allocatable :: istart2 (:) ! list of starting i-index in tile 2 of each contact - integer , allocatable :: iend2 (:) ! list of ending i-index in tile 2 of each contact - integer , allocatable :: jstart2 (:) ! list of starting j-index in tile 2 of each contact - integer , allocatable :: jend2 (:) ! list of ending j-index in tile 2 of each contact - integer :: ni ! global size in i direction, only for mesh as input - integer :: nj ! global size in j direction, only for mesh as input - integer , allocatable :: nit (:) ! size of tile in i direction - integer , allocatable :: njt (:) ! size of tile in j direction - real(kind=kp), allocatable :: latt (:,:) ! mosaic latitude - real(kind=kp), allocatable :: lont (:,:) ! mosaic longitude + integer :: ni ! global size in i direction + integer :: nj ! global size in j direction + real(kind=r8), allocatable :: latt (:,:) ! mosaic latitude + real(kind=r8), allocatable :: lont (:,:) ! mosaic longitude integer :: begl ! starting index of size integer :: endl ! ending index of size integer :: layout (2) ! layout for domain decomposition - real(kind=kp), allocatable :: hgt (:) ! topography + real(kind=r8), allocatable :: hgt (:) ! topography integer , allocatable :: mask (:) ! mesh land mask: 1 = land, 0 = ocean - real(kind=kp), allocatable :: frac (:) ! mesh fractional land - real(kind=kp), allocatable :: lats (:) ! mesh latitude - real(kind=kp), allocatable :: lons (:) ! mesh longitude - real(kind=kp), allocatable :: garea (:) ! mesh cell area + real(kind=r8), allocatable :: frac (:) ! mesh fractional land + real(kind=r8), allocatable :: lats (:) ! mesh latitude + real(kind=r8), allocatable :: lons (:) ! mesh longitude + real(kind=r8), allocatable :: garea (:) ! mesh cell area end type domain_type ! data type for namelist options @@ -263,8 +250,9 @@ module lnd_comp_types character*255 :: ic_type ! source of initial conditions, custom vs. sfc logical :: restart_run ! flag for restart run integer :: num_soil_levels ! number of soil levels - real(kind=kp), allocatable :: soil_level_thickness(:) ! soil level thicknesses (m) - real(kind=kp), allocatable :: soil_level_nodes(:) ! soil level centroids from surface (m) + real(kind=r8) :: forcing_height ! forcing height (m) + real(kind=r8), allocatable :: soil_level_thickness(:) ! soil level thicknesses (m) + real(kind=r8), allocatable :: soil_level_nodes(:) ! soil level centroids from surface (m) integer :: dynamic_vegetation_option ! choice for dynamic vegetation option integer :: canopy_stomatal_resistance_option ! choice for canopy stomatal resistance option integer :: soil_wetness_option ! @@ -280,14 +268,16 @@ module lnd_comp_types integer :: surface_evap_resistance_option integer :: glacier_option integer :: surface_thermal_roughness_option - integer :: surface_diagnose_approach_option ! option for surface diagnose approach + integer :: surface_diagnose_approach_option + character*100 :: output_mode ! mods of output: all, low or mid integer :: output_freq ! model output interval + integer :: restart_freq ! model restart interval logical :: has_export ! enable/disable export fields logical :: calc_snet ! enable/disable calculating net shortwave rad. internally integer :: soil_type_category ! soil type (category) integer :: veg_type_category ! vegetation type (category) - real(kind=kp) :: initial_emiss ! initial value for the emissivity (constant in everywhere) - real(kind=kp) :: initial_albedo ! initial value for the monthly albedo (constant in everywhere) + real(kind=r8) :: initial_emiss ! initial value for the emissivity (constant in everywhere) + real(kind=r8) :: initial_albedo ! initial value for the monthly albedo (constant in everywhere) end type namelist_type type noahmp_type @@ -307,6 +297,22 @@ module lnd_comp_types end type noahmp_type + type field_type + real(r4), pointer :: ptr1r4(:) => null() ! data pointer for 1d r4 + real(r8), pointer :: ptr1r8(:) => null() ! data pointer for 1d r8 + integer , pointer :: ptr1i4(:) => null() ! data pointer for 1d i4 + real(r4), pointer :: ptr2r4(:,:) => null() ! data pointer for 2d r4 + real(r8), pointer :: ptr2r8(:,:) => null() ! data pointer for 2d r8 + integer , pointer :: ptr2i4(:,:) => null() ! data pointer for 2d i4 + integer :: id = -999 ! field id + character(len=128) :: short_name = "" ! variable short name + character(len=128) :: units = "" ! variable unit + character(len=128) :: long_name = "" ! variable long name + character(len=128) :: zaxis = "" ! name of z-axis + integer :: nlev ! number of layers in z-axis + integer :: nrec ! number of record in file (time axis) + end type field_type + type fld_list_type character(len=128) :: stdname integer :: ungridded_lbound = 0 @@ -320,6 +326,10 @@ module lnd_comp_types type(fld_list_type) :: fldsToLnd(fldsMax) type(fld_list_type) :: fldsFrLnd(fldsMax) + integer, parameter :: fldsMaxIO = 200 + type(field_type) :: histflds(fldsMaxIO) + type(field_type) :: restflds(fldsMaxIO) + contains subroutine Initialize(this, begl, endl, km, lsnowl) @@ -502,166 +512,166 @@ subroutine InitializeDefault(this) class(noahmp_type) :: this - this%init%snow_water_equivalent = 0.0_kp - this%init%snow_depth = 0.0_kp - this%init%canopy_water = 0.0_kp - this%init%skin_temperature = 0.0_kp - this%init%soil_temperature = 0.0_kp - this%init%soil_moisture = 0.0_kp - this%init%soil_liquid = 0.0_kp - this%init%surface_roughness = 0.0_kp - this%init%friction_velocity = 0.0_kp - - this%forc%t1 = 0.0_kp - this%forc%q1 = 0.0_kp - this%forc%u1 = 0.0_kp - this%forc%v1 = 0.0_kp - this%forc%ps = 0.0_kp - this%forc%pbot = 0.0_kp - this%forc%tskin = 0.0_kp - this%forc%dlwflx = 0.0_kp - this%forc%dswsfc = 0.0_kp - this%forc%snet = 0.0_kp - this%forc%wind = 0.0_kp - this%forc%tprcp = 0.0_kp - this%forc%tprcpc = 0.0_kp - this%forc%tprcpl = 0.0_kp - this%forc%snow = 0.0_kp - this%forc%snowc = 0.0_kp - this%forc%snowl = 0.0_kp - this%forc%vegfrac = 0.0_kp - this%forc%hgt = 0.0_kp - this%forc%prslk1 = 0.0_kp - this%forc%ustar1 = 0.0_kp - this%forc%zorl = 0.0_kp + this%init%snow_water_equivalent = 0.0_r8 + this%init%snow_depth = 0.0_r8 + this%init%canopy_water = 0.0_r8 + this%init%skin_temperature = 0.0_r8 + this%init%soil_temperature = 0.0_r8 + this%init%soil_moisture = 0.0_r8 + this%init%soil_liquid = 0.0_r8 + this%init%surface_roughness = 0.0_r8 + this%init%friction_velocity = 0.0_r8 + + this%forc%t1 = 0.0_r8 + this%forc%q1 = 0.0_r8 + this%forc%u1 = 0.0_r8 + this%forc%v1 = 0.0_r8 + this%forc%ps = 0.0_r8 + this%forc%pbot = 0.0_r8 + this%forc%tskin = 0.0_r8 + this%forc%dlwflx = 0.0_r8 + this%forc%dswsfc = 0.0_r8 + this%forc%snet = 0.0_r8 + this%forc%wind = 0.0_r8 + this%forc%tprcp = 0.0_r8 + this%forc%tprcpc = 0.0_r8 + this%forc%tprcpl = 0.0_r8 + this%forc%snow = 0.0_r8 + this%forc%snowc = 0.0_r8 + this%forc%snowl = 0.0_r8 + this%forc%vegfrac = 0.0_r8 + this%forc%hgt = 0.0_r8 + this%forc%prslk1 = 0.0_r8 + this%forc%ustar1 = 0.0_r8 + this%forc%zorl = 0.0_r8 this%model%iyrlen = 0 - this%model%julian = 0.0_kp - this%model%u1 = 0.0_kp - this%model%v1 = 0.0_kp + this%model%julian = 0.0_r8 + this%model%u1 = 0.0_r8 + this%model%v1 = 0.0_r8 this%model%soiltyp = 0 this%model%soilcol = 0 this%model%vegtype = 0 - this%model%sigmaf = 0.0_kp - this%model%emiss = 0.0_kp - this%model%albdvis = 0.0_kp - this%model%albdnir = 0.0_kp - this%model%albivis = 0.0_kp - this%model%albinir = 0.0_kp - this%model%snet = 0.0_kp - this%model%tg3 = 0.0_kp - this%model%cm = 0.0_kp - this%model%ch = 0.0_kp - this%model%prsl1 = 0.0_kp - this%model%prslki = 0.0_kp - this%model%prslk1 = 0.0_kp - this%model%prsik1 = 0.0_kp - this%model%zf = 0.0_kp - this%model%pblh = 0.0_kp + this%model%sigmaf = 0.0_r8 + this%model%emiss = 0.0_r8 + this%model%albdvis = 0.0_r8 + this%model%albdnir = 0.0_r8 + this%model%albivis = 0.0_r8 + this%model%albinir = 0.0_r8 + this%model%snet = 0.0_r8 + this%model%tg3 = 0.0_r8 + this%model%cm = 0.0_r8 + this%model%ch = 0.0_r8 + this%model%prsl1 = 0.0_r8 + this%model%prslki = 0.0_r8 + this%model%prslk1 = 0.0_r8 + this%model%prsik1 = 0.0_r8 + this%model%zf = 0.0_r8 + this%model%pblh = 0.0_r8 this%model%dry = .false. this%model%slopetyp = 0 - this%model%alb_monthly = 0.0_kp - this%model%gvf_monthly = 0.0_kp - this%model%shdmin = 0.0_kp - this%model%shdmax = 0.0_kp - this%model%snoalb = 0.0_kp - this%model%sfalb = 0.0_kp + this%model%alb_monthly = 0.0_r8 + this%model%gvf_monthly = 0.0_r8 + this%model%shdmin = 0.0_r8 + this%model%shdmax = 0.0_r8 + this%model%snoalb = 0.0_r8 + this%model%sfalb = 0.0_r8 this%model%flag_iter = .false. - this%model%xlatin = 0.0_kp - this%model%xcoszin = 0.0_kp - this%model%rainn_mp = 0.0_kp - this%model%rainc_mp = 0.0_kp - this%model%snow_mp = 0.0_kp - this%model%graupel_mp = 0.0_kp - this%model%ice_mp = 0.0_kp - this%model%tprcp = 0.0_kp - this%model%weasd = 0.0_kp - this%model%snwdph = 0.0_kp - this%model%tskin = 0.0_kp - this%model%srflag = 0.0_kp - this%model%canopy = 0.0_kp - this%model%trans = 0.0_kp - this%model%tsurf = 0.0_kp - this%model%zorl = 0.0_kp - this%model%rb1 = 0.0_kp - this%model%fm1 = 0.0_kp - this%model%fh1 = 0.0_kp - this%model%ustar1 = 0.0_kp - this%model%stress1 = 0.0_kp - this%model%fm101 = 0.0_kp - this%model%fh21 = 0.0_kp - this%model%rmol1 = 0.0_kp - this%model%flhc1 = 0.0_kp - this%model%flqc1 = 0.0_kp - this%model%snowxy = 0.0_kp - this%model%tvxy = 0.0_kp - this%model%tgxy = 0.0_kp - this%model%canicexy = 0.0_kp - this%model%canliqxy = 0.0_kp - this%model%eahxy = 0.0_kp - this%model%tahxy = 0.0_kp - this%model%cmxy = 0.0_kp - this%model%chxy = 0.0_kp - this%model%fwetxy = 0.0_kp - this%model%sneqvoxy = 0.0_kp - this%model%alboldxy = 0.0_kp - this%model%qsnowxy = 0.0_kp - this%model%wslakexy = 0.0_kp - this%model%zwtxy = 0.0_kp - this%model%waxy = 0.0_kp - this%model%wtxy = 0.0_kp - this%model%lfmassxy = 0.0_kp - this%model%rtmassxy = 0.0_kp - this%model%stmassxy = 0.0_kp - this%model%woodxy = 0.0_kp - this%model%stblcpxy = 0.0_kp - this%model%fastcpxy = 0.0_kp - this%model%xlaixy = 0.0_kp - this%model%xsaixy = 0.0_kp - this%model%taussxy = 0.0_kp - this%model%smoiseq = 0.0_kp - this%model%smcwtdxy = 0.0_kp - this%model%deeprechxy = 0.0_kp - this%model%rechxy = 0.0_kp - this%model%sncovr1 = 0.0_kp - this%model%qsurf = 0.0_kp - this%model%gflux = 0.0_kp - this%model%drain = 0.0_kp - this%model%evap = 0.0_kp - this%model%hflx = 0.0_kp - this%model%ep = 0.0_kp - this%model%runoff = 0.0_kp - this%model%cmm = 0.0_kp - this%model%chh = 0.0_kp - this%model%evbs = 0.0_kp - this%model%evcw = 0.0_kp - this%model%sbsno = 0.0_kp - this%model%pah = 0.0_kp - this%model%ecan = 0.0_kp - this%model%etran = 0.0_kp - this%model%edir = 0.0_kp - this%model%snowc = 0.0_kp - this%model%stm = 0.0_kp - this%model%rhonewsn1 = 0.0_kp - this%model%snohf = 0.0_kp - this%model%smcwlt2 = 0.0_kp - this%model%smcref2 = 0.0_kp - this%model%wet1 = 0.0_kp - this%model%t2mmp = 0.0_kp - this%model%q2mp = 0.0_kp - this%model%zvfun = 0.0_kp - this%model%ztmax = 0.0_kp - this%model%rho = 0.0_kp - this%model%pores = 0.0_kp - this%model%resid = 0.0_kp - this%model%smc = 0.0_kp - this%model%stc = 0.0_kp - this%model%slc = 0.0_kp - this%model%smoiseq = 0.0_kp - this%model%tsnoxy = 0.0_kp - this%model%zsnsoxy = 0.0_kp - this%model%snicexy = 0.0_kp - this%model%snliqxy = 0.0_kp + this%model%xlatin = 0.0_r8 + this%model%xcoszin = 0.0_r8 + this%model%rainn_mp = 0.0_r8 + this%model%rainc_mp = 0.0_r8 + this%model%snow_mp = 0.0_r8 + this%model%graupel_mp = 0.0_r8 + this%model%ice_mp = 0.0_r8 + this%model%tprcp = 0.0_r8 + this%model%weasd = 0.0_r8 + this%model%snwdph = 0.0_r8 + this%model%tskin = 0.0_r8 + this%model%srflag = 0.0_r8 + this%model%canopy = 0.0_r8 + this%model%trans = 0.0_r8 + this%model%tsurf = 0.0_r8 + this%model%zorl = 0.0_r8 + this%model%rb1 = 0.0_r8 + this%model%fm1 = 0.0_r8 + this%model%fh1 = 0.0_r8 + this%model%ustar1 = 0.0_r8 + this%model%stress1 = 0.0_r8 + this%model%fm101 = 0.0_r8 + this%model%fh21 = 0.0_r8 + this%model%rmol1 = 0.0_r8 + this%model%flhc1 = 0.0_r8 + this%model%flqc1 = 0.0_r8 + this%model%snowxy = 0.0_r8 + this%model%tvxy = 0.0_r8 + this%model%tgxy = 0.0_r8 + this%model%canicexy = 0.0_r8 + this%model%canliqxy = 0.0_r8 + this%model%eahxy = 0.0_r8 + this%model%tahxy = 0.0_r8 + this%model%cmxy = 0.0_r8 + this%model%chxy = 0.0_r8 + this%model%fwetxy = 0.0_r8 + this%model%sneqvoxy = 0.0_r8 + this%model%alboldxy = 0.0_r8 + this%model%qsnowxy = 0.0_r8 + this%model%wslakexy = 0.0_r8 + this%model%zwtxy = 0.0_r8 + this%model%waxy = 0.0_r8 + this%model%wtxy = 0.0_r8 + this%model%lfmassxy = 0.0_r8 + this%model%rtmassxy = 0.0_r8 + this%model%stmassxy = 0.0_r8 + this%model%woodxy = 0.0_r8 + this%model%stblcpxy = 0.0_r8 + this%model%fastcpxy = 0.0_r8 + this%model%xlaixy = 0.0_r8 + this%model%xsaixy = 0.0_r8 + this%model%taussxy = 0.0_r8 + this%model%smoiseq = 0.0_r8 + this%model%smcwtdxy = 0.0_r8 + this%model%deeprechxy = 0.0_r8 + this%model%rechxy = 0.0_r8 + this%model%sncovr1 = 0.0_r8 + this%model%qsurf = 0.0_r8 + this%model%gflux = 0.0_r8 + this%model%drain = 0.0_r8 + this%model%evap = 0.0_r8 + this%model%hflx = 0.0_r8 + this%model%ep = 0.0_r8 + this%model%runoff = 0.0_r8 + this%model%cmm = 0.0_r8 + this%model%chh = 0.0_r8 + this%model%evbs = 0.0_r8 + this%model%evcw = 0.0_r8 + this%model%sbsno = 0.0_r8 + this%model%pah = 0.0_r8 + this%model%ecan = 0.0_r8 + this%model%etran = 0.0_r8 + this%model%edir = 0.0_r8 + this%model%snowc = 0.0_r8 + this%model%stm = 0.0_r8 + this%model%rhonewsn1 = 0.0_r8 + this%model%snohf = 0.0_r8 + this%model%smcwlt2 = 0.0_r8 + this%model%smcref2 = 0.0_r8 + this%model%wet1 = 0.0_r8 + this%model%t2mmp = 0.0_r8 + this%model%q2mp = 0.0_r8 + this%model%zvfun = 0.0_r8 + this%model%ztmax = 0.0_r8 + this%model%rho = 0.0_r8 + this%model%pores = 0.0_r8 + this%model%resid = 0.0_r8 + this%model%smc = 0.0_r8 + this%model%stc = 0.0_r8 + this%model%slc = 0.0_r8 + this%model%smoiseq = 0.0_r8 + this%model%tsnoxy = 0.0_r8 + this%model%zsnsoxy = 0.0_r8 + this%model%snicexy = 0.0_r8 + this%model%snliqxy = 0.0_r8 end subroutine InitializeDefault @@ -806,6 +816,9 @@ subroutine InitializeStates(this, namelist, static, month) this%model%smcwtdxy(iloc) = 0.0 this%model%deeprechxy(iloc) = 0.0 this%model%rechxy(iloc) = 0.0 + + ! TODO: Fixed number given. This could be coupling field + this%model%rhonewsn1(iloc)= 200.0 end do ! iloc end subroutine InitializeStates diff --git a/src/module_sf_noahmp_glacier.F90 b/src/module_sf_noahmp_glacier.F90 index 6e34c43a..fcbe40a7 100644 --- a/src/module_sf_noahmp_glacier.F90 +++ b/src/module_sf_noahmp_glacier.F90 @@ -2652,7 +2652,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in !to obtain equilibrium state of snow in glacier region - if(sneqv > mwd) then ! 100 mm -> maximum water depth + if(sneqv > mwd .and. isnow /= 0) then ! 100 mm -> maximum water depth bdsnow = snice(0) / dzsnso(0) snoflow = (sneqv - mwd) snice(0) = snice(0) - snoflow diff --git a/src/module_sf_noahmplsm.F90 b/src/module_sf_noahmplsm.F90 index 273343d4..6abd59f6 100644 --- a/src/module_sf_noahmplsm.F90 +++ b/src/module_sf_noahmplsm.F90 @@ -2116,7 +2116,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ! thermal properties of soil, snow, lake, and frozen soil call thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in - dt ,snowh ,snice ,snliq , & !in + dt ,snowh ,snice ,snliq , shdfac, & !in smc ,sh2o ,tg ,stc ,ur , & !in lat ,z0m ,zlvl ,vegtyp , & !in df ,hcpct ,snicev ,snliqv ,epore , & !out @@ -2463,7 +2463,7 @@ end subroutine energy !>\ingroup NoahMP_LSM subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in - dt ,snowh ,snice ,snliq , & !in + dt ,snowh ,snice ,snliq , shdfac, & !in smc ,sh2o ,tg ,stc ,ur , & !in lat ,z0m ,zlvl ,vegtyp , & !in df ,hcpct ,snicev ,snliqv ,epore , & !out @@ -2480,6 +2480,7 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , real (kind=kind_phys) , intent(in) :: dt !< time step [s] real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !< snow ice mass (kg/m2) real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !< snow liq mass (kg/m2) + real (kind=kind_phys) , intent(in) :: shdfac !< green vegetation fraction [0.0-1.0] real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !< thickness of snow/soil layers [m] real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !< soil moisture (ice + liq.) [m3/m3] real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sh2o !< liquid soil moisture [m3/m3] @@ -2539,6 +2540,7 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , ! not in use because of the separation of the canopy layer from the ground. ! but this may represent the effects of leaf litter (niu comments) ! df1 = df1 * exp (sbeta * shdfac) + df(1) = df(1) * exp (sbeta * shdfac) ! compute lake thermal properties ! (no consideration of turbulent mixing for this version) @@ -4888,7 +4890,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & end if endif ! 4 -! use sfc_diag to calculate t2mv and q2v for opt_sfc=1&3 +! use sfc_diag to calculate t2mb and q2b for opt_sfc=1&3 if(opt_diag ==3) then if(opt_sfc == 1 .or. opt_sfc == 3) then @@ -5823,7 +5825,8 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, elseif (opt_trs == chen09) then - z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) +! z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) + z0m_out = fveg * z0m + (1.0 - fveg) * z0mg czil = 10.0 ** (- 0.4 * parameters%hvt) reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c @@ -5873,7 +5876,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out - elseif (opt_trs == tessel) then + elseif (opt_trs == chen09 .or. opt_trs == tessel) then if (vegtyp <= 5) then z0h_out = z0m_out @@ -5881,7 +5884,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out * 0.01 endif - elseif (opt_trs == blumel99 .or. opt_trs == chen09) then + elseif (opt_trs == blumel99) then reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c if (reyn > 2.0) then @@ -11522,7 +11525,7 @@ real*8 function psim_unstable_full(zolf) x=(1.-16.*zolf)**.25 !psimk=2*alog(0.5*(1+x))+alog(0.5*(1+x*x))-2.*atan(x)+2.*atan(1.) - psimk=2.*dlog(0.5*(1+x))+dlog(0.5*(1+x*x))-2.*atan(x)+2.*atan1 + psimk=2.*log(0.5*(1+x))+log(0.5*(1+x*x))-2.*atan(x)+2.*atan1 ym=(1.-10.*zolf)**onethird !psimc=(3./2.)*log((ym**2.+ym+1.)/3.)-sqrt(3.)*atan((2.*ym+1)/sqrt(3.))+4.*atan(1.)/sqrt(3.)