From 5ecb21addee9a5c659c3ba153195fe0e5df660f1 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Thu, 15 Oct 2020 15:06:13 +0000 Subject: [PATCH] feature/coldstart Keep a personal copy of chgres_cube with the new name of coldstart. This copy does not include the nam, rap or hrrr grib2 options. https://github.com/GeorgeGayno-NOAA/UFS_UTILS/issues/9 --- sorc/CMakeLists.txt | 3 +- sorc/coldstart.fd/CMakeLists.txt | 40 + sorc/coldstart.fd/atmosphere.F90 | 2060 ++++++ sorc/coldstart.fd/chgres.F90 | 107 + sorc/coldstart.fd/grib2_util.F90 | 77 + sorc/coldstart.fd/input_data.F90 | 5901 ++++++++++++++++++ sorc/coldstart.fd/model_grid.F90 | 1306 ++++ sorc/coldstart.fd/program_setup.f90 | 598 ++ sorc/coldstart.fd/search_util.f90 | 190 + sorc/coldstart.fd/static_data.F90 | 528 ++ sorc/coldstart.fd/surface.F90 | 3797 +++++++++++ sorc/coldstart.fd/thompson_mp_climo_data.F90 | 329 + sorc/coldstart.fd/utils.f90 | 80 + sorc/coldstart.fd/write_data.F90 | 3116 +++++++++ 14 files changed, 18131 insertions(+), 1 deletion(-) create mode 100644 sorc/coldstart.fd/CMakeLists.txt create mode 100644 sorc/coldstart.fd/atmosphere.F90 create mode 100644 sorc/coldstart.fd/chgres.F90 create mode 100644 sorc/coldstart.fd/grib2_util.F90 create mode 100644 sorc/coldstart.fd/input_data.F90 create mode 100644 sorc/coldstart.fd/model_grid.F90 create mode 100644 sorc/coldstart.fd/program_setup.f90 create mode 100644 sorc/coldstart.fd/search_util.f90 create mode 100644 sorc/coldstart.fd/static_data.F90 create mode 100644 sorc/coldstart.fd/surface.F90 create mode 100644 sorc/coldstart.fd/thompson_mp_climo_data.F90 create mode 100644 sorc/coldstart.fd/utils.f90 create mode 100644 sorc/coldstart.fd/write_data.F90 diff --git a/sorc/CMakeLists.txt b/sorc/CMakeLists.txt index 0bc698c8d..bd6c1e72e 100644 --- a/sorc/CMakeLists.txt +++ b/sorc/CMakeLists.txt @@ -14,7 +14,8 @@ add_subdirectory(nemsio_chgdate.fd) add_subdirectory(mkgfsnemsioctl.fd) add_subdirectory(fre-nctools.fd) add_subdirectory(grid_tools.fd) -add_subdirectory(chgres_cube.fd) +#add_subdirectory(chgres_cube.fd) +add_subdirectory(coldstart.fd) add_subdirectory(orog_mask_tools.fd) add_subdirectory(sfc_climo_gen.fd) add_subdirectory(vcoord_gen.fd) diff --git a/sorc/coldstart.fd/CMakeLists.txt b/sorc/coldstart.fd/CMakeLists.txt new file mode 100644 index 000000000..c74a4e99d --- /dev/null +++ b/sorc/coldstart.fd/CMakeLists.txt @@ -0,0 +1,40 @@ +set(fortran_src + atmosphere.F90 + chgres.F90 + grib2_util.F90 + input_data.F90 + model_grid.F90 + program_setup.f90 + search_util.f90 + static_data.F90 + surface.F90 + thompson_mp_climo_data.F90 + utils.f90 + write_data.F90) + +if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -convert big_endian -assume byterecl") +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-0 -fdefault-real-8 -fconvert=big-endian") +endif() + +set(exe_name coldstart) +add_executable(${exe_name} ${fortran_src}) +target_link_libraries( + ${exe_name} + nemsio::nemsio + sfcio::sfcio + sigio::sigio + bacio::bacio_4 + sp::sp_d + w3nco::w3nco_d + esmf + wgrib2::wgrib2_lib + wgrib2::wgrib2_api + MPI::MPI_Fortran + NetCDF::NetCDF_Fortran) +if(OpenMP_Fortran_FOUND) + target_link_libraries(${exe_name} OpenMP::OpenMP_Fortran) +endif() + +install(TARGETS ${exe_name} RUNTIME DESTINATION ${exec_dir}) diff --git a/sorc/coldstart.fd/atmosphere.F90 b/sorc/coldstart.fd/atmosphere.F90 new file mode 100644 index 000000000..a76ea36b7 --- /dev/null +++ b/sorc/coldstart.fd/atmosphere.F90 @@ -0,0 +1,2060 @@ + module atmosphere + +!-------------------------------------------------------------------------- +! Module atmosphere +! +! Abstract: Process atmospheric fields: Horizontally interpolate input +! fields to the target grid. Adjust surface pressure according to +! terrain difference between input and target grids. Vertically +! interpolate to target grid vertical levels. Processing based on +! the spectral GFS version of CHGRES. +! +! Public Subroutines: +! ------------------- +! atmosphere driver Driver routine for processing atmospheric +! fields +! +! Public variables: +! ----------------- +! Variables defined below. Here "b4adj" indicates fields on the target +! grid before vertical adjustment. "target" indicates data on target +! grid. "input" indicates data on input grid. "_s" indicates fields +! on the 'south' edge of the grid box. "_w" indicate fields on the +! 'west' edge of the grid box. Otherwise, fields are at the center +! of the grid box. +! +!-------------------------------------------------------------------------- + + use esmf + + use input_data, only : lev_input, & + levp1_input, & + tracers_input_grid, & + dzdt_input_grid, & + ps_input_grid, & + wind_input_grid, & + temp_input_grid, & + pres_input_grid, & + terrain_input_grid, & + read_input_atm_data, & + cleanup_input_atm_data + + use model_grid, only : target_grid, & + latitude_s_target_grid, & + longitude_s_target_grid, & + latitude_w_target_grid, & + longitude_w_target_grid, & + terrain_target_grid + + use program_setup, only : vcoord_file_target_grid, & + regional, & + tracers, num_tracers, & + atm_weight_file, & + use_thomp_mp_climo + + use thompson_mp_climo_data, only : read_thomp_mp_climo_data, & + cleanup_thomp_mp_climo_input_data, & + qnifa_climo_input_grid, & + qnwfa_climo_input_grid, & + thomp_pres_climo_input_grid, & + lev_thomp_mp_climo + + implicit none + + private + + integer, public :: lev_target ! num vertical levels + integer, public :: levp1_target ! num levels plus 1 + integer, public :: nvcoord_target ! num vertical coordinate + ! variables + + real(esmf_kind_r8), allocatable, public :: vcoord_target(:,:) ! vertical coordinate + + type(esmf_field), public :: delp_target_grid + ! pressure thickness + type(esmf_field), public :: dzdt_target_grid + ! vertical velocity + type(esmf_field) :: dzdt_b4adj_target_grid + ! vertical vel before vert adj + type(esmf_field), allocatable, public :: tracers_target_grid(:) + ! tracers + type(esmf_field), allocatable :: tracers_b4adj_target_grid(:) + ! tracers before vert adj + type(esmf_field), public :: ps_target_grid + ! surface pressure + type(esmf_field) :: ps_b4adj_target_grid + ! sfc pres before terrain adj + type(esmf_field) :: pres_target_grid + ! 3-d pressure + type(esmf_field) :: pres_b4adj_target_grid + ! 3-d pres before terrain adj + type(esmf_field), public :: temp_target_grid + ! temperautre + type(esmf_field) :: temp_b4adj_target_grid + ! temp before vert adj + type(esmf_field) :: terrain_interp_to_target_grid + ! Input grid terrain + ! interpolated to target grid. + type(esmf_field), public :: u_s_target_grid + ! u-wind, 'south' edge + type(esmf_field), public :: v_s_target_grid + ! v-wind, 'south' edge + type(esmf_field) :: wind_target_grid + ! 3-d wind, grid box center + type(esmf_field) :: wind_b4adj_target_grid + ! 3-d wind before vert adj + type(esmf_field) :: wind_s_target_grid + ! 3-d wind, 'south' edge + type(esmf_field), public :: u_w_target_grid + ! u-wind, 'west' edge + type(esmf_field), public :: v_w_target_grid + ! v-wind, 'west' edge + type(esmf_field) :: wind_w_target_grid + ! 3-d wind, 'west' edge + type(esmf_field), public :: zh_target_grid + ! 3-d height + +! Fields associated with thompson microphysics climatological tracers. + + type(esmf_field) :: qnifa_climo_b4adj_target_grid + ! number concentration of ice + ! friendly aerosols before vert adj + type(esmf_field), public :: qnifa_climo_target_grid + ! number concentration of ice + ! friendly aerosols on target + ! horiz/vert grid. + type(esmf_field) :: qnwfa_climo_b4adj_target_grid + ! number concentration of water + ! friendly aerosols before vert adj + type(esmf_field), public :: qnwfa_climo_target_grid + ! number concentration of water + ! friendly aerosols on target + ! horiz/vert grid. + type(esmf_field) :: thomp_pres_climo_b4adj_target_grid + ! pressure of each level on + ! target grid + + public :: atmosphere_driver + + contains + +!----------------------------------------------------------------------------------- +! Driver routine for atmospheric fields. +!----------------------------------------------------------------------------------- + + subroutine atmosphere_driver(localpet) + + use mpi + + implicit none + + integer, intent(in) :: localpet + + integer :: isrctermprocessing + integer :: rc, n + + type(esmf_regridmethod_flag) :: method + type(esmf_routehandle) :: regrid_bl + + real(esmf_kind_r8), parameter :: p0=101325.0 + real(esmf_kind_r8), parameter :: rd = 287.058 + real(esmf_kind_r8), parameter :: grav = 9.81 + real(esmf_kind_r8), parameter :: lapse = -6.5e-03 + + real(esmf_kind_r8), parameter :: exponent = rd*lapse/grav + real(esmf_kind_r8), parameter :: one_over_exponent = 1.0 / exponent + + real(esmf_kind_r8), pointer :: psptr(:,:) + +!----------------------------------------------------------------------------------- +! Read atmospheric fields on the input grid. +!----------------------------------------------------------------------------------- + + call read_input_atm_data(localpet) + +!----------------------------------------------------------------------------------- +! Read vertical coordinate info for target grid. +!----------------------------------------------------------------------------------- + + call read_vcoord_info + +!----------------------------------------------------------------------------------- +! Create target grid field objects to hold data before vertical adjustment. +!----------------------------------------------------------------------------------- + + call create_atm_b4adj_esmf_fields + +!----------------------------------------------------------------------------------- +! Horizontally interpolate. If specified, use weights from file. +!----------------------------------------------------------------------------------- + + isrctermprocessing = 1 + + if (trim(atm_weight_file) /= "NULL") then + + print*,"- CALL FieldSMMStore FOR ATMOSPHERIC FIELDS." + + call ESMF_FieldSMMStore(temp_input_grid, & + temp_b4adj_target_grid, & + atm_weight_file, & + routehandle=regrid_bl, & + srctermprocessing=isrctermprocessing, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldSMMStore", rc) + + else + + print*,"- CALL FieldRegridStore FOR ATMOSPHERIC FIELDS." + + method=ESMF_REGRIDMETHOD_BILINEAR + + call ESMF_FieldRegridStore(temp_input_grid, & + temp_b4adj_target_grid, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + srctermprocessing=isrctermprocessing, & + extrapmethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + routehandle=regrid_bl, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + endif + + print*,"- CALL Field_Regrid FOR TEMPERATURE." + call ESMF_FieldRegrid(temp_input_grid, & + temp_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FOR PRESSURE." + call ESMF_FieldRegrid(pres_input_grid, & + pres_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + do n = 1, num_tracers + print*,"- CALL Field_Regrid FOR TRACER ", trim(tracers(n)) + call ESMF_FieldRegrid(tracers_input_grid(n), & + tracers_b4adj_target_grid(n), & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + enddo + + print*,"- CALL Field_Regrid FOR VERTICAL VELOCITY." + call ESMF_FieldRegrid(dzdt_input_grid, & + dzdt_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + nullify(psptr) + print*,"- CALL FieldGet FOR INPUT SURFACE PRESSURE." + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +!------------------------------------------------------------------------------------ +! Assume standard lapse rate when interpolating pressure (per Phil Pegion). +!------------------------------------------------------------------------------------ + + psptr = (psptr/p0)**exponent + + print*,"- CALL Field_Regrid FOR SURFACE PRESSURE." + call ESMF_FieldRegrid(ps_input_grid, & + ps_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + nullify(psptr) + print*,"- CALL FieldGet FOR INPUT SURFACE PRESSURE B4ADJ." + call ESMF_FieldGet(ps_b4adj_target_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + psptr = p0 * psptr**one_over_exponent + + print*,"- CALL Field_Regrid FOR TERRAIN." + call ESMF_FieldRegrid(terrain_input_grid, & + terrain_interp_to_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FOR 3-D WIND." + call ESMF_FieldRegrid(wind_input_grid, & + wind_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!----------------------------------------------------------------------------------- +! Deallocate input fields. +!----------------------------------------------------------------------------------- + + call cleanup_input_atm_data + +!----------------------------------------------------------------------------------- +! Create target grid field objects to hold data after vertical interpolation. +!----------------------------------------------------------------------------------- + + call create_atm_esmf_fields + +!----------------------------------------------------------------------------------- +! Adjust surface pressure for terrain differences. +!----------------------------------------------------------------------------------- + + call newps(localpet) + +!----------------------------------------------------------------------------------- +! Compute 3-d pressure based on adjusted surface pressure. +!----------------------------------------------------------------------------------- + + call newpr1(localpet) + +!----------------------------------------------------------------------------------- +! Vertically interpolate. +!----------------------------------------------------------------------------------- + + call vintg + +!----------------------------------------------------------------------------------- +! Compute height. +!----------------------------------------------------------------------------------- + + call compute_zh + +!----------------------------------------------------------------------------------- +! Free up memory. +!----------------------------------------------------------------------------------- + + call cleanup_target_atm_b4adj_data + +!----------------------------------------------------------------------------------- +! Interpolate winds to 'd' grid. +!----------------------------------------------------------------------------------- + + isrctermprocessing = 1 + method=ESMF_REGRIDMETHOD_BILINEAR + + print*,"- CALL FieldRegridStore FOR 3D-WIND WEST EDGE." + call ESMF_FieldRegridStore(wind_target_grid, & + wind_w_target_grid, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + srctermprocessing=isrctermprocessing, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + routehandle=regrid_bl, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid FOR 3-D WIND WEST EDGE." + call ESMF_FieldRegrid(wind_target_grid, & + wind_w_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + + isrctermprocessing = 1 + method=ESMF_REGRIDMETHOD_BILINEAR + + print*,"- CALL FieldRegridStore FOR 3D-WIND SOUTH EDGE." + call ESMF_FieldRegridStore(wind_target_grid, & + wind_s_target_grid, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + srctermprocessing=isrctermprocessing, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + routehandle=regrid_bl, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid FOR 3-D WIND SOUTH EDGE." + call ESMF_FieldRegrid(wind_target_grid, & + wind_s_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!----------------------------------------------------------------------------------- +! Convert from 3-d to 2-d cartesian winds. +!----------------------------------------------------------------------------------- + + call convert_winds + +!----------------------------------------------------------------------------------- +! If selected, process thompson microphysics climatological fields. +!----------------------------------------------------------------------------------- + + if (use_thomp_mp_climo) then + call read_thomp_mp_climo_data + call horiz_interp_thomp_mp_climo + call vintg_thomp_mp_climo + endif + +!----------------------------------------------------------------------------------- +! Write target data to file. +!----------------------------------------------------------------------------------- + + call write_fv3_atm_header_netcdf(localpet) + if (regional <= 1) call write_fv3_atm_data_netcdf(localpet) + if (regional >= 1) call write_fv3_atm_bndy_data_netcdf(localpet) + +!----------------------------------------------------------------------------------- +! Free up memory. +!----------------------------------------------------------------------------------- + + call cleanup_target_atm_data + + end subroutine atmosphere_driver + +!----------------------------------------------------------------------------------- +! Create target grid field objects to hold data before vertical interpolation. +! These will be defined with the same number of vertical levels as the input grid. +!----------------------------------------------------------------------------------- + + subroutine create_atm_b4adj_esmf_fields + + implicit none + + integer :: rc, n + + allocate(tracers_b4adj_target_grid(num_tracers)) + + do n = 1, num_tracers + print*,"- CALL FieldCreate FOR TARGET GRID TRACER BEFORE ADJUSTMENT ", trim(tracers(n)) + tracers_b4adj_target_grid(n) = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR TARGET GRID TEMPERATURE BEFORE ADJUSTMENT." + temp_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID PRESSURE BEFORE ADJUSTMENT." + pres_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID VERTICAL VELOCITY BEFORE ADJUSTMENT." + dzdt_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID UNSTAGGERED WINDS BEFORE ADJUSTMENT." + wind_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_input,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET TERRAIN." + terrain_interp_to_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET SURFACE PRESSURE BEFORE ADJUSTMENT." + ps_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine create_atm_b4adj_esmf_fields + +!----------------------------------------------------------------------------------- +! Create target grid field objects. +!----------------------------------------------------------------------------------- + + subroutine create_atm_esmf_fields + + implicit none + + integer :: rc, n + + allocate(tracers_target_grid(num_tracers)) + + do n = 1, num_tracers + print*,"- CALL FieldCreate FOR TARGET GRID TRACERS ", trim(tracers(n)) + tracers_target_grid(n) = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR TARGET GRID TEMPERATURE." + temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID PRESSURE." + pres_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID VERTICAL VELOCITY." + dzdt_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID DELP." + delp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET HEIGHT." + zh_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/levp1_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET UNSTAGGERED 3D-WIND." + wind_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_target,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET U_S." + u_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET V_S." + v_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET 3D-WIND_S." + wind_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_target,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET U_W." + u_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET V_W." + v_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET 3D-WIND_W." + wind_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_target,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET SURFACE PRESSURE." + ps_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine create_atm_esmf_fields + + subroutine convert_winds + + implicit none + + integer :: clb(4), cub(4) + integer :: i, j, k, rc + + real(esmf_kind_r8), pointer :: latptr(:,:) + real(esmf_kind_r8), pointer :: lonptr(:,:) + real(esmf_kind_r8), pointer :: uptr(:,:,:) + real(esmf_kind_r8), pointer :: vptr(:,:,:) + real(esmf_kind_r8), pointer :: windptr(:,:,:,:) + real(esmf_kind_r8) :: latrad, lonrad + +!----------------------------------------------------------------------------------- +! Convert from 3-d cartesian to 2-cartesian winds +!----------------------------------------------------------------------------------- + + print*,'- CONVERT WINDS.' + + print*,"- CALL FieldGet FOR 3-D WIND_S." + call ESMF_FieldGet(wind_s_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=windptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR U_S." + call ESMF_FieldGet(u_s_target_grid, & + farrayPtr=uptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR V_S." + call ESMF_FieldGet(v_s_target_grid, & + farrayPtr=vptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LATITUDE_S." + call ESMF_FieldGet(latitude_s_target_grid, & + farrayPtr=latptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LONGITUDE_S." + call ESMF_FieldGet(longitude_s_target_grid, & + farrayPtr=lonptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + latrad = latptr(i,j) * acos(-1.) / 180.0 + lonrad = lonptr(i,j) * acos(-1.) / 180.0 + do k = clb(3), cub(3) + uptr(i,j,k) = windptr(i,j,k,1) * cos(lonrad) + windptr(i,j,k,2) * sin(lonrad) + vptr(i,j,k) = -windptr(i,j,k,1) * sin(latrad) * sin(lonrad) + & + windptr(i,j,k,2) * sin(latrad) * cos(lonrad) + & + windptr(i,j,k,3) * cos(latrad) + enddo + enddo + enddo + + print*,"- CALL FieldGet FOR 3-D WIND_W." + call ESMF_FieldGet(wind_w_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=windptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR U_W." + call ESMF_FieldGet(u_w_target_grid, & + farrayPtr=uptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR V_W." + call ESMF_FieldGet(v_w_target_grid, & + farrayPtr=vptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LATITUDE_W." + call ESMF_FieldGet(latitude_w_target_grid, & + farrayPtr=latptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LONGITUDE_W." + call ESMF_FieldGet(longitude_w_target_grid, & + farrayPtr=lonptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + latrad = latptr(i,j) * acos(-1.) / 180.0 + lonrad = lonptr(i,j) * acos(-1.) / 180.0 + do k = clb(3), cub(3) + uptr(i,j,k) = windptr(i,j,k,1) * cos(lonrad) + windptr(i,j,k,2) * sin(lonrad) + vptr(i,j,k) = -windptr(i,j,k,1) * sin(latrad) * sin(lonrad) + & + windptr(i,j,k,2) * sin(latrad) * cos(lonrad) + & + windptr(i,j,k,3) * cos(latrad) + enddo + enddo + enddo + + end subroutine convert_winds + + subroutine newpr1(localpet) +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: NEWPR1 COMPUTE MODEL PRESSURES +! PRGMMR: JUANG ORG: W/NMC23 DATE: 2005-04-11 +! PRGMMR: Fanglin Yang ORG: W/NMC23 DATE: 2006-11-28 +! PRGMMR: S. Moorthi ORG: NCEP/EMC DATE: 2006-12-12 +! PRGMMR: S. Moorthi ORG: NCEP/EMC DATE: 2007-01-02 +! +! ABSTRACT: COMPUTE MODEL PRESSURES. +! +! PROGRAM HISTORY LOG: +! 2005-04-11 HANN_MING HENRY JUANG hybrid sigma, sigma-p, and sigma- +! +! USAGE: CALL NEWPR1(IM,IX,KM,KMP,IDVC,IDSL,NVCOORD,VCOORD,PP,TP,QP,P +! INPUT ARGUMENT LIST: +! IM INTEGER NUMBER OF POINTS TO COMPUTE +! KM INTEGER NUMBER OF LEVELS +! IDVC INTEGER VERTICAL COORDINATE ID +! (1 FOR SIGMA AND 2 FOR HYBRID) +! IDSL INTEGER TYPE OF SIGMA STRUCTURE +! (1 FOR PHILLIPS OR 2 FOR MEAN) +! NVCOORD INTEGER NUMBER OF VERTICAL COORDINATES +! VCOORD REAL (KM+1,NVCOORD) VERTICAL COORDINATE VALUES +! FOR IDVC=1, NVCOORD=1: SIGMA INTERFACE +! FOR IDVC=2, NVCOORD=2: HYBRID INTERFACE A AND B +! FOR IDVC=3, NVCOORD=3: JUANG GENERAL HYBRID INTERFACE +! AK REAL (KM+1) HYBRID INTERFACE A +! BK REAL (KM+1) HYBRID INTERFACE B +! PS REAL (IX) SURFACE PRESSURE (PA) +! OUTPUT ARGUMENT LIST: +! PM REAL (IX,KM) MID-LAYER PRESSURE (PA) +! DP REAL (IX,KM) LAYER DELTA PRESSURE (PA) +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +!C$$$ + implicit none + + integer, intent(in) :: localpet + + integer :: idsl, idvc, rc + integer :: i, j, k, clb(3), cub(3) + + real(esmf_kind_r8), parameter :: rd=287.05 + real(esmf_kind_r8), parameter :: cp=1004.6 + real(esmf_kind_r8), parameter :: rocp=rd/cp + real(esmf_kind_r8), parameter :: rocp1=rocp+1 + real(esmf_kind_r8), parameter :: rocpr=1/rocp + + real(esmf_kind_r8), pointer :: delp_ptr(:,:,:) + real(esmf_kind_r8), pointer :: pptr(:,:,:) ! adjusted 3-d p. + real(esmf_kind_r8), pointer :: psptr(:,:) ! adjusted surface p. + real(esmf_kind_r8) :: ak, bk + real(esmf_kind_r8), allocatable :: pi(:,:,:) + + print*,"COMPUTE 3-D PRESSURE FROM ADJUSTED SURFACE PRESSURE." + + idvc = 2 ! hard wire for now. + idsl = 2 ! hard wire for now. + + print*,"- CALL FieldGet FOR 3-D PRES." + call ESMF_FieldGet(pres_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR DELP." + call ESMF_FieldGet(delp_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=delp_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE AFTER ADJUSTMENT" + call ESMF_FieldGet(ps_target_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_target)) + + if(idvc.eq.2) then + do k=1,levp1_target + ak = vcoord_target(k,1) + bk = vcoord_target(k,2) + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pi(i,j,k) = ak + bk*psptr(i,j) + enddo + enddo + enddo + do k=1,lev_target + do i= clb(1), cub(1) + do j= clb(2), cub(2) + delp_ptr(i,j,k) = pi(i,j,k) - pi(i,j,k+1) + enddo + enddo + enddo + else + call error_handler("PROGRAM ONLY WORKS WITH IDVC 2", 1) + endif + + if(idsl.eq.2) then + do k=1,lev_target + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0 + enddo + enddo + enddo + else + do k=1,lev_target + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = ((pi(i,j,k)**rocp1-pi(i,j,k+1)**rocp1)/ & + (rocp1*(pi(i,j,k)-pi(i,j,k+1))))**rocpr + enddo + enddo + enddo + endif + + deallocate(pi) + + if (localpet == 0) then + print*,'new pres ',pptr(clb(1),clb(2),:) + print*,'delp ',delp_ptr(clb(1),clb(2),:) + endif + + end subroutine newpr1 + + subroutine newps(localpet) + +!$$$ subprogram documentation block +! +! subprogram: newps compute new surface pressure +! prgmmr: iredell org: w/nmc23 date: 92-10-31 +! +! abstract: computes a new surface pressure given a new orography. +! the new pressure is computed assuming a hydrostatic balance +! and a constant temperature lapse rate. below ground, the +! lapse rate is assumed to be -6.5 k/km. +! +! program history log: +! 91-10-31 mark iredell +! 2018-apr adapt for fv3. george gayno +! +!c$$$ + + implicit none + + integer, intent(in) :: localpet + integer :: i, j, k, ii + integer :: clb(3), cub(3), ls, rc + + real(esmf_kind_r8), pointer :: pptr(:,:,:) + real(esmf_kind_r8), pointer :: psptr(:,:) + real(esmf_kind_r8), pointer :: psnewptr(:,:) ! adjusted surface p. + real(esmf_kind_r8), pointer :: tptr(:,:,:) + real(esmf_kind_r8), pointer :: qptr(:,:,:) + real(esmf_kind_r8), pointer :: zsptr(:,:) + real(esmf_kind_r8), pointer :: zsnewptr(:,:) + real(esmf_kind_r8), allocatable :: zu(:,:) + real(esmf_kind_r8), parameter :: beta=-6.5E-3 + real(esmf_kind_r8), parameter :: epsilon=1.E-9 + real(esmf_kind_r8), parameter :: g=9.80665 + real(esmf_kind_r8), parameter :: rd=287.05 + real(esmf_kind_r8), parameter :: rv=461.50 + real(esmf_kind_r8), parameter :: gor=g/rd + real(esmf_kind_r8), parameter :: fv=rv/rd-1. + real(esmf_kind_r8) :: ftv, fgam, apu, fz0 + real(esmf_kind_r8) :: atvu, atv, fz1, fp0 + real(esmf_kind_r8) :: apd, azd, agam, azu + real(esmf_kind_r8) :: atvd, fp1, gamma, pu + real(esmf_kind_r8) :: tvu, pd, tvd + real(esmf_kind_r8) :: at, aq, ap, az + + ftv(at,aq)=at*(1+fv*aq) + fgam(apu,atvu,apd,atvd)=-gor*log(atvd/atvu)/log(apd/apu) + fz0(ap,atv,azd,apd)=azd+atv/gor*log(apd/ap) + fz1(ap,atv,azd,apd,agam)=azd-atv/agam*((apd/ap)**(-agam/gor)-1) + fp0(az,azu,apu,atvu)=apu*exp(-gor/atvu*(az-azu)) + fp1(az,azu,apu,atvu,agam)=apu*(1+agam/atvu*(az-azu))**(-gor/agam) + + print*,"- ADJUST SURFACE PRESSURE FOR NEW TERRAIN." + + print*,"- CALL FieldGet FOR 3-D PRES." + call ESMF_FieldGet(pres_b4adj_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + if(localpet==0) then + print*,'old pres ',pptr(clb(1),clb(2),:) + endif + + print*,"- CALL FieldGet FOR TEMPERATURE" + call ESMF_FieldGet(temp_b4adj_target_grid, & + farrayPtr=tptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +! Find specific humidity in the array of tracer fields. + + do ii = 1, num_tracers + if (trim(tracers(ii)) == "sphum") exit + enddo + + print*,"- CALL FieldGet FOR SPECIFIC HUMIDITY" + call ESMF_FieldGet(tracers_b4adj_target_grid(ii), & + farrayPtr=qptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE BEFORE ADJUSTMENT" + call ESMF_FieldGet(ps_b4adj_target_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE AFTER ADJUSTMENT" + call ESMF_FieldGet(ps_target_grid, & + farrayPtr=psnewptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR OLD TERRAIN" + call ESMF_FieldGet(terrain_interp_to_target_grid, & + farrayPtr=zsptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR NEW TERRAIN" + call ESMF_FieldGet(terrain_target_grid, & + farrayPtr=zsnewptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + allocate(zu(clb(1):cub(1),clb(2):cub(2))) + +!----------------------------------------------------------------------------------- +! Note, this routine was adapted from the spectral GFS which labeled the lowest +! model layer as '1'. +!----------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------- +! Compute surface pressure below the original ground. +!----------------------------------------------------------------------------------- + + ls=0 + k=1 + gamma=beta + do i=clb(1), cub(1) + do j=clb(2), cub(2) + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + zu(i,j)=fz1(pu,tvu,zsptr(i,j),psptr(i,j),gamma) + if(zsnewptr(i,j).le.zu(i,j)) then + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + if(abs(gamma).gt.epsilon) then + psnewptr(i,j)=fp1(zsnewptr(i,j),zu(i,j),pu,tvu,gamma) + else + psnewptr(i,j)=fp0(zsnewptr(i,j),zu(i,j),pu,tvu) + endif + else + psnewptr(i,j)=0 + ls=ls+1 + endif + enddo + enddo + +!----------------------------------------------------------------------------------- +! Compute surface pressure above the original ground. +!----------------------------------------------------------------------------------- + + do k=2,cub(3) + if(ls.gt.0) then + do i=clb(1),cub(1) + do j=clb(2),cub(2) + if(psnewptr(i,j).eq.0) then + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + pd=pptr(i,j,k-1) + tvd=ftv(tptr(i,j,k-1),qptr(i,j,k-1)) + gamma=fgam(pu,tvu,pd,tvd) + if(abs(gamma).gt.epsilon) then + zu(i,j)=fz1(pu,tvu,zu(i,j),pd,gamma) + else + zu(i,j)=fz0(pu,tvu,zu(i,j),pd) + endif + if(zsnewptr(i,j).le.zu(i,j)) then + if(abs(gamma).gt.epsilon) then + psnewptr(i,j)=fp1(zsnewptr(i,j),zu(i,j),pu,tvu,gamma) + else + psnewptr(i,j)=fp0(zsnewptr(i,j),zu(i,j),pu,tvu) + endif + ls=ls-1 + endif + endif + enddo + enddo + endif + enddo + +!----------------------------------------------------------------------------------- +! Compute surface pressure over the top. +!----------------------------------------------------------------------------------- + + + if(ls.gt.0) then + k=cub(3) + gamma=0 + do i=clb(1),cub(1) + do j=clb(2),cub(2) + if(psnewptr(i,j).eq.0) then + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + psnewptr(i,j)=fp0(zsnewptr(i,j),zu(i,j),pu,tvu) + endif + enddo + enddo + endif + + deallocate(zu) + + if (localpet == 0) then +! do i=clb(1),cub(1) +! do j=clb(2),cub(2) + do i=clb(1),clb(1) + do j=clb(2),clb(2) + print*,'sfcp adjust ',(zsnewptr(i,j)-zsptr(i,j)), psptr(i,j),psnewptr(i,j) + enddo + enddo + endif + + end subroutine newps + + subroutine read_vcoord_info + +!--------------------------------------------------------------------------------- +! Read vertical coordinate information. +!--------------------------------------------------------------------------------- + + implicit none + + integer :: istat, n, k + + print* + print*,"OPEN VERTICAL COORD FILE: ", trim(vcoord_file_target_grid) + open(14, file=trim(vcoord_file_target_grid), form='formatted', iostat=istat) + if (istat /= 0) then + call error_handler("OPENING VERTICAL COORD FILE", istat) + endif + + read(14, *, iostat=istat) nvcoord_target, lev_target + if (istat /= 0) then + call error_handler("READING VERTICAL COORD FILE", istat) + endif + + levp1_target = lev_target + 1 + + allocate(vcoord_target(levp1_target, nvcoord_target)) + read(14, *, iostat=istat) ((vcoord_target(n,k), k=1,nvcoord_target), n=1,levp1_target) + if (istat /= 0) then + call error_handler("READING VERTICAL COORD FILE", istat) + endif + + print* + do k = 1, levp1_target + print*,'VCOORD FOR LEV ', k, 'IS: ', vcoord_target(k,:) + enddo + + close(14) + + end subroutine read_vcoord_info + +!----------------------------------------------------------------------------------- +! Horizontally interpolate thompson microphysics data to the target model grid. +!----------------------------------------------------------------------------------- + + subroutine horiz_interp_thomp_mp_climo + + implicit none + + integer :: isrctermprocessing, rc + + type(esmf_regridmethod_flag) :: method + type(esmf_routehandle) :: regrid_bl + + isrctermprocessing=1 + + print*,"- CALL FieldCreate FOR TARGET GRID THOMP CLIMO QNIFA BEFORE ADJUSTMENT." + qnifa_climo_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_thomp_mp_climo/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID THOMP CLIMO QNWFA BEFORE ADJUSTMENT." + qnwfa_climo_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_thomp_mp_climo/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID THOMP CLIMO PRESSURE BEFORE ADJUSTMENT." + thomp_pres_climo_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_thomp_mp_climo/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID THOMP CLIMO QNIFA." + qnifa_climo_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID THOMP CLIMO QNWFA." + qnwfa_climo_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldRegridStore FOR THOMPSON CLIMO FIELDS." + + method=ESMF_REGRIDMETHOD_BILINEAR + + call ESMF_FieldRegridStore(qnifa_climo_input_grid, & + qnifa_climo_b4adj_target_grid, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + srctermprocessing=isrctermprocessing, & + extrapmethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + routehandle=regrid_bl, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid FOR THOMP CLIMO QNIFA." + call ESMF_FieldRegrid(qnifa_climo_input_grid, & + qnifa_climo_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FOR THOMP CLIMO QNWFA." + call ESMF_FieldRegrid(qnwfa_climo_input_grid, & + qnwfa_climo_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FOR THOMP PRESSURE." + call ESMF_FieldRegrid(thomp_pres_climo_input_grid, & + thomp_pres_climo_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!----------------------------------------------------------------------------------- +! Free up input data memory. +!----------------------------------------------------------------------------------- + + call cleanup_thomp_mp_climo_input_data + + end subroutine horiz_interp_thomp_mp_climo + +!----------------------------------------------------------------------------------- +! Vertically interpolate thompson mp climo tracers to the target model levels. +!----------------------------------------------------------------------------------- + + SUBROUTINE VINTG_THOMP_MP_CLIMO + + implicit none + + INTEGER :: CLB(3), CUB(3), RC + INTEGER :: IM, KM1, KM2, NT + INTEGER :: I, J, K + + REAL(ESMF_KIND_R8), ALLOCATABLE :: Z1(:,:,:), Z2(:,:,:) + REAL(ESMF_KIND_R8), ALLOCATABLE :: C1(:,:,:,:),C2(:,:,:,:) + + REAL(ESMF_KIND_R8), POINTER :: QNIFA1PTR(:,:,:) ! input + REAL(ESMF_KIND_R8), POINTER :: QNIFA2PTR(:,:,:) ! target + REAL(ESMF_KIND_R8), POINTER :: QNWFA1PTR(:,:,:) ! input + REAL(ESMF_KIND_R8), POINTER :: QNWFA2PTR(:,:,:) ! target + REAL(ESMF_KIND_R8), POINTER :: P1PTR(:,:,:) ! input pressure + REAL(ESMF_KIND_R8), POINTER :: P2PTR(:,:,:) ! target pressure + + print*,"- VERTICALY INTERPOLATE THOMP MP CLIMO TRACERS." + + print*,"- CALL FieldGet FOR 3-D THOMP PRES." + call ESMF_FieldGet(thomp_pres_climo_b4adj_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=p1ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! The '1'/'2' arrays hold fields before/after interpolation. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + NT= 2 ! number of thomp tracers + + ALLOCATE(Z1(CLB(1):CUB(1),CLB(2):CUB(2),lev_thomp_mp_climo)) + ALLOCATE(Z2(CLB(1):CUB(1),CLB(2):CUB(2),LEV_TARGET)) + ALLOCATE(C1(CLB(1):CUB(1),CLB(2):CUB(2),lev_thomp_mp_climo,NT)) + ALLOCATE(C2(CLB(1):CUB(1),CLB(2):CUB(2),LEV_TARGET,NT)) + + Z1 = -LOG(P1PTR) + + print*,"- CALL FieldGet FOR 3-D ADJUSTED PRESS" + call ESMF_FieldGet(pres_target_grid, & + farrayPtr=P2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + Z2 = -LOG(P2PTR) + +!print*,'pres check 1 ', p1ptr(clb(1),clb(2),:) +!print*,'pres check 2 ', p2ptr(clb(1),clb(2),:) + + print*,"- CALL FieldGet FOR qnifa before vertical adjustment." + call ESMF_FieldGet(qnifa_climo_b4adj_target_grid, & + farrayPtr=QNIFA1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,1) = QNIFA1PTR(:,:,:) + + print*,"- CALL FieldGet FOR qnwfa before vertical adjustment." + call ESMF_FieldGet(qnwfa_climo_b4adj_target_grid, & + farrayPtr=QNWFA1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,2) = QNWFA1PTR(:,:,:) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! PERFORM LAGRANGIAN ONE-DIMENSIONAL INTERPOLATION +! THAT IS 4TH-ORDER IN INTERIOR, 2ND-ORDER IN OUTSIDE INTERVALS +! AND 1ST-ORDER FOR EXTRAPOLATION. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + IM = (CUB(1)-CLB(1)+1) * (CUB(2)-CLB(2)+1) + KM1= LEV_THOMP_MP_CLIMO + KM2= LEV_TARGET + + CALL TERP3(IM,1,1,1,1,NT,(IM*KM1),(IM*KM2), & + KM1,IM,IM,Z1,C1,KM2,IM,IM,Z2,C2) + + print*,"- CALL FieldGet FOR ADJUSTED climo qnifa." + call ESMF_FieldGet(qnifa_climo_target_grid, & + farrayPtr=QNIFA2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR ADJUSTED climo qnwfa." + call ESMF_FieldGet(qnwfa_climo_target_grid, & + farrayPtr=QNWFA2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + DO K=1,LEV_TARGET + DO I=CLB(1),CUB(1) + DO J=CLB(2),CUB(2) + QNIFA2PTR(I,J,K) = C2(I,J,K,1) + QNWFA2PTR(I,J,K) = C2(I,J,K,2) + ENDDO + ENDDO + ENDDO + + DEALLOCATE (Z1, Z2, C1, C2) + + call ESMF_FieldDestroy(qnifa_climo_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(qnwfa_climo_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(thomp_pres_climo_b4adj_target_grid, rc=rc) + + END SUBROUTINE VINTG_THOMP_MP_CLIMO + + SUBROUTINE VINTG +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: VINTG VERTICALLY INTERPOLATE UPPER-AIR FIELDS +! PRGMMR: IREDELL ORG: W/NMC23 DATE: 92-10-31 +! +! ABSTRACT: VERTICALLY INTERPOLATE UPPER-AIR FIELDS. +! WIND, TEMPERATURE, HUMIDITY AND OTHER TRACERS ARE INTERPOLATED. +! THE INTERPOLATION IS CUBIC LAGRANGIAN IN LOG PRESSURE +! WITH A MONOTONIC CONSTRAINT IN THE CENTER OF THE DOMAIN. +! IN THE OUTER INTERVALS IT IS LINEAR IN LOG PRESSURE. +! OUTSIDE THE DOMAIN, FIELDS ARE GENERALLY HELD CONSTANT, +! EXCEPT FOR TEMPERATURE AND HUMIDITY BELOW THE INPUT DOMAIN, +! WHERE THE TEMPERATURE LAPSE RATE IS HELD FIXED AT -6.5 K/KM AND +! THE RELATIVE HUMIDITY IS HELD CONSTANT. THIS ROUTINE EXPECTS +! FIELDS ORDERED FROM BOTTOM TO TOP OF ATMOSPHERE. +! +! PROGRAM HISTORY LOG: +! 91-10-31 MARK IREDELL +! +! USAGE: CALL VINTG +! +! SUBPROGRAMS CALLED: +! TERP3 CUBICALLY INTERPOLATE IN ONE DIMENSION +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +! + use mpi + + IMPLICIT NONE + + REAL(ESMF_KIND_R8), PARAMETER :: DLTDZ=-6.5E-3*287.05/9.80665 + REAL(ESMF_KIND_R8), PARAMETER :: DLPVDRT=-2.5E6/461.50 + REAL(ESMF_KIND_R8), PARAMETER :: ONE = 1.0_ESMF_KIND_R8 + + INTEGER :: I, J, K, CLB(3), CUB(3), RC + INTEGER :: IM, KM1, KM2, NT, II + + REAL(ESMF_KIND_R8) :: DZ + REAL(ESMF_KIND_R8), ALLOCATABLE :: Z1(:,:,:), Z2(:,:,:) + REAL(ESMF_KIND_R8), ALLOCATABLE :: C1(:,:,:,:),C2(:,:,:,:) + + REAL(ESMF_KIND_R8), POINTER :: P1PTR(:,:,:) ! input pressure + REAL(ESMF_KIND_R8), POINTER :: P2PTR(:,:,:) ! output pressure + REAL(ESMF_KIND_R8), POINTER :: DZDT1PTR(:,:,:) ! input vvel + REAL(ESMF_KIND_R8), POINTER :: DZDT2PTR(:,:,:) ! output vvel + REAL(ESMF_KIND_R8), POINTER :: T1PTR(:,:,:) ! input temperature + REAL(ESMF_KIND_R8), POINTER :: T2PTR(:,:,:) ! output temperature + REAL(ESMF_KIND_R8), POINTER :: Q1PTR(:,:,:) ! input tracer + REAL(ESMF_KIND_R8), POINTER :: Q2PTR(:,:,:) ! output tracer + REAL(ESMF_KIND_R8), POINTER :: WIND1PTR(:,:,:,:) ! input wind (x,y,z components) + REAL(ESMF_KIND_R8), POINTER :: WIND2PTR(:,:,:,:) ! input wind (x,y,z components) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! COMPUTE LOG PRESSURE INTERPOLATING COORDINATE +! AND COPY INPUT WIND, TEMPERATURE, HUMIDITY AND OTHER TRACERS +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + print*,"- VERTICALY INTERPOLATE FIELDS." + + print*,"- CALL FieldGet FOR 3-D PRES." + call ESMF_FieldGet(pres_b4adj_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=p1ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! The '1'/'2' arrays hold fields before/after interpolation. +! Note the 'z' component of the horizontal wind will be treated as a +! tracer. So add one extra third dimension to these 3-d arrays. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + ALLOCATE(Z1(CLB(1):CUB(1),CLB(2):CUB(2),LEV_INPUT)) + ALLOCATE(Z2(CLB(1):CUB(1),CLB(2):CUB(2),LEV_TARGET)) + ALLOCATE(C1(CLB(1):CUB(1),CLB(2):CUB(2),LEV_INPUT,NUM_TRACERS+5)) + ALLOCATE(C2(CLB(1):CUB(1),CLB(2):CUB(2),LEV_TARGET,NUM_TRACERS+5)) + + Z1 = -LOG(P1PTR) + + print*,"- CALL FieldGet FOR 3-D ADJUSTED PRESS" + call ESMF_FieldGet(pres_target_grid, & + farrayPtr=P2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + Z2 = -LOG(P2PTR) + + print*,"- CALL FieldGet FOR 3-D WIND." + call ESMF_FieldGet(wind_b4adj_target_grid, & + farrayPtr=WIND1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,1) = WIND1PTR(:,:,:,1) + C1(:,:,:,2) = WIND1PTR(:,:,:,2) + C1(:,:,:,3) = WIND1PTR(:,:,:,3) + + print*,"- CALL FieldGet FOR VERTICAL VELOCITY." + call ESMF_FieldGet(dzdt_b4adj_target_grid, & + farrayPtr=DZDT1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,4) = DZDT1PTR(:,:,:) + + print*,"- CALL FieldGet FOR 3-D TEMP." + call ESMF_FieldGet(temp_b4adj_target_grid, & + farrayPtr=T1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,5) = T1PTR(:,:,:) + + DO I = 1, NUM_TRACERS + + print*,"- CALL FieldGet FOR 3-D TRACERS ", trim(tracers(i)) + call ESMF_FieldGet(tracers_b4adj_target_grid(i), & + farrayPtr=Q1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,5+I) = Q1PTR(:,:,:) + + ENDDO + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! PERFORM LAGRANGIAN ONE-DIMENSIONAL INTERPOLATION +! THAT IS 4TH-ORDER IN INTERIOR, 2ND-ORDER IN OUTSIDE INTERVALS +! AND 1ST-ORDER FOR EXTRAPOLATION. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + IM = (CUB(1)-CLB(1)+1) * (CUB(2)-CLB(2)+1) + KM1= LEV_INPUT + KM2= LEV_TARGET + NT= NUM_TRACERS + 1 ! treat 'z' wind as tracer. + + CALL TERP3(IM,1,1,1,1,4+NT,(IM*KM1),(IM*KM2), & + KM1,IM,IM,Z1,C1,KM2,IM,IM,Z2,C2) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! COPY OUTPUT WIND, TEMPERATURE, HUMIDITY AND OTHER TRACERS +! EXCEPT BELOW THE INPUT DOMAIN, LET TEMPERATURE INCREASE WITH A FIXED +! LAPSE RATE AND LET THE RELATIVE HUMIDITY REMAIN CONSTANT. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + print*,"- CALL FieldGet FOR 3-D ADJUSTED TEMP." + call ESMF_FieldGet(temp_target_grid, & + farrayPtr=T2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR ADJUSTED VERTICAL VELOCITY." + call ESMF_FieldGet(dzdt_target_grid, & + farrayPtr=DZDT2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR 3-D ADJUSTED WIND." + call ESMF_FieldGet(wind_target_grid, & + farrayPtr=WIND2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + DO K=1,LEV_TARGET + DO I=CLB(1),CUB(1) + DO J=CLB(2),CUB(2) + WIND2PTR(I,J,K,1)=C2(I,J,K,1) + WIND2PTR(I,J,K,2)=C2(I,J,K,2) + WIND2PTR(I,J,K,3)=C2(I,J,K,3) + DZDT2PTR(I,J,K)=C2(I,J,K,4) + DZ=Z2(I,J,K)-Z1(I,J,1) + IF(DZ.GE.0) THEN + T2PTR(I,J,K)=C2(I,J,K,5) + ELSE + T2PTR(I,J,K)=C1(I,J,1,5)*EXP(DLTDZ*DZ) + ENDIF + ENDDO + ENDDO + ENDDO + + DO II = 1, NUM_TRACERS + + print*,"- CALL FieldGet FOR 3-D TRACER ", trim(tracers(ii)) + call ESMF_FieldGet(tracers_target_grid(ii), & + farrayPtr=Q2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + IF (TRIM(TRACERS(II)) == "sphum") THEN ! specific humidity + + DO K=1,LEV_TARGET + DO I=CLB(1),CUB(1) + DO J=CLB(2),CUB(2) + DZ=Z2(I,J,K)-Z1(I,J,1) + IF(DZ.GE.0) THEN + Q2PTR(I,J,K) = C2(I,J,K,5+II) + ELSE + Q2PTR(I,J,K) = C1(I,J,1,5+II)*EXP(DLPVDRT*(ONE/T2PTR(I,J,K)-ONE/T1PTR(I,J,1))-DZ) + ENDIF + ENDDO + ENDDO + ENDDO + + ELSE ! all other tracers + + DO K=1,LEV_TARGET + DO I=CLB(1),CUB(1) + DO J=CLB(2),CUB(2) + Q2PTR(I,J,K) = C2(I,J,K,5+II) + ENDDO + ENDDO + ENDDO + + ENDIF + + ENDDO + + DEALLOCATE (Z1, Z2, C1, C2) + + END SUBROUTINE VINTG + + SUBROUTINE TERP3(IM,IXZ1,IXQ1,IXZ2,IXQ2,NM,NXQ1,NXQ2, & + KM1,KXZ1,KXQ1,Z1,Q1,KM2,KXZ2,KXQ2,Z2,Q2) +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: TERP3 CUBICALLY INTERPOLATE IN ONE DIMENSION +! PRGMMR: IREDELL ORG: W/NMC23 DATE: 98-05-01 +! +! ABSTRACT: INTERPOLATE FIELD(S) IN ONE DIMENSION ALONG THE COLUMN(S). +! THE INTERPOLATION IS CUBIC LAGRANGIAN WITH A MONOTONIC CONSTRAINT +! IN THE CENTER OF THE DOMAIN. IN THE OUTER INTERVALS IT IS LINEAR. +! OUTSIDE THE DOMAIN, FIELDS ARE HELD CONSTANT. +! +! PROGRAM HISTORY LOG: +! 98-05-01 MARK IREDELL +! 1999-01-04 IREDELL USE ESSL SEARCH +! +! USAGE: CALL TERP3(IM,IXZ1,IXQ1,IXZ2,IXQ2,NM,NXQ1,NXQ2, +! & KM1,KXZ1,KXQ1,Z1,Q1,KM2,KXZ2,KXQ2,Z2,Q2,J2) +! INPUT ARGUMENT LIST: +! IM INTEGER NUMBER OF COLUMNS +! IXZ1 INTEGER COLUMN SKIP NUMBER FOR Z1 +! IXQ1 INTEGER COLUMN SKIP NUMBER FOR Q1 +! IXZ2 INTEGER COLUMN SKIP NUMBER FOR Z2 +! IXQ2 INTEGER COLUMN SKIP NUMBER FOR Q2 +! NM INTEGER NUMBER OF FIELDS PER COLUMN +! NXQ1 INTEGER FIELD SKIP NUMBER FOR Q1 +! NXQ2 INTEGER FIELD SKIP NUMBER FOR Q2 +! KM1 INTEGER NUMBER OF INPUT POINTS +! KXZ1 INTEGER POINT SKIP NUMBER FOR Z1 +! KXQ1 INTEGER POINT SKIP NUMBER FOR Q1 +! Z1 REAL (1+(IM-1)*IXZ1+(KM1-1)*KXZ1) +! INPUT COORDINATE VALUES IN WHICH TO INTERPOLATE +! (Z1 MUST BE STRICTLY MONOTONIC IN EITHER DIRECTION) +! Q1 REAL (1+(IM-1)*IXQ1+(KM1-1)*KXQ1+(NM-1)*NXQ1) +! INPUT FIELDS TO INTERPOLATE +! KM2 INTEGER NUMBER OF OUTPUT POINTS +! KXZ2 INTEGER POINT SKIP NUMBER FOR Z2 +! KXQ2 INTEGER POINT SKIP NUMBER FOR Q2 +! Z2 REAL (1+(IM-1)*IXZ2+(KM2-1)*KXZ2) +! OUTPUT COORDINATE VALUES TO WHICH TO INTERPOLATE +! (Z2 NEED NOT BE MONOTONIC) +! +! OUTPUT ARGUMENT LIST: +! Q2 REAL (1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) +! OUTPUT INTERPOLATED FIELDS +! J2 REAL (1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) +! OUTPUT INTERPOLATED FIELDS CHANGE WRT Z2 +! +! SUBPROGRAMS CALLED: +! RSEARCH SEARCH FOR A SURROUNDING REAL INTERVAL +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +!C$$$ + IMPLICIT NONE + INTEGER IM,IXZ1,IXQ1,IXZ2,IXQ2,NM,NXQ1,NXQ2 + INTEGER KM1,KXZ1,KXQ1,KM2,KXZ2,KXQ2 + INTEGER I,K1,K2,N + INTEGER K1S(IM,KM2) + REAL(ESMF_KIND_R8), PARAMETER :: ONE = 1.0_ESMF_KIND_R8 + REAL(ESMF_KIND_R8) :: Z1(1+(IM-1)*IXZ1+(KM1-1)*KXZ1) + REAL(ESMF_KIND_R8) :: Q1(1+(IM-1)*IXQ1+(KM1-1)*KXQ1+(NM-1)*NXQ1) + REAL(ESMF_KIND_R8) :: Z2(1+(IM-1)*IXZ2+(KM2-1)*KXZ2) + REAL(ESMF_KIND_R8) :: Q2(1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) +! REAL(ESMF_KIND_R8) :: J2(1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) + REAL(ESMF_KIND_R8) :: FFA(IM),FFB(IM),FFC(IM),FFD(IM) + REAL(ESMF_KIND_R8) :: GGA(IM),GGB(IM),GGC(IM),GGD(IM) + REAL(ESMF_KIND_R8) :: Z1A,Z1B,Z1C,Z1D,Q1A,Q1B,Q1C,Q1D,Z2S,Q2S +! REAL(ESMF_KIND_R8) :: J2S + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! FIND THE SURROUNDING INPUT INTERVAL FOR EACH OUTPUT POINT. + CALL RSEARCH(IM,KM1,IXZ1,KXZ1,Z1,KM2,IXZ2,KXZ2,Z2,1,IM,K1S) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! GENERALLY INTERPOLATE CUBICALLY WITH MONOTONIC CONSTRAINT +! FROM TWO NEAREST INPUT POINTS ON EITHER SIDE OF THE OUTPUT POINT, +! BUT WITHIN THE TWO EDGE INTERVALS INTERPOLATE LINEARLY. +! KEEP THE OUTPUT FIELDS CONSTANT OUTSIDE THE INPUT DOMAIN. + +!$OMP PARALLEL DO DEFAULT(PRIVATE) SHARED(IM,IXZ1,IXQ1,IXZ2), & +!$OMP& SHARED(IXQ2,NM,NXQ1,NXQ2,KM1,KXZ1,KXQ1,Z1,Q1,KM2,KXZ2), & +!$OMP& SHARED(KXQ2,Z2,Q2,K1S) + DO K2=1,KM2 + DO I=1,IM + K1=K1S(I,K2) + IF(K1.EQ.1.OR.K1.EQ.KM1-1) THEN + Z2S=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + Z1A=Z1(1+(I-1)*IXZ1+(K1-1)*KXZ1) + Z1B=Z1(1+(I-1)*IXZ1+(K1+0)*KXZ1) + FFA(I)=(Z2S-Z1B)/(Z1A-Z1B) + FFB(I)=(Z2S-Z1A)/(Z1B-Z1A) + GGA(I)=ONE/(Z1A-Z1B) + GGB(I)=ONE/(Z1B-Z1A) + ELSEIF(K1.GT.1.AND.K1.LT.KM1-1) THEN + Z2S=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + Z1A=Z1(1+(I-1)*IXZ1+(K1-2)*KXZ1) + Z1B=Z1(1+(I-1)*IXZ1+(K1-1)*KXZ1) + Z1C=Z1(1+(I-1)*IXZ1+(K1+0)*KXZ1) + Z1D=Z1(1+(I-1)*IXZ1+(K1+1)*KXZ1) + FFA(I)=(Z2S-Z1B)/(Z1A-Z1B)* & + (Z2S-Z1C)/(Z1A-Z1C)* & + (Z2S-Z1D)/(Z1A-Z1D) + FFB(I)=(Z2S-Z1A)/(Z1B-Z1A)* & + (Z2S-Z1C)/(Z1B-Z1C)* & + (Z2S-Z1D)/(Z1B-Z1D) + FFC(I)=(Z2S-Z1A)/(Z1C-Z1A)* & + (Z2S-Z1B)/(Z1C-Z1B)* & + (Z2S-Z1D)/(Z1C-Z1D) + FFD(I)=(Z2S-Z1A)/(Z1D-Z1A)* & + (Z2S-Z1B)/(Z1D-Z1B)* & + (Z2S-Z1C)/(Z1D-Z1C) + GGA(I)= ONE/(Z1A-Z1B)* & + (Z2S-Z1C)/(Z1A-Z1C)* & + (Z2S-Z1D)/(Z1A-Z1D)+ & + (Z2S-Z1B)/(Z1A-Z1B)* & + ONE/(Z1A-Z1C)* & + (Z2S-Z1D)/(Z1A-Z1D)+ & + (Z2S-Z1B)/(Z1A-Z1B)* & + (Z2S-Z1C)/(Z1A-Z1C)* & + ONE/(Z1A-Z1D) + GGB(I)= ONE/(Z1B-Z1A)* & + (Z2S-Z1C)/(Z1B-Z1C)* & + (Z2S-Z1D)/(Z1B-Z1D)+ & + (Z2S-Z1A)/(Z1B-Z1A)* & + ONE/(Z1B-Z1C)* & + (Z2S-Z1D)/(Z1B-Z1D)+ & + (Z2S-Z1A)/(Z1B-Z1A)* & + (Z2S-Z1C)/(Z1B-Z1C)* & + ONE/(Z1B-Z1D) + GGC(I)= ONE/(Z1C-Z1A)* & + (Z2S-Z1B)/(Z1C-Z1B)* & + (Z2S-Z1D)/(Z1C-Z1D)+ & + (Z2S-Z1A)/(Z1C-Z1A)* & + ONE/(Z1C-Z1B)* & + (Z2S-Z1D)/(Z1C-Z1D)+ & + (Z2S-Z1A)/(Z1C-Z1A)* & + (Z2S-Z1B)/(Z1C-Z1B)* & + ONE/(Z1C-Z1D) + GGD(I)= ONE/(Z1D-Z1A)* & + (Z2S-Z1B)/(Z1D-Z1B)* & + (Z2S-Z1C)/(Z1D-Z1C)+ & + (Z2S-Z1A)/(Z1D-Z1A)* & + ONE/(Z1D-Z1B)* & + (Z2S-Z1C)/(Z1D-Z1C)+ & + (Z2S-Z1A)/(Z1D-Z1A)* & + (Z2S-Z1B)/(Z1D-Z1B)* & + ONE/(Z1D-Z1C) + ENDIF + ENDDO + +! INTERPOLATE. + DO N=1,NM + DO I=1,IM + K1=K1S(I,K2) + IF(K1.EQ.0) THEN + Q2S=Q1(1+(I-1)*IXQ1+(N-1)*NXQ1) +! J2S=0 + ELSEIF(K1.EQ.KM1) THEN + Q2S=Q1(1+(I-1)*IXQ1+(KM1-1)*KXQ1+(N-1)*NXQ1) +! J2S=0 + ELSEIF(K1.EQ.1.OR.K1.EQ.KM1-1) THEN + Q1A=Q1(1+(I-1)*IXQ1+(K1-1)*KXQ1+(N-1)*NXQ1) + Q1B=Q1(1+(I-1)*IXQ1+(K1+0)*KXQ1+(N-1)*NXQ1) + Q2S=FFA(I)*Q1A+FFB(I)*Q1B +! J2S=GGA(I)*Q1A+GGB(I)*Q1B + ELSE + Q1A=Q1(1+(I-1)*IXQ1+(K1-2)*KXQ1+(N-1)*NXQ1) + Q1B=Q1(1+(I-1)*IXQ1+(K1-1)*KXQ1+(N-1)*NXQ1) + Q1C=Q1(1+(I-1)*IXQ1+(K1+0)*KXQ1+(N-1)*NXQ1) + Q1D=Q1(1+(I-1)*IXQ1+(K1+1)*KXQ1+(N-1)*NXQ1) + Q2S=FFA(I)*Q1A+FFB(I)*Q1B+FFC(I)*Q1C+FFD(I)*Q1D +! J2S=GGA(I)*Q1A+GGB(I)*Q1B+GGC(I)*Q1C+GGD(I)*Q1D + IF(Q2S.LT.MIN(Q1B,Q1C)) THEN + Q2S=MIN(Q1B,Q1C) +! J2S=0 + ELSEIF(Q2S.GT.MAX(Q1B,Q1C)) THEN + Q2S=MAX(Q1B,Q1C) +! J2S=0 + ENDIF + ENDIF + Q2(1+(I-1)*IXQ2+(K2-1)*KXQ2+(N-1)*NXQ2)=Q2S +! J2(1+(I-1)*IXQ2+(K2-1)*KXQ2+(N-1)*NXQ2)=J2S + ENDDO + ENDDO + ENDDO +!$OMP END PARALLEL DO + + END SUBROUTINE TERP3 + + SUBROUTINE RSEARCH(IM,KM1,IXZ1,KXZ1,Z1,KM2,IXZ2,KXZ2,Z2,IXL2,KXL2,L2) +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: RSEARCH SEARCH FOR A SURROUNDING REAL INTERVAL +! PRGMMR: IREDELL ORG: W/NMC23 DATE: 98-05-01 +! +! ABSTRACT: THIS SUBPROGRAM SEARCHES MONOTONIC SEQUENCES OF REAL NUMBERS +! FOR INTERVALS THAT SURROUND A GIVEN SEARCH SET OF REAL NUMBERS. +! THE SEQUENCES MAY BE MONOTONIC IN EITHER DIRECTION; THE REAL NUMBERS +! MAY BE SINGLE OR DOUBLE PRECISION; THE INPUT SEQUENCES AND SETS +! AND THE OUTPUT LOCATIONS MAY BE ARBITRARILY DIMENSIONED. +! +! PROGRAM HISTORY LOG: +! 1999-01-05 MARK IREDELL +! +! USAGE: CALL RSEARCH(IM,KM1,IXZ1,KXZ1,Z1,KM2,IXZ2,KXZ2,Z2,IXL2,KXL2, +! & L2) +! INPUT ARGUMENT LIST: +! IM INTEGER NUMBER OF SEQUENCES TO SEARCH +! KM1 INTEGER NUMBER OF POINTS IN EACH SEQUENCE +! IXZ1 INTEGER SEQUENCE SKIP NUMBER FOR Z1 +! KXZ1 INTEGER POINT SKIP NUMBER FOR Z1 +! Z1 REAL (1+(IM-1)*IXZ1+(KM1-1)*KXZ1) +! SEQUENCE VALUES TO SEARCH +! (Z1 MUST BE MONOTONIC IN EITHER DIRECTION) +! KM2 INTEGER NUMBER OF POINTS TO SEARCH FOR +! IN EACH RESPECTIVE SEQUENCE +! IXZ2 INTEGER SEQUENCE SKIP NUMBER FOR Z2 +! KXZ2 INTEGER POINT SKIP NUMBER FOR Z2 +! Z2 REAL (1+(IM-1)*IXZ2+(KM2-1)*KXZ2) +! SET OF VALUES TO SEARCH FOR +! (Z2 NEED NOT BE MONOTONIC) +! IXL2 INTEGER SEQUENCE SKIP NUMBER FOR L2 +! KXL2 INTEGER POINT SKIP NUMBER FOR L2 +! +! OUTPUT ARGUMENT LIST: +! L2 INTEGER (1+(IM-1)*IXL2+(KM2-1)*KXL2) +! INTERVAL LOCATIONS HAVING VALUES FROM 0 TO KM1 +! (Z2 WILL BE BETWEEN Z1(L2) AND Z1(L2+1)) +! +! REMARKS: +! IF THE ARRAY Z1 IS DIMENSIONED (IM,KM1), THEN THE SKIP NUMBERS ARE +! IXZ1=1 AND KXZ1=IM; IF IT IS DIMENSIONED (KM1,IM), THEN THE SKIP +! NUMBERS ARE IXZ1=KM1 AND KXZ1=1; IF IT IS DIMENSIONED (IM,JM,KM1), +! THEN THE SKIP NUMBERS ARE IXZ1=1 AND KXZ1=IM*JM; ETCETERA. +! SIMILAR EXAMPLES APPLY TO THE SKIP NUMBERS FOR Z2 AND L2. +! +! RETURNED VALUES OF 0 OR KM1 INDICATE THAT THE GIVEN SEARCH VALUE +! IS OUTSIDE THE RANGE OF THE SEQUENCE. +! +! IF A SEARCH VALUE IS IDENTICAL TO ONE OF THE SEQUENCE VALUES +! THEN THE LOCATION RETURNED POINTS TO THE IDENTICAL VALUE. +! IF THE SEQUENCE IS NOT STRICTLY MONOTONIC AND A SEARCH VALUE IS +! IDENTICAL TO MORE THAN ONE OF THE SEQUENCE VALUES, THEN THE +! LOCATION RETURNED MAY POINT TO ANY OF THE IDENTICAL VALUES. +! +! TO BE EXACT, FOR EACH I FROM 1 TO IM AND FOR EACH K FROM 1 TO KM2, +! Z=Z2(1+(I-1)*IXZ2+(K-1)*KXZ2) IS THE SEARCH VALUE AND +! L=L2(1+(I-1)*IXL2+(K-1)*KXL2) IS THE LOCATION RETURNED. +! IF L=0, THEN Z IS LESS THAN THE START POINT Z1(1+(I-1)*IXZ1) +! FOR ASCENDING SEQUENCES (OR GREATER THAN FOR DESCENDING SEQUENCES). +! IF L=KM1, THEN Z IS GREATER THAN OR EQUAL TO THE END POINT +! Z1(1+(I-1)*IXZ1+(KM1-1)*KXZ1) FOR ASCENDING SEQUENCES +! (OR LESS THAN OR EQUAL TO FOR DESCENDING SEQUENCES). +! OTHERWISE Z IS BETWEEN THE VALUES Z1(1+(I-1)*IXZ1+(L-1)*KXZ1) AND +! Z1(1+(I-1)*IXZ1+(L-0)*KXZ1) AND MAY EQUAL THE FORMER. +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +! + IMPLICIT NONE + + INTEGER,INTENT(IN) :: IM,KM1,IXZ1,KXZ1,KM2,IXZ2,KXZ2,IXL2,KXL2 + INTEGER,INTENT(OUT) :: L2(1+(IM-1)*IXL2+(KM2-1)*KXL2) + + REAL(ESMF_KIND_R8),INTENT(IN) :: Z1(1+(IM-1)*IXZ1+(KM1-1)*KXZ1) + REAL(ESMF_KIND_R8),INTENT(IN) :: Z2(1+(IM-1)*IXZ2+(KM2-1)*KXZ2) + + INTEGER :: I,K2,L + + REAL(ESMF_KIND_R8) :: Z + + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! FIND THE SURROUNDING INPUT INTERVAL FOR EACH OUTPUT POINT. + DO I=1,IM + IF (Z1(1+(I-1)*IXZ1).LE.Z1(1+(I-1)*IXZ1+(KM1-1)*KXZ1)) THEN +! INPUT COORDINATE IS MONOTONICALLY ASCENDING. + DO K2=1,KM2 + Z=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + L=0 + DO + IF(Z.LT.Z1(1+(I-1)*IXZ1+L*KXZ1)) EXIT + L=L+1 + IF(L.EQ.KM1) EXIT + ENDDO + L2(1+(I-1)*IXL2+(K2-1)*KXL2)=L + ENDDO + ELSE +! INPUT COORDINATE IS MONOTONICALLY DESCENDING. + DO K2=1,KM2 + Z=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + L=0 + DO + IF(Z.GT.Z1(1+(I-1)*IXZ1+L*KXZ1)) EXIT + L=L+1 + IF(L.EQ.KM1) EXIT + ENDDO + L2(1+(I-1)*IXL2+(K2-1)*KXL2)=L + ENDDO + ENDIF + ENDDO + + END SUBROUTINE RSEARCH + + subroutine compute_zh + + implicit none + + integer :: i,ii, j,k, rc, clb(2), cub(2) + + real(esmf_kind_r8), allocatable :: pe0(:), pn0(:) + real(esmf_kind_r8), pointer :: psptr(:,:) + real(esmf_kind_r8), pointer :: zhsfcptr(:,:) + real(esmf_kind_r8), pointer :: zhptr(:,:,:) + real(esmf_kind_r8), pointer :: tptr(:,:,:) + real(esmf_kind_r8), pointer :: qptr(:,:,:) + real(esmf_kind_r8) :: ak, bk, zvir, grd + real(esmf_kind_r8), parameter :: grav = 9.80665 + real(esmf_kind_r8), parameter :: rdgas = 287.05 + real(esmf_kind_r8), parameter :: rvgas = 461.50 + + print*,"- COMPUTE HEIGHT" + + print*,"- CALL FieldGet FOR SURFACE PRESSURE" + call ESMF_FieldGet(ps_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TERRAIN HEIGHT" + call ESMF_FieldGet(terrain_target_grid, & + farrayPtr=zhsfcptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR HEIGHT" + call ESMF_FieldGet(zh_target_grid, & + farrayPtr=zhptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TEMPERATURE" + call ESMF_FieldGet(temp_target_grid, & + farrayPtr=tptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do ii = 1, num_tracers + if (trim(tracers(ii)) == "sphum") exit + enddo + + print*,"- CALL FieldGet FOR SPECIFIC HUMIDITY" + call ESMF_FieldGet(tracers_target_grid(ii), & + farrayPtr=qptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + grd = grav/rdgas + zvir = rvgas/rdgas - 1.0_esmf_kind_r8 + + allocate(pe0(levp1_target)) + allocate(pn0(levp1_target)) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + + do k = 1, levp1_target + ak = vcoord_target(k,1) + ak = max(ak, 1.e-9) + bk = vcoord_target(k,2) + + pe0(k) = ak + bk*psptr(i,j) + pn0(k) = log(pe0(k)) + enddo + + zhptr(i,j,1) = zhsfcptr(i,j) + + do k = 2, levp1_target + zhptr(i,j,k) = zhptr(i,j,k-1)+tptr(i,j,k-1)*(1.+zvir*qptr(i,j,k-1))* & + (pn0(k-1)-pn0(k))/grd + enddo + + enddo + enddo + + deallocate(pe0, pn0) + + end subroutine compute_zh + + subroutine cleanup_target_atm_b4adj_data + + implicit none + + integer :: i, rc + + print*,"- DESTROY TARGET GRID ATMOSPHERIC BEFORE ADJUSTMENT FIELDS." + + call ESMF_FieldDestroy(wind_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(dzdt_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(ps_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(pres_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(temp_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(terrain_interp_to_target_grid, rc=rc) + + do i = 1, num_tracers + call ESMF_FieldDestroy(tracers_b4adj_target_grid(i), rc=rc) + enddo + + deallocate(tracers_b4adj_target_grid) + + end subroutine cleanup_target_atm_b4adj_data + + subroutine cleanup_target_atm_data + + implicit none + + integer :: i, rc + + print*,"- DESTROY TARGET GRID ATMOSPHERIC FIELDS." + + call ESMF_FieldDestroy(delp_target_grid, rc=rc) + call ESMF_FieldDestroy(dzdt_target_grid, rc=rc) + call ESMF_FieldDestroy(ps_target_grid, rc=rc) + call ESMF_FieldDestroy(pres_target_grid, rc=rc) + call ESMF_FieldDestroy(temp_target_grid, rc=rc) + call ESMF_FieldDestroy(u_s_target_grid, rc=rc) + call ESMF_FieldDestroy(v_s_target_grid, rc=rc) + call ESMF_FieldDestroy(wind_target_grid, rc=rc) + call ESMF_FieldDestroy(wind_s_target_grid, rc=rc) + call ESMF_FieldDestroy(wind_w_target_grid, rc=rc) + call ESMF_FieldDestroy(u_w_target_grid, rc=rc) + call ESMF_FieldDestroy(v_w_target_grid, rc=rc) + call ESMF_FieldDestroy(zh_target_grid, rc=rc) + + do i = 1, num_tracers + call ESMF_FieldDestroy(tracers_target_grid(i), rc=rc) + enddo + + deallocate(tracers_target_grid) + + if (ESMF_FieldIsCreated(qnifa_climo_target_grid)) then + call ESMF_FieldDestroy(qnifa_climo_target_grid, rc=rc) + endif + + if (ESMF_FieldIsCreated(qnwfa_climo_target_grid)) then + call ESMF_FieldDestroy(qnwfa_climo_target_grid, rc=rc) + endif + + end subroutine cleanup_target_atm_data + + end module atmosphere diff --git a/sorc/coldstart.fd/chgres.F90 b/sorc/coldstart.fd/chgres.F90 new file mode 100644 index 000000000..20d6b94cc --- /dev/null +++ b/sorc/coldstart.fd/chgres.F90 @@ -0,0 +1,107 @@ + program chgres + +!------------------------------------------------------------------------- +! Program CHGRES +! +! Abstract: Initialize an FV3 run using history or restart data from +! another FV3 run, or the NEMS version of the spectral GFS. +! Converts atmospheric, surface and nst data. +! +!------------------------------------------------------------------------- + + use mpi + use esmf + + use atmosphere, only : atmosphere_driver + + use program_setup, only : read_setup_namelist, & + read_varmap, & + convert_atm, & + convert_sfc + + use model_grid, only : define_target_grid, & + define_input_grid, & + cleanup_input_target_grid_data + + use surface, only : surface_driver + + implicit none + + integer :: ierr, localpet, npets + + type(esmf_vm) :: vm + +!------------------------------------------------------------------------- +! Initialize mpi and esmf environment. +!------------------------------------------------------------------------- + + call mpi_init(ierr) + + print*,"- INITIALIZE ESMF" + call ESMF_Initialize(rc=ierr) + if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("INITIALIZING ESMF", ierr) + + print*,"- CALL VMGetGlobal" + call ESMF_VMGetGlobal(vm, rc=ierr) + if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN VMGetGlobal", ierr) + + print*,"- CALL VMGet" + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) + if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN VMGet", ierr) + + print*,'- NPETS IS ',npets + print*,'- LOCAL PET ',localpet + +!------------------------------------------------------------------------- +! Read program configuration namelist. +!------------------------------------------------------------------------- + + call read_setup_namelist + +!------------------------------------------------------------------------- +! Read variable mapping file (used for grib2 input data only). +!------------------------------------------------------------------------- + + call read_varmap + +!------------------------------------------------------------------------- +! Create esmf grid objects for input and target grids. +!------------------------------------------------------------------------- + + call define_target_grid(localpet, npets) + + call define_input_grid(localpet, npets) + +!------------------------------------------------------------------------- +! Convert atmospheric fields +!------------------------------------------------------------------------- + + if (convert_atm) then + + call atmosphere_driver(localpet) + + end if + +!------------------------------------------------------------------------- +! Convert surface/nsst fields +!------------------------------------------------------------------------- + + if (convert_sfc) then + + call surface_driver(localpet) + + end if + + call cleanup_input_target_grid_data + + print*,"- CALL ESMF_finalize" + call ESMF_finalize(endflag=ESMF_END_KEEPMPI, rc=ierr) + + call mpi_finalize(ierr) + + print*,"- DONE." + + end program chgres diff --git a/sorc/coldstart.fd/grib2_util.F90 b/sorc/coldstart.fd/grib2_util.F90 new file mode 100644 index 000000000..64a1cdb71 --- /dev/null +++ b/sorc/coldstart.fd/grib2_util.F90 @@ -0,0 +1,77 @@ +module grib2_util + +!-------------------------------------------------------------------------- +! Module: grib2_util +! +! Abstract: Utilities for use when reading grib2 data. +! +!-------------------------------------------------------------------------- + +use esmf + +use model_grid, only : i_input, j_input + +implicit none + +contains + + subroutine rh2spfh(rh_sphum,p,t) + + implicit none + real,parameter :: alpha=-9.477E-4 , & !K^-1, + Tnot=273.15, & !K + Lnot=2.5008E6, & !JKg^-1 + Rv=461.51, & !JKg^-1K^-1 + esnot=611.21 !Pa + + real(esmf_kind_r4), intent(inout), dimension(i_input,j_input) ::rh_sphum + real(esmf_kind_r8), intent(in) :: p, t(i_input,j_input) + + real, dimension(i_input,j_input) :: es, e, rh + + print*,"- CONVERT RH TO SPFH AT LEVEL ", p + + rh = rh_sphum + !print *, 'T = ', T, ' RH = ', RH, ' P = ', P + es = esnot * exp( Lnot/Rv * ((t-Tnot)/(t*tnot) + alpha * LOG(t/Tnot) - alpha * (t-Tnot)/ t)) + !print *, 'es = ', es + e = rh * es / 100.0 + !print *, 'e = ', e + rh_sphum = 0.622 * e / p + !print *, 'q = ', sphum + + !if (P .eq. 100000.0) THEN + ! print *, 'T = ', T, ' RH = ', RH, ' P = ', P, ' es = ', es, ' e = ', e, ' q = ', sphum + !end if + +end subroutine RH2SPFH + +subroutine convert_omega(omega,p,t,q,clb,cub) + + implicit none + real(esmf_kind_r8), pointer :: omega(:,:,:), p(:,:,:), t(:,:,:), q(:,:,:),omtmp,ptmp + + integer :: clb(3), cub(3), i ,j, k + + real, parameter :: Rd = 287.15_esmf_kind_r8, & !JKg^-1K^-1 + Rv=461.51_esmf_kind_r8, & !JKg^-1K^-1 + g = 9.81_esmf_kind_r8 ! ms^-2 + + real(esmf_kind_r8) :: tv, w + + do k = clb(3),cub(3) + do j = clb(2),cub(2) + do i = clb(1),cub(1) + tv = t(i,j,k)*(1+Rd/Rv*q(i,j,k)) + omtmp=>omega(i,j,k) + ptmp=>p(i,j,k) + + w = -1 * omtmp * Rd * tv / (ptmp * g) + omega(i,j,k)=w + enddo + enddo + enddo + +end subroutine convert_omega + + end module grib2_util diff --git a/sorc/coldstart.fd/input_data.F90 b/sorc/coldstart.fd/input_data.F90 new file mode 100644 index 000000000..f5847fe6d --- /dev/null +++ b/sorc/coldstart.fd/input_data.F90 @@ -0,0 +1,5901 @@ + module input_data + +!-------------------------------------------------------------------------- +! Module input_data +! +! Abstract: Read atmospheric, surface and nst data on the input grid. +! Supported formats include fv3 tiled 'restart' files, fv3 tiled +! 'history' files, fv3 gaussian history files, spectral gfs +! gaussian nemsio files, and spectral gfs sigio/sfcio files. +! +! Public Subroutines: +! ----------------- +! read_input_atm_data Driver routine to read atmospheric data +! cleanup_input_atm_data Free up memory associated with atm data +! read_input_sfc_data Driver routine to read surface data +! cleanup_input_sfc_data Free up memory associated with sfc data +! read_input_nst_data Driver routine to read nst data +! cleanup_input_nst_data Free up memory associated with nst data +! +! Public variables: +! ----------------- +! Defined below. "input" indicates field associated with the input grid. +! +!-------------------------------------------------------------------------- + + use esmf + use netcdf + use nemsio_module + + use program_setup, only : data_dir_input_grid, & + nst_files_input_grid, & + sfc_files_input_grid, & + atm_files_input_grid, & + grib2_file_input_grid, & + atm_core_files_input_grid, & + atm_tracer_files_input_grid, & + convert_nst, & + orog_dir_input_grid, & + orog_files_input_grid, & + tracers_input, num_tracers, & + input_type, tracers, & + get_var_cond, read_from_input + + use model_grid, only : input_grid, & + i_input, j_input, & + ip1_input, jp1_input, & + num_tiles_input_grid, & + latitude_input_grid, & + longitude_input_grid, & + inv_file + + implicit none + + private + +! Fields associated with the atmospheric model. + + type(esmf_field), public :: dzdt_input_grid ! vert velocity + type(esmf_field) :: dpres_input_grid ! pressure thickness + type(esmf_field), public :: pres_input_grid ! 3-d pressure + type(esmf_field), public :: ps_input_grid ! surface pressure + type(esmf_field), public :: terrain_input_grid ! terrain height + type(esmf_field), public :: temp_input_grid ! temperature + type(esmf_field) :: u_input_grid ! u/v wind at grid + type(esmf_field) :: v_input_grid ! box center + type(esmf_field), public :: wind_input_grid ! 3-component wind + type(esmf_field), allocatable, public :: tracers_input_grid(:) ! tracers + + integer, public :: lev_input ! # of atmospheric layers + integer, public :: levp1_input ! # of atmos layer interfaces + +! Fields associated with the land-surface model. + + integer, public :: veg_type_landice_input = 15 ! NOAH land ice option + ! defined at this veg type. + ! Default is igbp. + + type(esmf_field), public :: canopy_mc_input_grid ! canopy moist content + type(esmf_field), public :: f10m_input_grid ! log((z0+10)*1/z0) + type(esmf_field), public :: ffmm_input_grid ! log((z0+z1)*1/z0) + ! See sfc_diff.f for details. + type(esmf_field), public :: landsea_mask_input_grid ! land sea mask; + ! 0-water, 1-land, 2-ice + type(esmf_field), public :: q2m_input_grid ! 2-m spec hum + type(esmf_field), public :: seaice_depth_input_grid ! sea ice depth + type(esmf_field), public :: seaice_fract_input_grid ! sea ice fraction + type(esmf_field), public :: seaice_skin_temp_input_grid ! sea ice skin temp + type(esmf_field), public :: skin_temp_input_grid ! skin temp/sst + type(esmf_field), public :: snow_depth_input_grid ! snow dpeth + type(esmf_field), public :: snow_liq_equiv_input_grid ! snow liq equiv depth + type(esmf_field), public :: soil_temp_input_grid ! 3-d soil temp + type(esmf_field), public :: soil_type_input_grid ! soil type + type(esmf_field), public :: soilm_liq_input_grid ! 3-d liquid soil moisture + type(esmf_field), public :: soilm_tot_input_grid ! 3-d total soil moisture + type(esmf_field), public :: srflag_input_grid ! snow/rain flag + type(esmf_field), public :: t2m_input_grid ! 2-m temperature + type(esmf_field), public :: tprcp_input_grid ! precip + type(esmf_field), public :: ustar_input_grid ! fric velocity + type(esmf_field), public :: veg_type_input_grid ! vegetation type + type(esmf_field), public :: z0_input_grid ! roughness length + + integer, public :: lsoil_input=4 ! # of soil layers, + ! # hardwire for now + + character(len=50), private, allocatable :: slevs(:) + +! Fields associated with the nst model. + + type(esmf_field), public :: c_d_input_grid + type(esmf_field), public :: c_0_input_grid + type(esmf_field), public :: d_conv_input_grid + type(esmf_field), public :: dt_cool_input_grid + type(esmf_field), public :: ifd_input_grid + type(esmf_field), public :: qrain_input_grid + type(esmf_field), public :: tref_input_grid ! reference temperature + type(esmf_field), public :: w_d_input_grid + type(esmf_field), public :: w_0_input_grid + type(esmf_field), public :: xs_input_grid + type(esmf_field), public :: xt_input_grid + type(esmf_field), public :: xu_input_grid + type(esmf_field), public :: xv_input_grid + type(esmf_field), public :: xz_input_grid + type(esmf_field), public :: xtts_input_grid + type(esmf_field), public :: xzts_input_grid + type(esmf_field), public :: z_c_input_grid + type(esmf_field), public :: zm_input_grid + + public :: read_input_atm_data + public :: cleanup_input_atm_data + public :: read_input_sfc_data + public :: cleanup_input_sfc_data + public :: read_input_nst_data + public :: cleanup_input_nst_data + + contains + +!--------------------------------------------------------------------------- +! Read input grid atmospheric data driver +!--------------------------------------------------------------------------- + + subroutine read_input_atm_data(localpet) + + implicit none + + integer, intent(in) :: localpet + +!------------------------------------------------------------------------------- +! Read the tiled 'warm' restart files. +!------------------------------------------------------------------------------- + + if (trim(input_type) == "restart") then + + call read_input_atm_restart_file(localpet) + +!------------------------------------------------------------------------------- +! Read the gaussian history files in netcdf format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "gaussian_netcdf") then + + call read_input_atm_gaussian_netcdf_file(localpet) + +!------------------------------------------------------------------------------- +! Read the tiled history files in netcdf format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "history") then + + call read_input_atm_tiled_history_file(localpet) + +!------------------------------------------------------------------------------- +! Read the gaussian history files in nemsio format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "gaussian_nemsio") then ! fv3gfs gaussian nemsio + + call read_input_atm_gaussian_nemsio_file(localpet) + +!------------------------------------------------------------------------------- +! Read the spectral gfs gaussian history files in nemsio format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "gfs_gaussian_nemsio") then ! spectral gfs gaussian + ! nemsio. + call read_input_atm_gfs_gaussian_nemsio_file(localpet) + +!------------------------------------------------------------------------------- +! Read the spectral gfs gaussian history files in sigio format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "gfs_sigio") then ! spectral gfs sigio format. + + call read_input_atm_gfs_sigio_file(localpet) + +!------------------------------------------------------------------------------- +! Read fv3gfs data in grib2 format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "grib2") then + + call read_input_atm_grib2_file(localpet) + + endif + + end subroutine read_input_atm_data + +!--------------------------------------------------------------------------- +! Read input grid nst data driver +!--------------------------------------------------------------------------- + + subroutine read_input_nst_data(localpet) + + implicit none + + integer, intent(in) :: localpet + + integer :: rc + + print*,"- READ INPUT GRID NST DATA." + + print*,"- CALL FieldCreate FOR INPUT GRID C_D." + c_d_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID C_0." + c_0_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID D_CONV." + d_conv_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID DT_COOL." + dt_cool_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID IFD." + ifd_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID QRAIN." + qrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TREF." + tref_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID W_D." + w_d_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID W_0." + w_0_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XS." + xs_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XT." + xt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XU." + xu_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XV." + xv_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XZ." + xz_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XTTS." + xtts_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XZTS." + xzts_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID Z_C." + z_c_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID ZM." + zm_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + +!-------------------------------------------------------------------------- +! Read input grid nst data from a fv3 gaussian nemsio history file or +! spectral GFS nemsio file. +!-------------------------------------------------------------------------- + + if (trim(input_type) == "gaussian_nemsio" .or. trim(input_type) == "gfs_gaussian_nemsio") then + + call read_input_nst_nemsio_file(localpet) + +!--------------------------------------------------------------------------- +! Read nst data from these netcdf formatted fv3 files: tiled history, +! tiled warm restart, and gaussian history. +!--------------------------------------------------------------------------- + + else + + call read_input_nst_netcdf_file(localpet) + + endif + + end subroutine read_input_nst_data + +!--------------------------------------------------------------------------- +! Read input grid surface data driver. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_data(localpet) + + implicit none + + integer, intent(in) :: localpet + + integer :: rc + + print*,"- CALL FieldCreate FOR INPUT GRID LANDSEA MASK." + landsea_mask_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID Z0." + z0_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID VEGETATION TYPE." + veg_type_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID CANOPY MOISTURE CONTENT." + canopy_mc_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SEAICE FRACTION." + seaice_fract_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SEAICE DEPTH." + seaice_depth_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SEAICE SKIN TEMPERATURE." + seaice_skin_temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SNOW DEPTH." + snow_depth_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SNOW LIQUID EQUIVALENT." + snow_liq_equiv_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID T2M." + t2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID Q2M." + q2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TPRCP." + tprcp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID F10M." + f10m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID USTAR." + ustar_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID FFMM." + ffmm_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SRFLAG." + srflag_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT SKIN TEMPERATURE." + skin_temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT SOIL TYPE." + soil_type_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT SOIL TEMPERATURE." + soil_temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT TOTAL SOIL MOISTURE." + soilm_tot_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT LIQUID SOIL MOISTURE." + soilm_liq_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + +!------------------------------------------------------------------------------- +! Read the tiled 'warm' restart files. +!------------------------------------------------------------------------------- + + if (trim(input_type) == "restart") then + + call read_input_sfc_restart_file(localpet) + +!------------------------------------------------------------------------------- +! Read the tiled or gaussian history files in netcdf format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "history" .or. trim(input_type) == & + "gaussian_netcdf") then + + call read_input_sfc_netcdf_file(localpet) + +!------------------------------------------------------------------------------- +! Read the gaussian history files in nemsio format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "gaussian_nemsio") then + + call read_input_sfc_gaussian_nemsio_file(localpet) + +!------------------------------------------------------------------------------- +! Read the spectral gfs gaussian history files in nemsio format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "gfs_gaussian_nemsio") then + + call read_input_sfc_gfs_gaussian_nemsio_file(localpet) + +!------------------------------------------------------------------------------- +! Read the spectral gfs gaussian history files in sfcio format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "gfs_sigio") then + + call read_input_sfc_gfs_sfcio_file(localpet) + +!------------------------------------------------------------------------------- +! Read fv3gfs surface data in grib2 format. +!------------------------------------------------------------------------------- + + elseif (trim(input_type) == "grib2") then + + call read_input_sfc_grib2_file(localpet) + + endif + + end subroutine read_input_sfc_data + +!--------------------------------------------------------------------------- +! Create atmospheric esmf fields. +!--------------------------------------------------------------------------- + + subroutine init_atm_esmf_fields + + implicit none + + integer :: i, rc + + print*,"- INITIALIZE ATMOSPHERIC ESMF FIELDS." + + print*,"- CALL FieldCreate FOR INPUT GRID 3-D WIND." + wind_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_input,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE." + ps_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TEMPERATURE." + temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + allocate(tracers_input_grid(num_tracers)) + + do i = 1, num_tracers + print*,"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(tracers_input(i)) + tracers_input_grid(i) = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR INPUT GRID DZDT." + dzdt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID U." + u_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID V." + v_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID PRESSURE." + pres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine init_atm_esmf_fields + +!--------------------------------------------------------------------------- +! Read input atmospheric data from spectral gfs (old sigio format). +! Used prior to July 19, 2017. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_gfs_sigio_file(localpet) + + use sigio_module + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer(sigio_intkind) :: iret + integer :: rc, i, j, k + integer :: clb(3), cub(3) + + real(esmf_kind_r8) :: ak, bk + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + real(esmf_kind_r8), allocatable :: dummy3d2(:,:,:) + real(esmf_kind_r8), pointer :: pptr(:,:,:), psptr(:,:) + real(esmf_kind_r8), allocatable :: pi(:,:,:) + + type(sigio_head) :: sighead + type(sigio_dbta) :: sigdata + + the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + + print*,"- ATMOSPHERIC DATA IN SIGIO FORMAT." + print*,"- OPEN AND READ: ", trim(the_file) + + call sigio_sropen(21, trim(the_file), iret) + if (iret /= 0) then + rc = iret + call error_handler("OPENING SPECTRAL GFS SIGIO FILE.", rc) + endif + call sigio_srhead(21, sighead, iret) + if (iret /= 0) then + rc = iret + call error_handler("READING SPECTRAL GFS SIGIO FILE.", rc) + endif + + lev_input = sighead%levs + levp1_input = lev_input + 1 + + if (num_tracers /= sighead%ntrac) then + call error_handler("WRONG NUMBER OF TRACERS EXPECTED.", 99) + endif + + if (sighead%idvt == 0 .or. sighead%idvt == 21) then + if (trim(tracers_input(1)) /= 'spfh' .or. & + trim(tracers_input(2)) /= 'o3mr' .or. & + trim(tracers_input(3)) /= 'clwmr') then + call error_handler("TRACERS SELECTED DO NOT MATCH FILE CONTENTS.", 99) + endif + else + print*,'- UNRECOGNIZED IDVT: ', sighead%idvt + call error_handler("UNRECOGNIZED IDVT", 99) + endif + +!--------------------------------------------------------------------------- +! Initialize esmf atmospheric fields. +!--------------------------------------------------------------------------- + + call init_atm_esmf_fields + + if (localpet == 0) then + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lev_input)) + allocate(dummy3d2(i_input,j_input,lev_input)) + else + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + allocate(dummy3d2(0,0,0)) + endif + + if (localpet == 0) then + call sigio_aldbta(sighead, sigdata, iret) + if (iret /= 0) then + rc = iret + call error_handler("ALLOCATING SIGDATA.", rc) + endif + call sigio_srdbta(21, sighead, sigdata, iret) + if (iret /= 0) then + rc = iret + call error_handler("READING SIGDATA.", rc) + endif + call sptez(0,sighead%jcap,4,i_input, j_input, sigdata%ps, dummy2d, 1) + dummy2d = exp(dummy2d) * 1000.0 + print*,'surface pres ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR SURFACE PRESSURE." + call ESMF_FieldScatter(ps_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call sptez(0,sighead%jcap,4,i_input, j_input, sigdata%hs, dummy2d, 1) + print*,'terrain ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + do k = 1, num_tracers + + if (localpet == 0) then + call sptezm(0,sighead%jcap,4,i_input, j_input, lev_input, sigdata%q(:,:,k), dummy3d, 1) + print*,trim(tracers_input(k)),maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(k)) + call ESMF_FieldScatter(tracers_input_grid(k), dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + if (localpet == 0) then + call sptezm(0,sighead%jcap,4,i_input, j_input, lev_input, sigdata%t, dummy3d, 1) + print*,'temp ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +!--------------------------------------------------------------------------- +! The spectral gfs files have omega, not vertical velocity. Set to +! zero for now. Convert from omega to vv in the future? +!--------------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- NO VERTICAL VELOCITY RECORD. SET TO ZERO." + dummy3d = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT DZDT." + call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call sptezmv(0, sighead%jcap, 4, i_input, j_input, lev_input, sigdata%d, sigdata%z, dummy3d, dummy3d2, 1) + print*,'u ',maxval(dummy3d),minval(dummy3d) + print*,'v ',maxval(dummy3d2),minval(dummy3d2) + endif + + print*,"- CALL FieldScatter FOR INPUT U-WIND." + call ESMF_FieldScatter(u_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR INPUT V-WIND." + call ESMF_FieldScatter(v_input_grid, dummy3d2, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d, dummy3d, dummy3d2) + + if (localpet == 0) call sigio_axdbta(sigdata, iret) + + call sigio_sclose(21, iret) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d component winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute 3-d pressure from 'ak' and 'bk'. +!--------------------------------------------------------------------------- + + print*,"- COMPUTE 3-D PRESSURE." + + print*,"- CALL FieldGet FOR 3-D PRES." + nullify(pptr) + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + nullify(psptr) + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +!--------------------------------------------------------------------------- +! First, compute interface pressure. +!--------------------------------------------------------------------------- + + allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_input),stat=rc) + + do k=1,levp1_input + ak = sighead%vcoord(k,1) + bk = sighead%vcoord(k,2) + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pi(i,j,k) = ak + bk*psptr(i,j) + enddo + enddo + enddo + + if (localpet == 0) then + print*,'pres int ',psptr(clb(1),clb(2)),pi(clb(1),clb(2),:) + endif + +!--------------------------------------------------------------------------- +! Now comput mid-layer pressure from interface pressure. +!--------------------------------------------------------------------------- + + do k=1,lev_input + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0_esmf_kind_r8 + enddo + enddo + enddo + + deallocate(pi) + + if (localpet == 0) then + print*,'pres ',psptr(clb(1),clb(2)),pptr(clb(1),clb(2),:) + endif + + end subroutine read_input_atm_gfs_sigio_file + +!--------------------------------------------------------------------------- +! Read input atmospheric data from spectral gfs (global gaussian in +! nemsio format. Starting July 19, 2017). +!--------------------------------------------------------------------------- + + subroutine read_input_atm_gfs_gaussian_nemsio_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + character(len=20) :: vlevtyp, vname + + integer(nemsio_intkind) :: vlev, iret + integer :: i, j, k, n, rc + integer :: clb(3), cub(3) + + real(nemsio_realkind), allocatable :: vcoord(:,:,:) + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + real(esmf_kind_r8) :: ak, bk + real(esmf_kind_r8), allocatable :: pi(:,:,:) + real(esmf_kind_r8), pointer :: pptr(:,:,:), psptr(:,:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + + print*,"- READ ATMOS DATA FROM SPECTRAL GFS NEMSIO FILE: ", trim(the_file) + + print*,"- OPEN FILE." + call nemsio_open(gfile, the_file, "read", iret=iret) + if (iret /= 0) call error_handler("OPENING SPECTRAL GFS NEMSIO ATM FILE.", iret) + + print*,"- READ NUMBER OF VERTICAL LEVELS." + call nemsio_getfilehead(gfile, iret=iret, dimz=lev_input) + if (iret /= 0) call error_handler("READING NUMBER OF VERTICAL LEVLES.", iret) + + levp1_input = lev_input + 1 + + allocate(vcoord(levp1_input,3,2)) + + print*,"- READ VERTICAL COORDINATE INFO." + call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord) + if (iret /= 0) call error_handler("READING VERTICAL COORDINATE INFO.", iret) + +!--------------------------------------------------------------------------- +! Initialize esmf atmospheric fields. +!--------------------------------------------------------------------------- + + call init_atm_esmf_fields + + if (localpet == 0) then + allocate(dummy(i_input*j_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lev_input)) + else + allocate(dummy(0)) + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + endif + +!----------------------------------------------------------------------- +! 3-d fields in gaussian files increment from bottom to model top. +! That is what is expected by this program, so no need to flip indices. +!----------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ TEMPERATURE." + vname = "tmp" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TEMPERATURE RECORD.", iret) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) +! print*,'temp check after read ',vlev, dummy3d(1,1,vlev) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + do n = 1, num_tracers + + if (localpet == 0) then + print*,"- READ ", trim(tracers_input(n)) + vname = trim(tracers_input(n)) + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TRACER RECORD.", iret) +! print*,'tracer ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(n)) + call ESMF_FieldScatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + if (localpet == 0) then + print*,"- READ U-WINDS." + vname = "ugrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING U-WIND RECORD.", iret) +! print*,'ugrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT U-WIND." + call ESMF_FieldScatter(u_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ V-WINDS." + vname = "vgrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING V-WIND RECORD.", iret) +! print*,'vgrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT V-WIND." + call ESMF_FieldScatter(v_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +!--------------------------------------------------------------------------- +! The spectral gfs nemsio files do not have a vertical velocity or +! omega record. So set to zero for now. +!--------------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- NO VERTICAL VELOCITY RECORD. SET TO ZERO." + dummy3d = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT DZDT." + call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ HGT." + vname = "hgt" + vlevtyp = "sfc" + vlev = 1 + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING HGT RECORD.", iret) +! print*,'hgt ',vlev, maxval(dummy),minval(dummy) + dummy2d = reshape(dummy, (/i_input,j_input/)) + endif + + print*,"- CALL FieldScatter FOR TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ PRES." + vname = "pres" + vlevtyp = "sfc" + vlev = 1 + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING PRES RECORD.", iret) +! print*,'pres ',vlev, maxval(dummy),minval(dummy) + dummy2d = reshape(dummy, (/i_input,j_input/)) + endif + + print*,"- CALL FieldScatter FOR SURFACE PRESSURE." + call ESMF_FieldScatter(ps_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + call nemsio_close(gfile) + + deallocate(dummy, dummy2d, dummy3d) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d component winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute 3-d pressure from 'ak' and 'bk'. +!--------------------------------------------------------------------------- + + print*,"- COMPUTE 3-D PRESSURE." + + print*,"- CALL FieldGet FOR 3-D PRES." + nullify(pptr) + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + nullify(psptr) + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +!--------------------------------------------------------------------------- +! First, compute interface pressure. +!--------------------------------------------------------------------------- + + allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_input)) + + do k=1,levp1_input + ak = vcoord(k,1,1) + bk = vcoord(k,2,1) + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pi(i,j,k) = ak + bk*psptr(i,j) + enddo + enddo + enddo + + deallocate(vcoord) + +!--------------------------------------------------------------------------- +! Now comput mid-layer pressure from interface pressure. +!--------------------------------------------------------------------------- + + do k=1,lev_input + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0 + enddo + enddo + enddo + + deallocate(pi) + + end subroutine read_input_atm_gfs_gaussian_nemsio_file + +!--------------------------------------------------------------------------- +! Read input grid atmospheric fv3 gaussian nemsio files. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_gaussian_nemsio_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + character(len=20) :: vlevtyp, vname + + integer :: i, j, k, n + integer :: rc, clb(3), cub(3) + integer(nemsio_intkind) :: vlev, iret + + real(nemsio_realkind), allocatable :: vcoord(:,:,:) + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:) + real(esmf_kind_r8), pointer :: dpresptr(:,:,:) + real(esmf_kind_r8), allocatable :: pres_interface(:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + + print*,"- READ ATMOS DATA FROM GAUSSIAN NEMSIO FILE: ", trim(the_file) + + print*,"- OPEN FILE." + call nemsio_open(gfile, the_file, "read", iret=iret) + if (iret /= 0) call error_handler("OPENING GAUSSIAN NEMSIO ATM FILE.", iret) + + print*,"- READ NUMBER OF VERTICAL LEVELS." + call nemsio_getfilehead(gfile, iret=iret, dimz=lev_input) + if (iret /= 0) call error_handler("READING NUMBER OF VERTICAL LEVLES.", iret) + + levp1_input = lev_input + 1 + + allocate(vcoord(levp1_input,3,2)) + + print*,"- READ VERTICAL COORDINATE INFO." + call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord) + if (iret /= 0) call error_handler("READING VERTICAL COORDINATE INFO.", iret) + +!--------------------------------------------------------------------------- +! Initialize esmf atmospheric fields. +!--------------------------------------------------------------------------- + + call init_atm_esmf_fields + + print*,"- CALL FieldCreate FOR INPUT DPRES." + dpres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + if (localpet == 0) then + allocate(dummy(i_input*j_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lev_input)) + else + allocate(dummy(0)) + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + endif + +!----------------------------------------------------------------------- +! 3-d fields in gaussian files increment from bottom to model top. +! That is what is expected by this program, so no need to flip indices. +!----------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ TEMPERATURE." + vname = "tmp" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TEMPERATURE RECORD.", iret) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + print*,'temp check after read ',vlev, dummy3d(1,1,vlev) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + do n = 1, num_tracers + + if (localpet == 0) then + print*,"- READ ", trim(tracers_input(n)) + vname = trim(tracers_input(n)) + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TRACER RECORD.", iret) + print*,'tracer ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(n)) + call ESMF_FieldScatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + if (localpet == 0) then + print*,"- READ U-WINDS." + vname = "ugrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING U-WIND RECORD.", iret) + print*,'ugrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT U-WIND." + call ESMF_FieldScatter(u_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ V-WINDS." + vname = "vgrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING V-WIND RECORD.", iret) + print*,'vgrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT V-WIND." + call ESMF_FieldScatter(v_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DPRES." + vname = "dpres" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING DPRES RECORD.", iret) + print*,'dpres ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT DPRES." + call ESMF_FieldScatter(dpres_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DZDT." + vname = "dzdt" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING DZDT RECORD.", iret) + print*,'dzdt ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT DZDT." + call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ HGT." + vname = "hgt" + vlevtyp = "sfc" + vlev = 1 + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING HGT RECORD.", iret) + print*,'hgt ',vlev, maxval(dummy),minval(dummy) + dummy2d = reshape(dummy, (/i_input,j_input/)) + endif + + print*,"- CALL FieldScatter FOR TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + call nemsio_close(gfile) + + deallocate(dummy, dummy2d, dummy3d) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d component winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute 3-d pressure. Mid-layer and surface pressure are computed +! from delta p. The surface pressure in the file is not used. After +! the model's write component interpolates from the cubed-sphere grid +! to the gaussian grid, the surface pressure is no longer consistent +! with the delta p (per Jun Wang). +!--------------------------------------------------------------------------- + + print*,"- COMPUTE 3-D PRESSURE." + + print*,"- CALL FieldGet FOR DELTA PRESSURE." + nullify(dpresptr) + call ESMF_FieldGet(dpres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=dpresptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR 3-D PRESSURE." + nullify(presptr) + call ESMF_FieldGet(pres_input_grid, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + nullify(psptr) + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + allocate(pres_interface(levp1_input)) + + if (localpet == 0) then + do k = clb(3), cub(3) + print*,'dpres is ',cub(1),cub(2),k, dpresptr(cub(1),cub(2),k) + enddo + endif + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + pres_interface(levp1_input) = vcoord(levp1_input,1,1) + do k = lev_input, 1, -1 + pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k) + enddo + psptr(i,j) = pres_interface(1) + do k = 1, lev_input + presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8 + enddo + enddo + enddo + + deallocate(vcoord) + + if (localpet == 0) then + print*,'psfc is ',clb(1),clb(2),psptr(clb(1),clb(2)) + print*,'pres is ',clb(1),clb(2),presptr(clb(1),clb(2),:) + endif + + print*,'pres check 1',localpet,maxval(presptr(:,:,1)),minval(presptr(:,:,1)) + print*,'pres check lev',localpet,maxval(presptr(:,:,lev_input)),minval(presptr(:,:,lev_input)) + + deallocate(pres_interface) + + call ESMF_FieldDestroy(dpres_input_grid, rc=rc) + + end subroutine read_input_atm_gaussian_nemsio_file + +!--------------------------------------------------------------------------- +! Read input grid fv3 atmospheric data 'warm' restart files. +! +! Routine reads tiled files in parallel. Tile 1 is read by +! localpet 0; tile 2 by localpet 1, etc. The number of pets +! must be equal to or greater than the number of tiled files. +! Logic only tested with global input data of six tiles. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_restart_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: i, j, k + integer :: clb(3), cub(3) + integer :: rc, tile, ncid, id_var + integer :: error, id_dim + + real(esmf_kind_r8), allocatable :: ak(:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:) + real(esmf_kind_r8), pointer :: dpresptr(:,:,:) + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(esmf_kind_r8), allocatable :: pres_interface(:) + +!--------------------------------------------------------------------------- +! Get number of vertical levels and model top pressure. +!--------------------------------------------------------------------------- + + tilefile = trim(data_dir_input_grid) // "/" // trim(atm_core_files_input_grid(7)) + print*,"- READ ATM VERTICAL LEVELS FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'xaxis_1', id_dim) + call netcdf_err(error, 'reading xaxis_1 id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input) + call netcdf_err(error, 'reading xaxis_1 value' ) + + lev_input = levp1_input - 1 + + allocate(ak(levp1_input)) + + error=nf90_inq_varid(ncid, 'ak', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, ak) + call netcdf_err(error, 'reading ak' ) + + error = nf90_close(ncid) + +!--------------------------------------------------------------------------- +! Initialize esmf atmospheric fields. +!--------------------------------------------------------------------------- + + call init_atm_esmf_fields + + print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." + dpres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + if (localpet < num_tiles_input_grid) then + allocate(data_one_tile_3d(i_input,j_input,lev_input)) + allocate(data_one_tile(i_input,j_input)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(data_one_tile(0,0)) + endif + + if (localpet < num_tiles_input_grid) then + tile = localpet+1 + tilefile= trim(data_dir_input_grid) // "/" // trim(atm_core_files_input_grid(tile)) + print*,"- READ ATMOSPHERIC CORE FILE: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + endif + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'phis', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'reading field' ) + data_one_tile = data_one_tile / 9.806_8 ! geopotential height + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN for tile ",tile + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then +! error=nf90_inq_varid(ncid, 'W', id_var) +! call netcdf_err(error, 'reading field id' ) +! error=nf90_get_var(ncid, id_var, data_one_tile_3d) +! call netcdf_err(error, 'reading field' ) +! data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + +! Using 'w' from restart files has caused problems. Set to zero. + data_one_tile_3d = 0.0_8 + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY for tile ",tile + call ESMF_FieldScatter(dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'T', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'delp', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT DELTA PRESSURE." + call ESMF_FieldScatter(dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'ua', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID U." + call ESMF_FieldScatter(u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'va', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID V." + call ESMF_FieldScatter(v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) error = nf90_close(ncid) + + if (localpet < num_tiles_input_grid) then + tile = localpet+1 + tilefile= trim(data_dir_input_grid) // "/" // trim(atm_tracer_files_input_grid(tile)) + print*,"- READ ATMOSPHERIC TRACER FILE: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + endif + + do i = 1, num_tracers + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, tracers_input(i), id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(i)) + call ESMF_FieldScatter(tracers_input_grid(i), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + enddo + + if (localpet < num_tiles_input_grid) error=nf90_close(ncid) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d cartesian winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute pressures +!--------------------------------------------------------------------------- + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR PRESSURE." + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR DELTA PRESSURE." + call ESMF_FieldGet(dpres_input_grid, & + farrayPtr=dpresptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + allocate(pres_interface(levp1_input)) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + pres_interface(levp1_input) = ak(1) ! model top in Pa + do k = (levp1_input-1), 1, -1 + pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k) + enddo + do k = 1, lev_input + presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8 + enddo + psptr(i,j) = pres_interface(1) + enddo + enddo + + deallocate(ak) + deallocate(pres_interface) + + call ESMF_FieldDestroy(dpres_input_grid, rc=rc) + + deallocate(data_one_tile_3d, data_one_tile) + + end subroutine read_input_atm_restart_file + +!--------------------------------------------------------------------------- +! Read fv3 netcdf gaussian history file. Each task reads a horizontal +! slice. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_gaussian_netcdf_file(localpet) + + use mpi + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: start(3), count(3), iscnt + integer :: error, ncid, num_tracers_file + integer :: id_dim, idim_input, jdim_input + integer :: id_var, rc, nprocs, max_procs + integer :: kdim, remainder, myrank, i, j, k, n + integer :: clb(3), cub(3) + integer, allocatable :: kcount(:), startk(:), displ(:) + integer, allocatable :: ircnt(:) + + real(esmf_kind_r8), allocatable :: phalf(:) + real(esmf_kind_r8), allocatable :: pres_interface(:) + real(kind=4), allocatable :: dummy3d(:,:,:) + real(kind=4), allocatable :: dummy3dall(:,:,:) + real(esmf_kind_r8), allocatable :: dummy3dflip(:,:,:) + real(esmf_kind_r8), allocatable :: dummy(:,:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), dpresptr(:,:,:) + real(esmf_kind_r8), pointer :: psptr(:,:) + + print*,"- READ INPUT ATMOS DATA FROM GAUSSIAN NETCDF FILE." + + tilefile = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'grid_xt', id_dim) + call netcdf_err(error, 'reading grid_xt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=idim_input) + call netcdf_err(error, 'reading grid_xt value' ) + + error=nf90_inq_dimid(ncid, 'grid_yt', id_dim) + call netcdf_err(error, 'reading grid_yt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input) + call netcdf_err(error, 'reading grid_yt value' ) + + if (idim_input /= i_input .or. jdim_input /= j_input) then + call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 2) + endif + + error=nf90_inq_dimid(ncid, 'pfull', id_dim) + call netcdf_err(error, 'reading pfull id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=lev_input) + call netcdf_err(error, 'reading pfull value' ) + + error=nf90_inq_dimid(ncid, 'phalf', id_dim) + call netcdf_err(error, 'reading phalf id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input) + call netcdf_err(error, 'reading phalf value' ) + allocate(phalf(levp1_input)) + error=nf90_inq_varid(ncid, 'phalf', id_var) + call netcdf_err(error, 'getting phalf varid' ) + error=nf90_get_var(ncid, id_var, phalf) + call netcdf_err(error, 'reading phalf varid' ) + + error=nf90_get_att(ncid, nf90_global, 'ncnsto', num_tracers_file) + call netcdf_err(error, 'reading ntracer value' ) + + call mpi_comm_size(mpi_comm_world, nprocs, error) + print*,'- Running with ', nprocs, ' processors' + + call mpi_comm_rank(mpi_comm_world, myrank, error) + print*,'- myrank/localpet is ',myrank,localpet + + max_procs = nprocs + if (nprocs > lev_input) then + max_procs = lev_input + endif + + kdim = lev_input / max_procs + remainder = lev_input - (max_procs*kdim) + + allocate(kcount(0:nprocs-1)) + kcount=0 + allocate(startk(0:nprocs-1)) + startk=0 + allocate(displ(0:nprocs-1)) + displ=0 + allocate(ircnt(0:nprocs-1)) + ircnt=0 + + do k = 0, max_procs-2 + kcount(k) = kdim + enddo + kcount(max_procs-1) = kdim + remainder + + startk(0) = 1 + do k = 1, max_procs-1 + startk(k) = startk(k-1) + kcount(k-1) + enddo + + ircnt(:) = idim_input * jdim_input * kcount(:) + + displ(0) = 0 + do k = 1, max_procs-1 + displ(k) = displ(k-1) + ircnt(k-1) + enddo + + iscnt=idim_input*jdim_input*kcount(myrank) + +! Account for case if number of tasks exceeds the number of vert levels. + + if (myrank <= max_procs-1) then + allocate(dummy3d(idim_input,jdim_input,kcount(myrank))) + else + allocate(dummy3d(0,0,0)) + endif + + if (myrank == 0) then + allocate(dummy3dall(idim_input,jdim_input,lev_input)) + dummy3dall = 0.0 + allocate(dummy3dflip(idim_input,jdim_input,lev_input)) + dummy3dflip = 0.0 + allocate(dummy(idim_input,jdim_input)) + dummy = 0.0 + else + allocate(dummy3dall(0,0,0)) + allocate(dummy3dflip(0,0,0)) + allocate(dummy(0,0)) + endif + +!--------------------------------------------------------------------------- +! Initialize esmf atmospheric fields. +!--------------------------------------------------------------------------- + + call init_atm_esmf_fields + + print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." + dpres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + +! Temperature + + if (myrank <= max_procs-1) then + start = (/1,1,startk(myrank)/) + count = (/idim_input,jdim_input,kcount(myrank)/) + error=nf90_inq_varid(ncid, 'tmp', id_var) + call netcdf_err(error, 'reading tmp field id' ) + error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count) + call netcdf_err(error, 'reading tmp field' ) + endif + + call mpi_gatherv(dummy3d, iscnt, mpi_real, & + dummy3dall, ircnt, displ, mpi_real, & + 0, mpi_comm_world, error) + if (error /= 0) call error_handler("IN mpi_gatherv of temperature", error) + + if (myrank == 0) then + dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE " + call ESMF_FieldScatter(temp_input_grid, dummy3dflip, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! dpres + + if (myrank <= max_procs-1) then + error=nf90_inq_varid(ncid, 'dpres', id_var) + call netcdf_err(error, 'reading dpres field id' ) + error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count) + call netcdf_err(error, 'reading dpres field' ) + endif + + call mpi_gatherv(dummy3d, iscnt, mpi_real, & + dummy3dall, ircnt, displ, mpi_real, & + 0, mpi_comm_world, error) + if (error /= 0) call error_handler("IN mpi_gatherv of dpres", error) + + if (myrank == 0) then + dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID DPRES " + call ESMF_FieldScatter(dpres_input_grid, dummy3dflip, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! ugrd + + if (myrank <= max_procs-1) then + error=nf90_inq_varid(ncid, 'ugrd', id_var) + call netcdf_err(error, 'reading ugrd field id' ) + error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count) + call netcdf_err(error, 'reading ugrd field' ) + endif + + call mpi_gatherv(dummy3d, iscnt, mpi_real, & + dummy3dall, ircnt, displ, mpi_real, & + 0, mpi_comm_world, error) + if (error /= 0) call error_handler("IN mpi_gatherv of ugrd", error) + + if (myrank == 0) then + dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID UGRD " + call ESMF_FieldScatter(u_input_grid, dummy3dflip, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! vgrd + + if (myrank <= max_procs-1) then + error=nf90_inq_varid(ncid, 'vgrd', id_var) + call netcdf_err(error, 'reading vgrd field id' ) + error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count) + call netcdf_err(error, 'reading vgrd field' ) + endif + + call mpi_gatherv(dummy3d, iscnt, mpi_real, & + dummy3dall, ircnt, displ, mpi_real, & + 0, mpi_comm_world, error) + if (error /= 0) call error_handler("IN mpi_gatherv of vgrd", error) + + if (myrank == 0) then + dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VGRD " + call ESMF_FieldScatter(v_input_grid, dummy3dflip, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! tracers + + do n = 1, num_tracers + + if (myrank <= max_procs-1) then + error=nf90_inq_varid(ncid, tracers_input(n), id_var) + call netcdf_err(error, 'reading tracer field id' ) + error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count) + call netcdf_err(error, 'reading tracer field' ) + endif + + call mpi_gatherv(dummy3d, iscnt, mpi_real, & + dummy3dall, ircnt, displ, mpi_real, & + 0, mpi_comm_world, error) + if (error /= 0) call error_handler("IN mpi_gatherv of tracer", error) + + if (myrank == 0) then + dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1) + where(dummy3dflip < 0.0) dummy3dflip = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT GRID ", tracers_input(n) + call ESMF_FieldScatter(tracers_input_grid(n), dummy3dflip, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + +! dzdt set to zero for now. + + if (myrank == 0) then + dummy3dflip = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT GRID DZDT" + call ESMF_FieldScatter(dzdt_input_grid, dummy3dflip, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy3dflip, dummy3dall, dummy3d) + +! terrain + + if (myrank==0) then + print*,"- READ TERRAIN." + error=nf90_inq_varid(ncid, 'hgtsfc', id_var) + call netcdf_err(error, 'reading hgtsfc field id' ) + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'reading hgtsfc field' ) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! surface pressure + + if (myrank==0) then + print*,"- READ SURFACE P." + error=nf90_inq_varid(ncid, 'pressfc', id_var) + call netcdf_err(error, 'reading pressfc field id' ) + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'reading pressfc field' ) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SURFACE P." + call ESMF_FieldScatter(ps_input_grid, dummy, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(kcount, startk, displ, ircnt, dummy) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d cartesian winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute pressure. +!--------------------------------------------------------------------------- + + print*,"- CALL FieldGet FOR PRESSURE." + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR DELTA PRESSURE." + call ESMF_FieldGet(dpres_input_grid, & + farrayPtr=dpresptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + allocate(pres_interface(levp1_input)) + +!--------------------------------------------------------------------------- +! Compute 3-d pressure. +!--------------------------------------------------------------------------- + +!--------------------------------------------------------------------------- +! When ingesting gaussian netcdf files, the mid-layer +! surface pressure are computed top down from delta-p +! The surface pressure in the file is not used. According +! to Jun Wang, after the model's write component interpolates from the +! cubed-sphere grid to the gaussian grid, the surface pressure is +! no longer consistent with the delta p. +!--------------------------------------------------------------------------- + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + pres_interface(levp1_input) = phalf(1) * 100.0_8 + do k = lev_input, 1, -1 + pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k) + enddo + psptr(i,j) = pres_interface(1) + do k = 1, lev_input + presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8 + enddo + enddo + enddo + + deallocate(pres_interface, phalf) + + call ESMF_FieldDestroy(dpres_input_grid, rc=rc) + + end subroutine read_input_atm_gaussian_netcdf_file + +!--------------------------------------------------------------------------- +! Read input grid fv3 atmospheric tiled history files in netcdf format. +! +! Routine reads tiled files in parallel. Tile 1 is read by +! localpet 0; tile 2 by localpet 1, etc. The number of pets +! must be equal to or greater than the number of tiled files. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_tiled_history_file(localpet) + + use mpi + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: error, ncid, rc, tile + integer :: id_dim, idim_input, jdim_input + integer :: id_var, i, j, k, n + integer :: clb(3), cub(3), num_tracers_file + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), dpresptr(:,:,:) + real(esmf_kind_r8), pointer :: psptr(:,:) + real(esmf_kind_r8), allocatable :: pres_interface(:), phalf(:) + + print*,"- READ INPUT ATMOS DATA FROM TILED HISTORY FILES." + + tilefile = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'grid_xt', id_dim) + call netcdf_err(error, 'reading grid_xt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=idim_input) + call netcdf_err(error, 'reading grid_xt value' ) + + error=nf90_inq_dimid(ncid, 'grid_yt', id_dim) + call netcdf_err(error, 'reading grid_yt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input) + call netcdf_err(error, 'reading grid_yt value' ) + + if (idim_input /= i_input .or. jdim_input /= j_input) then + call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 2) + endif + + error=nf90_inq_dimid(ncid, 'pfull', id_dim) + call netcdf_err(error, 'reading pfull id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=lev_input) + call netcdf_err(error, 'reading pfull value' ) + + error=nf90_inq_dimid(ncid, 'phalf', id_dim) + call netcdf_err(error, 'reading phalf id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input) + call netcdf_err(error, 'reading phalf value' ) + allocate(phalf(levp1_input)) + error=nf90_inq_varid(ncid, 'phalf', id_var) + call netcdf_err(error, 'getting phalf varid' ) + error=nf90_get_var(ncid, id_var, phalf) + call netcdf_err(error, 'reading phalf varid' ) + + error=nf90_get_att(ncid, nf90_global, 'ncnsto', num_tracers_file) + call netcdf_err(error, 'reading ntracer value' ) + + error = nf90_close(ncid) + + print*,'- FILE HAS ', num_tracers_file, ' TRACERS.' + print*,'- WILL PROCESS ', num_tracers, ' TRACERS.' + +!--------------------------------------------------------------------------- +! Initialize esmf atmospheric fields. +!--------------------------------------------------------------------------- + + call init_atm_esmf_fields + + print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." + dpres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + if (localpet < num_tiles_input_grid) then + allocate(data_one_tile(i_input,j_input)) + allocate(data_one_tile_3d(i_input,j_input,lev_input)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + if (localpet < num_tiles_input_grid) then + tile = localpet+1 + tilefile= trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(tile)) + print*,"- READ ATMOSPHERIC DATA FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + endif + + if (localpet < num_tiles_input_grid) then +! print*,"- READ VERTICAL VELOCITY." +! error=nf90_inq_varid(ncid, 'dzdt', id_var) +! call netcdf_err(error, 'reading field id' ) +! error=nf90_get_var(ncid, id_var, data_one_tile_3d) +! call netcdf_err(error, 'reading field' ) +! data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + +! Using w from the tiled history files has caused problems. +! Set to zero. + data_one_tile_3d = 0.0_8 + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY." + call ESMF_FieldScatter(dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + do n = 1, num_tracers + + if (localpet < num_tiles_input_grid) then + print*,"- READ ", trim(tracers_input(n)) + error=nf90_inq_varid(ncid, tracers_input(n), id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TRACER ", trim(tracers_input(n)) + call ESMF_FieldScatter(tracers_input_grid(n), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ TEMPERATURE." + error=nf90_inq_varid(ncid, 'tmp', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ U-WIND." + error=nf90_inq_varid(ncid, 'ugrd', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID U." + call ESMF_FieldScatter(u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ V-WIND." + error=nf90_inq_varid(ncid, 'vgrd', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID V." + call ESMF_FieldScatter(v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ SURFACE PRESSURE." + error=nf90_inq_varid(ncid, 'pressfc', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'reading field' ) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE." + call ESMF_FieldScatter(ps_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ TERRAIN." + error=nf90_inq_varid(ncid, 'hgtsfc', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'reading field' ) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ DELTA PRESSURE." + error=nf90_inq_varid(ncid, 'dpres', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT DELTA PRESSURE." + call ESMF_FieldScatter(dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) error = nf90_close(ncid) + + deallocate(data_one_tile_3d, data_one_tile) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d cartesian winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute pressure. +!--------------------------------------------------------------------------- + + print*,"- CALL FieldGet FOR PRESSURE." + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR DELTA PRESSURE." + call ESMF_FieldGet(dpres_input_grid, & + farrayPtr=dpresptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + allocate(pres_interface(levp1_input)) + +!--------------------------------------------------------------------------- +! Compute 3-d pressure. +!--------------------------------------------------------------------------- + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + pres_interface(1) = psptr(i,j) + do k = 2, levp1_input + pres_interface(k) = pres_interface(k-1) - dpresptr(i,j,k-1) + enddo + do k = 1, lev_input + presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8 + enddo + enddo + enddo + + deallocate(pres_interface, phalf) + + call ESMF_FieldDestroy(dpres_input_grid, rc=rc) + + end subroutine read_input_atm_tiled_history_file + +!--------------------------------------------------------------------------- +! Read input grid atmospheric fv3gfs grib2 files. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_grib2_file(localpet) + + use wgrib2api + + use grib2_util, only : rh2spfh, convert_omega + + implicit none + + integer, intent(in) :: localpet + + integer, parameter :: ntrac_max=14 + + character(len=300) :: the_file + character(len=20) :: vlevtyp, vname, lvl_str,lvl_str_space, & + trac_names_grib_1(ntrac_max), & + trac_names_grib_2(ntrac_max), & + trac_names_vmap(ntrac_max), & + tracers_input_grib_1(num_tracers), & + tracers_input_grib_2(num_tracers), & + tmpstr, & + method, tracers_input_vmap(num_tracers), & + tracers_default(ntrac_max), vname2 + character (len=500) :: metadata + + integer :: i, j, k, n, lvl_str_space_len + integer :: rc, clb(3), cub(3) + integer :: vlev, iret,varnum + + integer :: len_str + logical :: lret + + logical :: conv_omega=.false., & + hasspfh=.true. + + real(esmf_kind_r8), allocatable :: rlevs(:) + real(esmf_kind_r4), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:), dummy2d_8(:,:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:),tptr(:,:,:), & + qptr(:,:,:), wptr(:,:,:), & + uptr(:,:,:), vptr(:,:,:) + real(esmf_kind_r4) :: value + real(esmf_kind_r8), parameter :: p0 = 100000.0 + + + tracers(:) = "NULL" + !trac_names_grib = (/":SPFH:",":CLWR:", "O3MR",":CICE:", ":RWMR:",":SNMR:",":GRLE:", & + ! ":TCDC:", ":NCCICE:",":SPNCR:", ":NCONCD:",":PMTF:",":PMTC:",":TKE:"/) + trac_names_grib_1 = (/":var0_2", ":var0_2", ":var0_2", ":var0_2", ":var0_2",":var0_2", \ + ":var0_2", ":var0_2", ":var0_2", ":var0_2", ":var0_2",":var0_2", \ + ":var0_2", ":var0_2"/) + trac_names_grib_2 = (/"_1_0: ", "_1_22: ", "_14_192:", "_1_23: ", "_1_24: ","_1_25: ", \ + "_1_32: ", "_6_1: ", "_6_29: ", "_1_100: ", "_6_28: ","_13_193:", \ + "_13_192:", "_2_2: "/) + trac_names_vmap = (/"sphum ", "liq_wat ", "o3mr ", "ice_wat ", & + "rainwat ", "snowwat ", "graupel ", "cld_amt ", "ice_nc ", & + "rain_nc ", "water_nc", "liq_aero", "ice_aero", & + "sgs_tke "/) + tracers_default = (/"sphum ", "liq_wat ", "o3mr ", "ice_wat ", & + "rainwat ", "snowwat ", "graupel ", "cld_amt ", "ice_nc ", & + "rain_nc ", "water_nc", "liq_aero", "ice_aero", & + "sgs_tke "/) + + the_file = trim(data_dir_input_grid) // "/" // trim(grib2_file_input_grid) + + print*,"- READ ATMOS DATA FROM GRIB2 FILE: ", trim(the_file) + print*,"- USE INVENTORY FILE ", inv_file + + print*,"- OPEN FILE." + inquire(file=the_file,exist=lret) + if (.not.lret) call error_handler("OPENING GRIB2 ATM FILE.", iret) + + print*,"- READ VERTICAL COORDINATE." + iret = grb2_inq(the_file,inv_file,":var_0_2","_0_0:"," hybrid level:") + + if (iret <= 0) then + lvl_str = "mb:" + lvl_str_space = " mb:" + lvl_str_space_len = 4 + iret = grb2_inq(the_file,inv_file,":UGRD:",lvl_str_space) + lev_input=iret + if (localpet == 0) print*,"- DATA IS ON ", lev_input, " ISOBARIC LEVELS." + else + call error_handler("HYBRID VERTICAL COORD DATA NOT SUPPORTED", -1) + endif + + allocate(slevs(lev_input)) + allocate(rlevs(lev_input)) + levp1_input = lev_input + 1 + +! Get the vertical levels, and search string by sequential reads + + do i = 1,lev_input + iret=grb2_inq(the_file,inv_file,':UGRD:',trim(lvl_str),sequential=i-1,desc=metadata) + if (iret.ne.1) call error_handler(" IN SEQUENTIAL FILE READ.", iret) + + j = index(metadata,':UGRD:') + len(':UGRD:') + k = index(metadata,trim(lvl_str_space)) + len(trim(lvl_str_space))-1 + + read(metadata(j:k),*) rlevs(i) + + slevs(i) = metadata(j-1:k) + rlevs(i) = rlevs(i) * 100.0 + if (localpet==0) print*, "- LEVEL = ", slevs(i) + enddo + +! Jili Dong add sort to re-order isobaric levels. + + call quicksort(rlevs,1,lev_input) + + do i = 1,lev_input + write(slevs(i),"(F20.10)") rlevs(i)/100.0 + len_str = len_trim(slevs(i)) + + do while (slevs(i)(len_str:len_str) .eq. '0') + slevs(i) = slevs(i)(:len_str-1) + len_str = len_str - 1 + end do + + if (slevs(i)(len_str:len_str) .eq. '.') then + slevs(i) = slevs(i)(:len_str-1) + len_str = len_str - 1 + end if + + slevs(i) = trim(slevs(i)) + + slevs(i) = ":"//trim(adjustl(slevs(i)))//" mb:" + if (localpet==0) print*, "- LEVEL AFTER SORT = ",slevs(i) + enddo + + if (localpet == 0) print*,"- FIND SPFH OR RH IN FILE" + iret = grb2_inq(the_file,inv_file,trac_names_grib_1(1),trac_names_grib_2(1),lvl_str_space) + + if (iret <= 0) then + iret = grb2_inq(the_file,inv_file, ':var0_2','_1_1:',lvl_str_space) + if (iret <= 0) call error_handler("READING ATMOSPHERIC WATER VAPOR VARIABLE.", iret) + hasspfh = .false. + trac_names_grib_2(1)='_1_1:' + if (localpet == 0) print*,"- FILE CONTAINS RH." + else + if (localpet == 0) print*,"- FILE CONTAINS SPFH." + endif + + print*,"- COUNT NUMBER OF TRACERS TO BE READ IN BASED ON PHYSICS SUITE TABLE" + do n = 1, num_tracers + + vname = tracers_input(n) + + i = maxloc(merge(1.,0.,trac_names_vmap == vname),dim=1) + + tracers_input_grib_1(n) = trac_names_grib_1(i) + tracers_input_grib_2(n) = trac_names_grib_2(i) + tracers_input_vmap(n)=trac_names_vmap(i) + tracers(n)=tracers_default(i) + + enddo + + if (localpet==0) print*, "- NUMBER OF TRACERS IN FILE = ", num_tracers + +!--------------------------------------------------------------------------- +! Initialize esmf atmospheric fields. +!--------------------------------------------------------------------------- + + call init_atm_esmf_fields + + if (localpet == 0) then + allocate(dummy2d(i_input,j_input)) + allocate(dummy2d_8(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lev_input)) + else + allocate(dummy2d(0,0)) + allocate(dummy2d_8(0,0)) + allocate(dummy3d(0,0,0)) + endif + +!----------------------------------------------------------------------- +! Fields in non-native files read in from top to bottom. We will +! flip indices later. This program expects bottom to top. +!----------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ TEMPERATURE." + vname = ":TMP:" + do vlev = 1, lev_input + iret = grb2_inq(the_file,inv_file,vname,slevs(vlev),data2=dummy2d) + if (iret<=0) then + call error_handler("READING IN TEMPERATURE AT LEVEL "//trim(slevs(vlev)),iret) + endif + dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8) + print*,'temp check after read ',vlev, dummy3d(1,1,vlev) + enddo + endif + + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + do n = 1, num_tracers + + if (localpet == 0) print*,"- READ ", trim(tracers_input_vmap(n)) + vname = tracers_input_vmap(n) + call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & + this_field_var_name=tmpstr,loc=varnum) + if (n==1 .and. .not. hasspfh) then + print*,"- CALL FieldGather TEMPERATURE." + call ESMF_FieldGather(temp_input_grid,dummy3d,rootPet=0, tile=1, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + endif + if (localpet == 0) then + vname = trim(tracers_input_grib_1(n)) + vname2 = trim(tracers_input_grib_2(n)) + + do vlev = 1, lev_input + iret = grb2_inq(the_file,inv_file,vname,slevs(vlev),vname2,data2=dummy2d) + + if (iret <= 0) then + call handle_grib_error(vname, slevs(vlev),method,value,varnum,iret,var=dummy2d) + if (iret==1) then ! missing_var_method == skip or no entry + if (trim(vname2)=="_1_0:" .or. trim(vname2) == "_1_1:" .or. & + trim(vname2) == ":14:192:") then + call error_handler("READING IN "//trim(vname)//" AT LEVEL "//trim(slevs(vlev))& + //". SET A FILL VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret) + else + exit + endif + endif + endif + + if (n==1 .and. .not. hasspfh) then + call rh2spfh(dummy2d,rlevs(vlev),dummy3d(:,:,vlev)) + endif + + print*,'tracer ',vlev, maxval(dummy2d),minval(dummy2d) + dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8) + enddo + endif + + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input_vmap(n)) + call ESMF_FieldScatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + if (localpet==0) then + do vlev = 1, lev_input + + vname = ":var0_2" + vname2 = "_2_2:" + iret = grb2_inq(the_file,inv_file,vname,vname2,slevs(vlev),data2=dummy2d) + if (iret<=0) then + call error_handler("READING UWIND AT LEVEL "//trim(slevs(vlev)),iret) + endif + + print*, 'max, min U ', minval(dummy2d), maxval(dummy2d) + dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8) + + enddo + endif + + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT U-WIND." + call ESMF_FieldScatter(u_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet==0) then + do vlev = 1, lev_input + + vname = ":var0_2" + vname2 = "_2_3:" + iret = grb2_inq(the_file,inv_file,vname,vname2,slevs(vlev),data2=dummy2d) + if (iret<=0) then + call error_handler("READING VWIND AT LEVEL "//trim(slevs(vlev)),iret) + endif + + print*, 'max, min V ', minval(dummy2d), maxval(dummy2d) + dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8) + + enddo + endif + + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT V-WIND." + call ESMF_FieldScatter(v_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SURFACE PRESSURE." + !vname = ":PRES:" + vname = ":var0_2" + vname2 = "_3_0:" + vlevtyp = ":surface:" + iret = grb2_inq(the_file,inv_file,vname,vname2,vlevtyp,data2=dummy2d) + if (iret <= 0) call error_handler("READING SURFACE PRESSURE RECORD.", iret) + dummy2d_8 = real(dummy2d,esmf_kind_r8) + endif + + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE." + call ESMF_FieldScatter(ps_input_grid, dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DZDT." + vname = "dzdt" + call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, & + loc=varnum) + !vname = ":DZDT:" + vname = ":var0_2" + vname2 = "_2_9:" + do vlev = 1, lev_input + iret = grb2_inq(the_file,inv_file,vname,vname2,slevs(vlev),data2=dummy2d) + if (iret <= 0 ) then + print*,"DZDT not available at level ", trim(slevs(vlev)), " so checking for VVEL" + !vname = ":VVEL:" + vname2 = "_2_8:" + iret = grb2_inq(the_file,inv_file,vname,vname2,slevs(vlev),data2=dummy2d) + + + if (iret <= 0) then + call handle_grib_error(vname, slevs(vlev),method,value,varnum,iret,var=dummy2d) + if (iret==1) then ! missing_var_method == skip + cycle + endif + else + conv_omega = .true. + endif + + endif + print*,'dzdt ',vlev, maxval(dummy2d),minval(dummy2d) + dummy3d(:,:,vlev) = dummy2d + enddo + endif + + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT DZDT." + call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TERRAIN." + !vname = ":HGT:" + vname = ":var0_2" + vname2 = "_3_5:" + vlevtyp = ":surface:" + iret = grb2_inq(the_file,inv_file,vname,vname2,vlevtyp,data2=dummy2d) + if (iret <= 0) call error_handler("READING TERRAIN HEIGHT RECORD.", iret) + dummy2d_8 = real(dummy2d,esmf_kind_r8) + endif + + if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d, dummy3d, dummy2d_8) + +!--------------------------------------------------------------------------- +! Flip 'z' indices to all 3-d variables. Data is read in from model +! top to surface. This program expects surface to model top. +!--------------------------------------------------------------------------- + + if (localpet == 0) print*,"- CALL FieldGet FOR SURFACE PRESSURE." + nullify(psptr) + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(presptr) + if (localpet == 0) print*,"- CALL FieldGet FOR 3-D PRESSURE." + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(tptr) + if (localpet == 0) print*,"- CALL FieldGet TEMPERATURE." + call ESMF_FieldGet(temp_input_grid, & + farrayPtr=tptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(uptr) + if (localpet == 0) print*,"- CALL FieldGet FOR U" + call ESMF_FieldGet(u_input_grid, & + farrayPtr=uptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(vptr) + if (localpet == 0) print*,"- CALL FieldGet FOR V" + call ESMF_FieldGet(v_input_grid, & + farrayPtr=vptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(wptr) + if (localpet == 0) print*,"- CALL FieldGet FOR W" + call ESMF_FieldGet(dzdt_input_grid, & + farrayPtr=wptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + if (localpet == 0) print*,"- CALL FieldGet FOR TRACERS." + do n=1,num_tracers + nullify(qptr) + call ESMF_FieldGet(tracers_input_grid(n), & + farrayPtr=qptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + do i = clb(1),cub(1) + do j = clb(2),cub(2) + qptr(i,j,:) = qptr(i,j,lev_input:1:-1) + end do + end do + end do + + do i = clb(1),cub(1) + do j = clb(2),cub(2) + presptr(i,j,:) = rlevs(lev_input:1:-1) + tptr(i,j,:) = tptr(i,j,lev_input:1:-1) + uptr(i,j,:) = uptr(i,j,lev_input:1:-1) + vptr(i,j,:) = vptr(i,j,lev_input:1:-1) + wptr(i,j,:) = wptr(i,j,lev_input:1:-1) + end do + end do + + if (localpet == 0) then + print*,'psfc is ',clb(1),clb(2),psptr(clb(1),clb(2)) + print*,'pres is ',cub(1),cub(2),presptr(cub(1),cub(2),:) + + print*,'pres check 1',localpet,maxval(presptr(clb(1):cub(1),clb(2):cub(2),1)), & + minval(presptr(clb(1):cub(1),clb(2):cub(2),1)) + print*,'pres check lev',localpet,maxval(presptr(clb(1):cub(1),clb(2):cub(2), & + lev_input)),minval(presptr(clb(1):cub(1),clb(2):cub(2),lev_input)) + endif + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d component winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Convert dpdt to dzdt if needed +!--------------------------------------------------------------------------- + + if (conv_omega) then + + if (localpet == 0) print*,"- CONVERT FROM OMEGA TO DZDT." + + nullify(tptr) + if (localpet == 0) print*,"- CALL FieldGet TEMPERATURE." + call ESMF_FieldGet(temp_input_grid, & + farrayPtr=tptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(qptr) + if (localpet == 0) print*,"- CALL FieldGet SPECIFIC HUMIDITY." + call ESMF_FieldGet(tracers_input_grid(1), & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=qptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(wptr) + if (localpet == 0) print*,"- CALL FieldGet DZDT." + call ESMF_FieldGet(dzdt_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=wptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + nullify(presptr) + call ESMF_FieldGet(pres_input_grid, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + call convert_omega(wptr,presptr,tptr,qptr,clb,cub) + + endif + + end subroutine read_input_atm_grib2_file + +!--------------------------------------------------------------------------- +! Read input grid surface data from a spectral gfs gaussian sfcio file. +! Prior to July 19, 2017. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_gfs_sfcio_file(localpet) + + use sfcio_module + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer(sfcio_intkind) :: iret + integer :: rc + + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + + type(sfcio_head) :: sfchead + type(sfcio_dbta) :: sfcdata + + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + + print*,"- READ SURFACE DATA IN SFCIO FORMAT." + print*,"- OPEN AND READ: ",trim(the_file) + call sfcio_sropen(23, trim(the_file), iret) + if (iret /= 0) then + rc=iret + call error_handler("OPENING FILE", rc) + endif + + call sfcio_srhead(23, sfchead, iret) + if (iret /= 0) then + rc=iret + call error_handler("READING HEADER", rc) + endif + + if (localpet == 0) then + call sfcio_aldbta(sfchead, sfcdata, iret) + if (iret /= 0) then + rc=iret + call error_handler("ALLOCATING DATA.", rc) + endif + call sfcio_srdbta(23, sfchead, sfcdata, iret) + if (iret /= 0) then + rc=iret + call error_handler("READING DATA.", rc) + endif + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lsoil_input)) + else + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + endif + + if (localpet == 0) dummy2d = sfcdata%slmsk + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%zorl + + print*,"- CALL FieldScatter FOR INPUT Z0." + call ESMF_FieldScatter(z0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = nint(sfcdata%vtype) + + print*,"- CALL FieldScatter FOR INPUT VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Prior to July, 2017, gfs used zobler soil types. '13' indicates permanent land ice. + veg_type_landice_input = 13 + + if (localpet == 0) dummy2d = sfcdata%canopy + + print*,"- CALL FieldScatter FOR INPUT CANOPY MC." + call ESMF_FieldScatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%fice + + print*,"- CALL FieldScatter FOR INPUT ICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%hice + + print*,"- CALL FieldScatter FOR INPUT ICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%tisfc + + print*,"- CALL FieldScatter FOR INPUT ICE SKIN TEMP." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%snwdph ! mm (expected by program) + + print*,"- CALL FieldScatter FOR INPUT SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%sheleg + + print*,"- CALL FieldScatter FOR INPUT SNOW LIQUID EQUIV." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%t2m + + print*,"- CALL FieldScatter FOR INPUT T2M." + call ESMF_FieldScatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%q2m + + print*,"- CALL FieldScatter FOR INPUT Q2M." + call ESMF_FieldScatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%tprcp + + print*,"- CALL FieldScatter FOR INPUT TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%f10m + + print*,"- CALL FieldScatter FOR INPUT F10M." + call ESMF_FieldScatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%uustar + + print*,"- CALL FieldScatter FOR INPUT USTAR." + call ESMF_FieldScatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%ffmm + + print*,"- CALL FieldScatter FOR INPUT FFMM." + call ESMF_FieldScatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%srflag + + print*,"- CALL FieldScatter FOR INPUT SRFLAG." + call ESMF_FieldScatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%tsea + + print*,"- CALL FieldScatter FOR INPUT SKIN TEMP." + call ESMF_FieldScatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = nint(sfcdata%stype) + + print*,"- CALL FieldScatter FOR INPUT SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%orog + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy3d = sfcdata%slc + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy3d = sfcdata%smc + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy3d = sfcdata%stc + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d, dummy3d) + call sfcio_axdbta(sfcdata, iret) + + call sfcio_sclose(23, iret) + + end subroutine read_input_sfc_gfs_sfcio_file + +!--------------------------------------------------------------------------- +! Read input grid surface data from a spectral gfs gaussian nemsio file. +! Format used by gfs starting July 19, 2017. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_gfs_gaussian_nemsio_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer :: rc + + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + + if (localpet == 0) then + allocate(dummy3d(i_input,j_input,lsoil_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy(i_input*j_input)) + print*,"- OPEN FILE ", trim(the_file) + call nemsio_open(gfile, the_file, "read", iret=rc) + if (rc /= 0) call error_handler("OPENING FILE.", rc) + else + allocate(dummy3d(0,0,0)) + allocate(dummy2d(0,0)) + allocate(dummy(0)) + endif + + if (localpet == 0) then + print*,"- READ TERRAIN." + call nemsio_readrecv(gfile, "orog", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TERRAIN.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'orog ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ LANDSEA MASK." + call nemsio_readrecv(gfile, "land", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'landmask ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE FRACTION." + call nemsio_readrecv(gfile, "icec", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icec ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE DEPTH." + call nemsio_readrecv(gfile, "icetk", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icetk ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "tisfc", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ti ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW LIQUID EQUIVALENT." + call nemsio_readrecv(gfile, "weasd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'weasd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW DEPTH." + call nemsio_readrecv(gfile, "snod", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'snod ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ VEG TYPE." + call nemsio_readrecv(gfile, "vtype", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING VEG TYPE", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'vtype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TYPE." + call nemsio_readrecv(gfile, "sotyp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SOIL TYPE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'sotype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ T2M." + call nemsio_readrecv(gfile, "tmp", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING T2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'t2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Q2M." + call nemsio_readrecv(gfile, "spfh", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Q2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'q2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TPRCP." + call nemsio_readrecv(gfile, "tprcp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TPRCP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tprcp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ FFMM." + call nemsio_readrecv(gfile, "ffmm", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING FFMM.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ffmm ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ USTAR." + call nemsio_readrecv(gfile, "fricv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING USTAR.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'fricv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = 0.0 + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "tmp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SKIN TEMPERATURE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tmp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ F10M." + call nemsio_readrecv(gfile, "f10m", "10 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING F10M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'f10m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M." + call ESMF_FieldScatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ CANOPY MOISTURE CONTENT." + call nemsio_readrecv(gfile, "cnwat", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING CANOPY MOISTURE CONTENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'cnwat ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Z0." + call nemsio_readrecv(gfile, "sfcr", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Z0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'sfcr ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d) + + if (localpet == 0) then + print*,"- READ LIQUID SOIL MOISTURE." + call nemsio_readrecv(gfile, "slc", "soil layer", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "slc", "soil layer", 2, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "slc", "soil layer", 3, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "slc", "soil layer", 4, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'slc ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TOTAL SOIL MOISTURE." + call nemsio_readrecv(gfile, "smc", "soil layer", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "smc", "soil layer", 2, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "smc", "soil layer", 3, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "smc", "soil layer", 4, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'smc ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TEMPERATURE." + call nemsio_readrecv(gfile, "stc", "soil layer", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 SOIL TEMP.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "stc", "soil layer", 2, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 SOIL TEMP.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "stc", "soil layer", 3, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 SOIL TEMP.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "stc", "soil layer", 4, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 SOIL TEMP.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'stc ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy3d, dummy) + + if (localpet == 0) call nemsio_close(gfile) + + end subroutine read_input_sfc_gfs_gaussian_nemsio_file + +!--------------------------------------------------------------------------- +! Read input grid surface data from an fv3 gaussian nemsio file. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_gaussian_nemsio_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=250) :: the_file + + integer :: rc + + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + + if (localpet == 0) then + allocate(dummy3d(i_input,j_input,lsoil_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy(i_input*j_input)) + print*,"- OPEN FILE ", trim(the_file) + call nemsio_open(gfile, the_file, "read", iret=rc) + if (rc /= 0) call error_handler("OPENING FILE.", rc) + else + allocate(dummy3d(0,0,0)) + allocate(dummy2d(0,0)) + allocate(dummy(0)) + endif + + if (localpet == 0) then + print*,"- READ TERRAIN." + call nemsio_readrecv(gfile, "orog", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TERRAIN.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'orog ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ LANDSEA MASK." + call nemsio_readrecv(gfile, "land", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'landmask ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE FRACTION." + call nemsio_readrecv(gfile, "icec", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icec ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE DEPTH." + call nemsio_readrecv(gfile, "icetk", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icetk ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "ti", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ti ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW LIQUID EQUIVALENT." + call nemsio_readrecv(gfile, "weasd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'weasd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW DEPTH." + call nemsio_readrecv(gfile, "snod", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) * 1000.0_8 + print*,'snod ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ VEG TYPE." + call nemsio_readrecv(gfile, "vtype", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING VEG TYPE", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'vtype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TYPE." + call nemsio_readrecv(gfile, "sotyp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SOIL TYPE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'sotype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ T2M." + call nemsio_readrecv(gfile, "tmp", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING T2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'t2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Q2M." + call nemsio_readrecv(gfile, "spfh", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Q2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'q2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TPRCP." + call nemsio_readrecv(gfile, "tprcp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TPRCP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tprcp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ FFMM." + call nemsio_readrecv(gfile, "ffmm", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING FFMM.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ffmm ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ USTAR." + call nemsio_readrecv(gfile, "fricv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING USTAR.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'fricv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = 0.0 + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "tmp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SKIN TEMPERATURE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tmp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ F10M." + call nemsio_readrecv(gfile, "f10m", "10 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING F10M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'f10m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M." + call ESMF_FieldScatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ CANOPY MOISTURE CONTENT." + call nemsio_readrecv(gfile, "cnwat", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING CANOPY MOISTURE CONTENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'cnwat ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Z0." + call nemsio_readrecv(gfile, "sfcr", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Z0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) * 100.0_8 ! convert to cm + print*,'sfcr ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d) + + if (localpet == 0) then + print*,"- READ LIQUID SOIL MOISTURE." + call nemsio_readrecv(gfile, "soill", "0-10 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soill", "10-40 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soill", "40-100 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soill", "100-200 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'soill ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TOTAL SOIL MOISTURE." + call nemsio_readrecv(gfile, "soilw", "0-10 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soilw", "10-40 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soilw", "40-100 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soilw", "100-200 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'soilm ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TEMPERATURE." + call nemsio_readrecv(gfile, "tmp", "0-10 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 SOIL TEMP.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "tmp", "10-40 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 SOIL TEMP.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "tmp", "40-100 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 SOIL TEMP.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "tmp", "100-200 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 SOIL TEMP.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'soilt ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy3d, dummy) + + if (localpet == 0) call nemsio_close(gfile) + + end subroutine read_input_sfc_gaussian_nemsio_file + +!--------------------------------------------------------------------------- +! Read input grid surface data tiled warm 'restart' files. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_restart_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: error, rc + integer :: id_dim, idim_input, jdim_input + integer :: ncid, tile, id_var + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + +!--------------------------------------------------------------------------- +! Get i/j dimensions and number of soil layers from first surface file. +! Do dimensions match those from the orography file? +!--------------------------------------------------------------------------- + + tilefile = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + print*,"- READ GRID DIMENSIONS FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'xaxis_1', id_dim) + call netcdf_err(error, 'reading xaxis_1 id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=idim_input) + call netcdf_err(error, 'reading xaxis_1 value' ) + + error=nf90_inq_dimid(ncid, 'yaxis_1', id_dim) + call netcdf_err(error, 'reading yaxis_1 id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input) + call netcdf_err(error, 'reading yaxis_1 value' ) + + if (idim_input /= i_input .or. jdim_input /= j_input) then + call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 1) + endif + + error = nf90_close(ncid) + + if (localpet == 0) then + allocate(data_one_tile(idim_input,jdim_input)) + allocate(data_one_tile_3d(idim_input,jdim_input,lsoil_input)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + TERRAIN_LOOP: do tile = 1, num_tiles_input_grid + + if (localpet == 0) then + tilefile = trim(orog_dir_input_grid) // trim(orog_files_input_grid(tile)) + print*,'- OPEN OROGRAPHY FILE: ', trim(tilefile) + error=nf90_open(tilefile,nf90_nowrite,ncid) + call netcdf_err(error, 'OPENING OROGRAPHY FILE' ) + error=nf90_inq_varid(ncid, 'orog_raw', id_var) + call netcdf_err(error, 'READING OROG RECORD ID' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'READING OROG RECORD' ) + print*,'terrain check ',tile, maxval(data_one_tile) + error=nf90_close(ncid) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo TERRAIN_LOOP + + TILE_LOOP : do tile = 1, num_tiles_input_grid + +! liquid soil moisture + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('slc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata_3d=data_one_tile_3d) + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('smc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata_3d=data_one_tile_3d) + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('stc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata_3d=data_one_tile_3d) + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! land mask + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('slmsk', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice fraction + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('fice', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('hice', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice skin temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tisfc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! liquid equivalent snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('sheleg', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! physical snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('snwdph', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Vegetation type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('vtype', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Soil type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('stype', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('t2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter q + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('q2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tprcp', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('f10m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M" + call ESMF_FieldScatter(f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('ffmm', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('uustar', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('srflag', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tsea', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('canopy', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('zorl', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo TILE_LOOP + + deallocate(data_one_tile, data_one_tile_3d) + + end subroutine read_input_sfc_restart_file + +!--------------------------------------------------------------------------- +! Read input grid surface data from tiled 'history' files (netcdf) or +! gaussian netcdf files. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_netcdf_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: error, id_var + integer :: id_dim, idim_input, jdim_input + integer :: ncid, rc, tile + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + +!--------------------------------------------------------------------------- +! Get i/j dimensions and number of soil layers from first surface file. +! Do dimensions match those from the orography file? +!--------------------------------------------------------------------------- + + tilefile = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + print*,"- READ GRID DIMENSIONS FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'grid_xt', id_dim) + call netcdf_err(error, 'reading grid_xt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=idim_input) + call netcdf_err(error, 'reading grid_xt value' ) + + error=nf90_inq_dimid(ncid, 'grid_yt', id_dim) + call netcdf_err(error, 'reading grid_yt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input) + call netcdf_err(error, 'reading grid_yt value' ) + + if (idim_input /= i_input .or. jdim_input /= j_input) then + call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 3) + endif + + error = nf90_close(ncid) + + if (localpet == 0) then + allocate(data_one_tile(idim_input,jdim_input)) + allocate(data_one_tile_3d(idim_input,jdim_input,lsoil_input)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + TERRAIN_LOOP: do tile = 1, num_tiles_input_grid + + if (trim(input_type) == "gaussian_netcdf") then + if (localpet == 0) then + call read_fv3_grid_data_netcdf('orog', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + else + + if (localpet == 0) then + tilefile = trim(orog_dir_input_grid) // trim(orog_files_input_grid(tile)) + print*,'- OPEN OROGRAPHY FILE: ', trim(tilefile) + error=nf90_open(tilefile,nf90_nowrite,ncid) + call netcdf_err(error, 'OPENING OROGRAPHY FILE.' ) + error=nf90_inq_varid(ncid, 'orog_raw', id_var) + call netcdf_err(error, 'READING OROGRAPHY RECORD ID.' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'READING OROGRAPHY RECORD.' ) + print*,'terrain check history ',tile, maxval(data_one_tile) + error=nf90_close(ncid) + endif + + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo TERRAIN_LOOP + + TILE_LOOP : do tile = 1, num_tiles_input_grid + +! liquid soil moisture + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('soill1', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,1) = data_one_tile + call read_fv3_grid_data_netcdf('soill2', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,2) = data_one_tile + call read_fv3_grid_data_netcdf('soill3', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,3) = data_one_tile + call read_fv3_grid_data_netcdf('soill4', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,4) = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! total soil moisture + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('soilw1', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,1) = data_one_tile + call read_fv3_grid_data_netcdf('soilw2', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,2) = data_one_tile + call read_fv3_grid_data_netcdf('soilw3', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,3) = data_one_tile + call read_fv3_grid_data_netcdf('soilw4', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,4) = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! soil tempeature (ice temp at land ice points) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('soilt1', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,1) = data_one_tile + call read_fv3_grid_data_netcdf('soilt2', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,2) = data_one_tile + call read_fv3_grid_data_netcdf('soilt3', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,3) = data_one_tile + call read_fv3_grid_data_netcdf('soilt4', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,4) = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! land mask + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('land', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice fraction + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('icec', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('icetk', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice skin temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tisfc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! liquid equivalent snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('weasd', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! physical snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('snod', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile = data_one_tile * 1000.0 ! convert from meters to mm. + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Vegetation type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('vtype', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Soil type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('sotyp', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tmp2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter q + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('spfh2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tprcp', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('f10m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M" + call ESMF_FieldScatter(f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('ffmm', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('fricv', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then +! call read_fv3_grid_data_netcdf('srflag', tile, idim_input, jdim_input, & +! lsoil_input, sfcdata=data_one_tile) + data_one_tile = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tmpsfc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('cnwat', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('sfcr', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo TILE_LOOP + + deallocate(data_one_tile, data_one_tile_3d) + + end subroutine read_input_sfc_netcdf_file + +!--------------------------------------------------------------------------- +! Read surface data from an fv3gfs grib2 file. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_grib2_file(localpet) + + use wgrib2api + + implicit none + + integer, intent(in) :: localpet + + character(len=250) :: the_file + character(len=20) :: vname, vname_file,slev + + character(len=50) :: method + + integer :: rc, varnum, iret, i, j,k + integer, parameter :: icet_default = 265.0 + + logical :: exist + + real(esmf_kind_r4) :: value + + real(esmf_kind_r4), allocatable :: dummy2d(:,:),tsk_save(:,:),icec_save(:,:) + real(esmf_kind_r8), allocatable :: dummy2d_8(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + integer(esmf_kind_i4), allocatable :: slmsk_save(:,:) + + + the_file = trim(data_dir_input_grid) // "/" // trim(grib2_file_input_grid) + + print*,"- READ SFC DATA FROM GRIB2 FILE: ", trim(the_file) + inquire(file=the_file,exist=exist) + if (.not.exist) then + iret = 1 + call error_handler("OPENING GRIB2 FILE.", iret) + end if + + lsoil_input = grb2_inq(the_file, inv_file, ':TSOIL:',' below ground:') + print*, "- FILE HAS ", lsoil_input, " SOIL LEVELS" + if (lsoil_input <= 0) call error_handler("COUNTING SOIL LEVELS.", rc) + + if (localpet == 0) then + allocate(dummy2d(i_input,j_input)) + allocate(slmsk_save(i_input,j_input)) + allocate(tsk_save(i_input,j_input)) + allocate(icec_save(i_input,j_input)) + allocate(dummy2d_8(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lsoil_input)) + else + allocate(dummy3d(0,0,0)) + allocate(dummy2d_8(0,0)) + allocate(dummy2d(0,0)) + + endif + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! These variables are always in grib files, or are required, so no need to check for them + ! in the varmap table. If they can't be found in the input file, then stop the program. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if (localpet == 0) then + print*,"- READ TERRAIN." + rc = grb2_inq(the_file, inv_file, ':HGT:',':surface:', data2=dummy2d) + if (rc /= 1) call error_handler("READING TERRAIN.", rc) + print*,'orog ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + +if (localpet == 0) then + print*,"- READ SEAICE FRACTION." + rc = grb2_inq(the_file, inv_file, ':ICEC:',':surface:', data2=dummy2d) + if (rc /= 1) call error_handler("READING SEAICE FRACTION.", rc) + !dummy2d = dummy2d(i_input:1:-1,j_input:1:-1) + print*,'icec ',maxval(dummy2d),minval(dummy2d) + icec_save = dummy2d + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + +!---------------------------------------------------------------------------------- +! GFS v14 and v15.2 grib data has two land masks. LANDN is created by +! nearest neighbor interpolation. LAND is created by bilinear interpolation. +! LANDN matches the bitmap. So use it first. For other GFS versions, use LAND. +! Mask in grib file is '1' (land), '0' (not land). Add sea/lake ice category +! '2' based on ice concentration. +!---------------------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ LANDSEA MASK." + rc = grb2_inq(the_file, inv_file, ':LANDN:',':surface:', data2=dummy2d) + + if (rc /= 1) then + rc = grb2_inq(the_file, inv_file, ':LAND:',':surface:', data2=dummy2d) + if (rc /= 1) call error_handler("READING LANDSEA MASK.", rc) + endif + + do j = 1, j_input + do i = 1, i_input + if(dummy2d(i,j) < 0.5_esmf_kind_r4) dummy2d(i,j)=0.0_esmf_kind_r4 + if(icec_save(i,j) > 0.15_esmf_kind_r4) then + !if (dummy2d(i,j) == 0.0_esmf_kind_r4) print*, "CONVERTING WATER TO SEA/LAKE ICE AT ", i, j + dummy2d(i,j) = 2.0_esmf_kind_r4 + endif + enddo + enddo + + slmsk_save = nint(dummy2d) + + deallocate(icec_save) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE SKIN TEMPERATURE." + rc = grb2_inq(the_file, inv_file, ':TMP:',':surface:', data2=dummy2d) + if (rc /= 1) call error_handler("READING SEAICE SKIN TEMP.", rc) + print*,'ti ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + +!---------------------------------------------------------------------------------- +! Read snow fields. Zero out at non-land points and undefined points (points +! removed using the bitmap). Program expects depth and liquid equivalent +! in mm. +!---------------------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ SNOW LIQUID EQUIVALENT." + rc = grb2_inq(the_file, inv_file, ':WEASD:',':surface:',':anl:',data2=dummy2d) + if (rc /= 1) then + rc = grb2_inq(the_file, inv_file, ':WEASD:',':surface:','hour fcst:',data2=dummy2d) + if (rc /= 1) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc) + endif + do j = 1, j_input + do i = 1, i_input + if(slmsk_save(i,j) == 0) dummy2d(i,j) = 0.0_esmf_kind_r4 + if(dummy2d(i,j) == grb2_UNDEFINED) dummy2d(i,j) = 0.0_esmf_kind_r4 + enddo + enddo +! print*,'weasd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW DEPTH." + rc = grb2_inq(the_file, inv_file, ':SNOD:',':surface:', data2=dummy2d) + if (rc /= 1) call error_handler("READING SNOW DEPTH.", rc) + where(dummy2d == grb2_UNDEFINED) dummy2d = 0.0_esmf_kind_r4 + dummy2d = dummy2d*1000.0 ! Grib2 files have snow depth in (m), fv3 expects it in mm + where(slmsk_save == 0) dummy2d = 0.0_esmf_kind_r4 +! print*,'snod ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ T2M." + rc = grb2_inq(the_file, inv_file, ':TMP:',':2 m above ground:',data2=dummy2d) + if (rc <= 0) call error_handler("READING T2M.", rc) + + print*,'t2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Q2M." + rc = grb2_inq(the_file, inv_file, ':SPFH:',':2 m above ground:',data2=dummy2d) + if (rc <=0) call error_handler("READING Q2M.", rc) + print*,'q2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SKIN TEMPERATURE." + rc = grb2_inq(the_file, inv_file, ':TMP:',':surface:', data2=dummy2d) + if (rc <= 0 ) call error_handler("READING SKIN TEMPERATURE.", rc) + tsk_save(:,:) = dummy2d + dummy2d_8 = real(dummy2d,esmf_kind_r8) + do j = 1, j_input + do i = 1, i_input + if(slmsk_save(i,j) == 0 .and. dummy2d(i,j) < 271.2) then +! print*,'too cool SST ',i,j,dummy2d(i,j) + dummy2d(i,j) = 271.2 + endif + if(slmsk_save(i,j) == 0 .and. dummy2d(i,j) > 310.) then +! print*,'too hot SST ',i,j,dummy2d(i,j) + dummy2d(i,j) = 310.0 + endif + enddo + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid,real(dummy2d,esmf_kind_r8),rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = 0.0 + + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid,real(dummy2d,esmf_kind_r8), rootpet=0,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + +! Soil type is not available. Set to a large negative fill value. + + dummy2d_8 = -99999.0_esmf_kind_r8 + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Begin variables whose presence in grib2 files varies, but no climatological + ! data is + ! available, so we have to account for values in the varmap table + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if (localpet == 0) then + print*,"- READ SEAICE DEPTH." + vname="hice" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + vname=":ICETK:" + rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) + if (rc <= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//& + " REPLACED WITH CLIMO. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d(:,:) = 0.0_esmf_kind_r4 + endif + endif + dummy2d_8= real(dummy2d,esmf_kind_r8) + print*,'hice ',maxval(dummy2d),minval(dummy2d) + + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TPRCP." + vname="tprcp" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + vname=":TPRCP:" + rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) + if (rc <= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& + " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d(:,:) = 0.0_esmf_kind_r4 + endif + endif + dummy2d_8= real(dummy2d,esmf_kind_r8) + print*,'tprcp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ FFMM." + vname="ffmm" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + vname=":FFMM:" + rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) + if (rc <= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& + " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d(:,:) = 0.0_esmf_kind_r4 + endif + endif + dummy2d_8= real(dummy2d,esmf_kind_r8) + print*,'ffmm ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ USTAR." + vname="fricv" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + vname=":FRICV:" + rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) + if (rc <= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL "//& + "REPLACED WITH CLIMO. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d(:,:) = 0.0_esmf_kind_r4 + endif + endif + dummy2d_8= real(dummy2d,esmf_kind_r8) + print*,'fricv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ F10M." + vname="f10m" + slev=":10 m above ground:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + vname=":F10M:" + rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) + if (rc <= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//& + " BE WRITTEN TO THE INPUT FILE. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d(:,:) = 0.0_esmf_kind_r4 + endif + endif + dummy2d_8= real(dummy2d,esmf_kind_r8) + print*,'f10m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M." + call ESMF_FieldScatter(f10m_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ CANOPY MOISTURE CONTENT." + vname="cnwat" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + vname=":CNWAT:" + rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) + if (rc <= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL"//& + " REPLACED WITH CLIMO. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d(:,:) = 0.0_esmf_kind_r4 + endif + endif + dummy2d_8= real(dummy2d,esmf_kind_r8) + print*,'cnwat ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Z0." + vname="sfcr" + slev=":surface:" + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + vname=":SFCR:" + rc= grb2_inq(the_file, inv_file, vname,slev, data2=dummy2d) + if (rc <= 0) then + call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d) + if (rc==1) then ! missing_var_method == skip or no entry in varmap table + print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//& + " REPLACED WITH CLIMO. SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE." + dummy2d(:,:) = 0.0_esmf_kind_r4 + endif + else + ! Grib files have z0 (m), but fv3 expects z0(cm) + dummy2d(:,:) = dummy2d(:,:)*10.0 + endif + dummy2d_8= real(dummy2d,esmf_kind_r8) + print*,'sfcr ',maxval(dummy2d),minval(dummy2d) + + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid,dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d) + + if (localpet == 0) then + print*,"- READ LIQUID SOIL MOISTURE." + vname = "soill" + vname_file = ":SOILL:" + call read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) !!! NEEDTO HANDLE + !!! SOIL LEVELS + print*,'soill ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TOTAL SOIL MOISTURE." + vname = "soilw" + !vname_file = "var2_2_1_7_0_192" !Some files don't recognize this as soilw,so use + vname_file = "var2_2_1_" ! the var number instead + call read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) + print*,'soilm ',maxval(dummy3d),minval(dummy3d) + endif + +!----------------------------------------------------------------------- +! Vegetation type is not available. However, it is needed to identify +! permanent land ice points. At land ice, the total soil moisture +! is a flag value of '1'. Use this flag as a temporary solution. +!----------------------------------------------------------------------- + + if (localpet == 0) then + dummy2d_8(:,:) = 0.0_esmf_kind_r8 + do j = 1, j_input + do i = 1, i_input + if(slmsk_save(i,j) == 1_esmf_kind_i4 .and. dummy3d(i,j,1) > 0.99) & + dummy2d_8(i,j) = real(veg_type_landice_input,esmf_kind_r8) + enddo + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d_8, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + +!--------------------------------------------------------------------------------- +! At open water (slmsk==0), the soil temperature array is not used and set +! to the filler value of SST. At lake/sea ice points (slmsk=2), the soil +! temperature array holds ice column temperature. That field is not available +! in GFS grib data, so set to a default value. +!--------------------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ SOIL TEMPERATURE." + vname = "soilt" + vname_file = ":TSOIL:" + call read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) + do k=1,lsoil_input + do j = 1, j_input + do i = 1, i_input + if (slmsk_save(i,j) == 0_esmf_kind_i4 ) dummy3d(i,j,k) = tsk_save(i,j) + if (slmsk_save(i,j) == 2_esmf_kind_i4 ) dummy3d(i,j,k) = icet_default + enddo + enddo + enddo + print*,'soilt ',maxval(dummy3d),minval(dummy3d) + + deallocate(tsk_save, slmsk_save) + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + deallocate(dummy3d) + deallocate(dummy2d_8) + + end subroutine read_input_sfc_grib2_file + +!--------------------------------------------------------------------------- +! Read nst data from these netcdf formatted fv3 files: tiled history, +! tiled warm restart, and gaussian history. +!--------------------------------------------------------------------------- + + subroutine read_input_nst_netcdf_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=10) :: field + + integer :: rc, tile + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + + if (localpet == 0) then + allocate(data_one_tile(i_input,j_input)) + else + allocate(data_one_tile(0,0)) + endif + + TILE_LOOP : do tile = 1, num_tiles_input_grid + +! c_d + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='c_d' + else + field='cd' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT C_D" + call ESMF_FieldScatter(c_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! c_0 + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='c_0' + else + field='c0' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT C_0" + call ESMF_FieldScatter(c_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! d_conv + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='d_conv' + else + field='dconv' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT D_CONV." + call ESMF_FieldScatter(d_conv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! dt_cool + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='dt_cool' + else + field='dtcool' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT DT_COOL." + call ESMF_FieldScatter(dt_cool_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! ifd - xu li said initialize to '1'. + + if (localpet == 0) then + data_one_tile = 1.0 + endif + + print*,"- CALL FieldScatter FOR INPUT IFD." + call ESMF_FieldScatter(ifd_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! qrain + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('qrain', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT QRAIN." + call ESMF_FieldScatter(qrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! tref + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tref', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT TREF" + call ESMF_FieldScatter(tref_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! w_d + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='w_d' + else + field='wd' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT W_D" + call ESMF_FieldScatter(w_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! w_0 + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='w_0' + else + field='w0' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT W_0" + call ESMF_FieldScatter(w_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xs + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xs', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XS" + call ESMF_FieldScatter(xs_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xt + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xt', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XT" + call ESMF_FieldScatter(xt_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xu + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xu', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XU" + call ESMF_FieldScatter(xu_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xv + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xv', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XV" + call ESMF_FieldScatter(xv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xz + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xz', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XZ" + call ESMF_FieldScatter(xz_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xtts + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xtts', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XTTS" + call ESMF_FieldScatter(xtts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xzts + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xzts', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XZTS" + call ESMF_FieldScatter(xzts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! z_c + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='z_c' + else + field='zc' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT Z_C" + call ESMF_FieldScatter(z_c_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! zm - Not used yet. Xu li said set to '0'. + + if (localpet == 0) then + data_one_tile = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT ZM" + call ESMF_FieldScatter(zm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo TILE_LOOP + + deallocate(data_one_tile) + + end subroutine read_input_nst_netcdf_file + +!-------------------------------------------------------------------------- +! Read input grid nst data from fv3 gaussian nemsio history file or +! spectral GFS nemsio file. The spectral GFS nst data is in a separate +! file from the surface data. The fv3 surface and nst data are in a +! single file. +!-------------------------------------------------------------------------- + + subroutine read_input_nst_nemsio_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer :: rc + + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + + type(nemsio_gfile) :: gfile + + if (trim(input_type) == "gfs_gaussian_nemsio") then ! spectral gfs nemsio in + ! separate file. + the_file = trim(data_dir_input_grid) // "/" // trim(nst_files_input_grid) + else + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + endif + + print*,"- READ NST DATA FROM: ", trim(the_file) + + if (localpet == 0) then + allocate(dummy(i_input*j_input)) + allocate(dummy2d(i_input,j_input)) + call nemsio_open(gfile, the_file, "read", iret=rc) + else + allocate(dummy(0)) + allocate(dummy2d(0,0)) + endif + + if (localpet == 0) then + print*,"- READ TREF" + call nemsio_readrecv(gfile, "tref", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TREF.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tref ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT TREF." + call ESMF_FieldScatter(tref_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ CD" + call nemsio_readrecv(gfile, "cd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING CD.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'cd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT C_D." + call ESMF_FieldScatter(c_d_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ C0" + call nemsio_readrecv(gfile, "c0", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING C0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'c0 ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT C_0." + call ESMF_FieldScatter(c_0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DCONV" + call nemsio_readrecv(gfile, "dconv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING DCONV.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'dconv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT D_CONV." + call ESMF_FieldScatter(d_conv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DTCOOL" + call nemsio_readrecv(gfile, "dtcool", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING DTCOOL.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'dtcool ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT DT_COOL." + call ESMF_FieldScatter(dt_cool_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + dummy2d = 1.0 ! IFD not in file. Set to '1' per Xu Li. + endif + + print*,"- CALL FieldScatter FOR INPUT IFD." + call ESMF_FieldScatter(ifd_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ QRAIN" + call nemsio_readrecv(gfile, "qrain", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING QRAIN.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'qrain ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT QRAIN." + call ESMF_FieldScatter(qrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ WD" + call nemsio_readrecv(gfile, "wd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING WD.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'wd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT WD." + call ESMF_FieldScatter(w_d_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ W0" + call nemsio_readrecv(gfile, "w0", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING W0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'w0 ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT W0." + call ESMF_FieldScatter(w_0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XS" + call nemsio_readrecv(gfile, "xs", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XS.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xs ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XS." + call ESMF_FieldScatter(xs_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XT" + call nemsio_readrecv(gfile, "xt", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xt ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XT." + call ESMF_FieldScatter(xt_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XU" + call nemsio_readrecv(gfile, "xu", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XU.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xu ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XU." + call ESMF_FieldScatter(xu_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XV" + call nemsio_readrecv(gfile, "xv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XV.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XV." + call ESMF_FieldScatter(xv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XZ" + call nemsio_readrecv(gfile, "xz", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XZ.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xz ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XZ." + call ESMF_FieldScatter(xz_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XTTS" + call nemsio_readrecv(gfile, "xtts", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XTTS.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xtts ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XTTS." + call ESMF_FieldScatter(xtts_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XZTS" + call nemsio_readrecv(gfile, "xzts", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XZTS.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xzts ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XZTS." + call ESMF_FieldScatter(xzts_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ ZC" + call nemsio_readrecv(gfile, "zc", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING ZC.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'zc ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT Z_C." + call ESMF_FieldScatter(z_c_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + dummy2d = 0.0 ! zm not used yet. Set to zero per Xu Li. + endif + + print*,"- CALL FieldScatter FOR INPUT ZM." + call ESMF_FieldScatter(zm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy, dummy2d) + + if (localpet == 0) call nemsio_close(gfile) + + end subroutine read_input_nst_nemsio_file + + SUBROUTINE READ_FV3_GRID_DATA_NETCDF(FIELD,TILE_NUM,IMO,JMO,LMO, & + SFCDATA, SFCDATA_3D) + + IMPLICIT NONE + + CHARACTER(LEN=*),INTENT(IN) :: FIELD + + INTEGER, INTENT(IN) :: IMO, JMO, LMO, TILE_NUM + + REAL(ESMF_KIND_R8), INTENT(OUT), OPTIONAL :: SFCDATA(IMO,JMO) + REAL(ESMF_KIND_R8), INTENT(OUT), OPTIONAL :: SFCDATA_3D(IMO,JMO,LMO) + + CHARACTER(LEN=256) :: TILEFILE + + INTEGER :: ERROR, NCID, ID_VAR + + TILEFILE = TRIM(DATA_DIR_INPUT_GRID) // "/" // TRIM(SFC_FILES_INPUT_GRID(TILE_NUM)) + + PRINT*,'WILL READ ',TRIM(FIELD), ' FROM: ', TRIM(TILEFILE) + + ERROR=NF90_OPEN(TRIM(TILEFILE),NF90_NOWRITE,NCID) + CALL NETCDF_ERR(ERROR, 'OPENING: '//TRIM(TILEFILE) ) + + ERROR=NF90_INQ_VARID(NCID, FIELD, ID_VAR) + CALL NETCDF_ERR(ERROR, 'READING FIELD ID' ) + + IF (PRESENT(SFCDATA_3D)) THEN + ERROR=NF90_GET_VAR(NCID, ID_VAR, SFCDATA_3D) + CALL NETCDF_ERR(ERROR, 'READING FIELD' ) + ELSE + ERROR=NF90_GET_VAR(NCID, ID_VAR, SFCDATA) + CALL NETCDF_ERR(ERROR, 'READING FIELD' ) + ENDIF + + ERROR = NF90_CLOSE(NCID) + + END SUBROUTINE READ_FV3_GRID_DATA_NETCDF + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d winds. +!--------------------------------------------------------------------------- + + subroutine convert_winds + + implicit none + + integer :: clb(4), cub(4) + integer :: i, j, k, rc + + real(esmf_kind_r8) :: latrad, lonrad + real(esmf_kind_r8), pointer :: windptr(:,:,:,:) + real(esmf_kind_r8), pointer :: uptr(:,:,:) + real(esmf_kind_r8), pointer :: vptr(:,:,:) + real(esmf_kind_r8), pointer :: latptr(:,:) + real(esmf_kind_r8), pointer :: lonptr(:,:) + + print*,"- CALL FieldGet FOR 3-D WIND." + call ESMF_FieldGet(wind_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=windptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR U." + call ESMF_FieldGet(u_input_grid, & + farrayPtr=uptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR V." + call ESMF_FieldGet(v_input_grid, & + farrayPtr=vptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LATITUDE." + call ESMF_FieldGet(latitude_input_grid, & + farrayPtr=latptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LONGITUDE." + call ESMF_FieldGet(longitude_input_grid, & + farrayPtr=lonptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + latrad = latptr(i,j) * acos(-1.) / 180.0 + lonrad = lonptr(i,j) * acos(-1.) / 180.0 + do k = clb(3), cub(3) + windptr(i,j,k,1) = uptr(i,j,k) * cos(lonrad) - vptr(i,j,k) * sin(latrad) * sin(lonrad) + windptr(i,j,k,2) = uptr(i,j,k) * sin(lonrad) + vptr(i,j,k) * sin(latrad) * cos(lonrad) + windptr(i,j,k,3) = vptr(i,j,k) * cos(latrad) + enddo + enddo + enddo + + call ESMF_FieldDestroy(u_input_grid, rc=rc) + call ESMF_FieldDestroy(v_input_grid, rc=rc) + + end subroutine convert_winds + +subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d) + + use, intrinsic :: ieee_arithmetic + + implicit none + + real(esmf_kind_r4), intent(in) :: value + real(esmf_kind_r4), intent(inout), optional :: var(:,:) + real(esmf_kind_r8), intent(inout), optional :: var8(:,:) + real(esmf_kind_r8), intent(inout), optional :: var3d(:,:,:) + + character(len=20), intent(in) :: vname, lev, method + + integer, intent(in) :: varnum + integer, intent(inout) :: iret + + iret = 0 + if (varnum == 9999) then + print*, "WARNING: ", trim(vname), " NOT FOUND AT LEVEL ", lev, " IN EXTERNAL FILE ", & + "AND NO ENTRY EXISTS IN VARMAP TABLE. VARIABLE WILL NOT BE USED." + iret = 1 + + return + endif + + if (trim(method) == "skip" ) then + print*, "WARNING: SKIPPING ", trim(vname), " IN FILE" + read_from_input(varnum) = .false. + iret = 1 + elseif (trim(method) == "set_to_fill") then + print*, "WARNING: ,", trim(vname), " NOT AVILABLE AT LEVEL ", trim(lev), & + ". SETTING EQUAL TO FILL VALUE OF ", value + if(present(var)) var(:,:) = value + if(present(var8)) var8(:,:) = value + if(present(var3d)) var3d(:,:,:) = value + elseif (trim(method) == "set_to_NaN") then + print*, "WARNING: ,", trim(vname), " NOT AVILABLE AT LEVEL ", trim(lev), & + ". SETTING EQUAL TO NaNs" + if(present(var)) var(:,:) = ieee_value(var,IEEE_QUIET_NAN) + if(present(var8)) var8(:,:) = ieee_value(var8,IEEE_QUIET_NAN) + if(present(var3d)) var3d(:,:,:) = ieee_value(var3d,IEEE_QUIET_NAN) + elseif (trim(method) == "stop") then + call error_handler("READING "//trim(vname)// " at level "//lev//". TO MAKE THIS NON- & + FATAL, CHANGE STOP TO SKIP FOR THIS VARIABLE IN YOUR VARMAP & + FILE.", iret) + else + call error_handler("ERROR USING MISSING_VAR_METHOD. PLEASE SET VALUES IN" // & + " VARMAP TABLE TO ONE OF: set_to_fill, set_to_NaN,"// & + " , skip, or stop.", 1) + endif + +end subroutine handle_grib_error + +subroutine read_grib_soil(the_file,inv_file,vname,vname_file,dummy3d,rc) + + use wgrib2api + implicit none + + character(len=*), intent(in) :: the_file, inv_file + character(len=20), intent(in) :: vname,vname_file + + integer, intent(out) :: rc + + real(esmf_kind_r8), intent(inout) :: dummy3d(:,:,:) + + real(esmf_kind_r4), allocatable :: dummy2d(:,:) + real(esmf_kind_r4) :: value + integer :: varnum,i + character(len=50) :: slevs(lsoil_input) + character(len=50) :: method + + allocate(dummy2d(i_input,j_input)) + + if(lsoil_input == 4) then + slevs = (/character(24)::':0-0.1 m below ground:', ':0.1-0.4 m below ground:', & + ':0.4-1 m below ground:', ':1-2 m below ground:'/) + else + rc = -1 + call error_handler("reading soil levels. File must have 4 soil levels.", rc) + endif + + call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, & + loc=varnum) + do i = 1,lsoil_input + if (vname_file=="var2_2_1_") then + rc = grb2_inq(the_file,inv_file,vname_file,"_0_192:",slevs(i),data2=dummy2d) + else + rc = grb2_inq(the_file,inv_file,vname_file,slevs(i),data2=dummy2d) + endif + if (rc <= 0) then + call handle_grib_error(vname_file, slevs(i),method,value,varnum,rc,var=dummy2d) + if (rc==1 .and. trim(vname) /= "soill") then + ! missing_var_method == skip or no entry in varmap table + call error_handler("READING IN "//trim(vname)//". SET A FILL "// & + "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",rc) + elseif (rc==1) then + dummy3d(:,:,:) = 0.0_esmf_kind_r8 + exit + endif + endif + + dummy3d(:,:,i) = real(dummy2d,esmf_kind_r8) + end do + + deallocate(dummy2d) + + end subroutine read_grib_soil + + subroutine cleanup_input_atm_data + + implicit none + + integer :: rc, n + + print*,'- DESTROY ATMOSPHERIC INPUT DATA.' + + call ESMF_FieldDestroy(terrain_input_grid, rc=rc) + call ESMF_FieldDestroy(pres_input_grid, rc=rc) + call ESMF_FieldDestroy(dzdt_input_grid, rc=rc) + call ESMF_FieldDestroy(temp_input_grid, rc=rc) + call ESMF_FieldDestroy(wind_input_grid, rc=rc) + call ESMF_FieldDestroy(ps_input_grid, rc=rc) + + do n = 1, num_tracers + call ESMF_FieldDestroy(tracers_input_grid(n), rc=rc) + enddo + deallocate(tracers_input_grid) + + end subroutine cleanup_input_atm_data + + subroutine cleanup_input_nst_data + + implicit none + + integer :: rc + + print*,'- DESTROY NST INPUT DATA.' + + call ESMF_FieldDestroy(landsea_mask_input_grid, rc=rc) + call ESMF_FieldDestroy(c_d_input_grid, rc=rc) + call ESMF_FieldDestroy(c_0_input_grid, rc=rc) + call ESMF_FieldDestroy(d_conv_input_grid, rc=rc) + call ESMF_FieldDestroy(dt_cool_input_grid, rc=rc) + call ESMF_FieldDestroy(ifd_input_grid, rc=rc) + call ESMF_FieldDestroy(qrain_input_grid, rc=rc) + call ESMF_FieldDestroy(tref_input_grid, rc=rc) + call ESMF_FieldDestroy(w_d_input_grid, rc=rc) + call ESMF_FieldDestroy(w_0_input_grid, rc=rc) + call ESMF_FieldDestroy(xs_input_grid, rc=rc) + call ESMF_FieldDestroy(xt_input_grid, rc=rc) + call ESMF_FieldDestroy(xu_input_grid, rc=rc) + call ESMF_FieldDestroy(xv_input_grid, rc=rc) + call ESMF_FieldDestroy(xz_input_grid, rc=rc) + call ESMF_FieldDestroy(xtts_input_grid, rc=rc) + call ESMF_FieldDestroy(xzts_input_grid, rc=rc) + call ESMF_FieldDestroy(z_c_input_grid, rc=rc) + call ESMF_FieldDestroy(zm_input_grid, rc=rc) + + end subroutine cleanup_input_nst_data + + subroutine cleanup_input_sfc_data + + implicit none + + integer :: rc + + print*,"- CALL FieldDestroy FOR INPUT GRID FIELDS." + + call ESMF_FieldDestroy(canopy_mc_input_grid, rc=rc) + call ESMF_FieldDestroy(f10m_input_grid, rc=rc) + call ESMF_FieldDestroy(ffmm_input_grid, rc=rc) + if (.not. convert_nst) then + call ESMF_FieldDestroy(landsea_mask_input_grid, rc=rc) + endif + call ESMF_FieldDestroy(q2m_input_grid, rc=rc) + call ESMF_FieldDestroy(seaice_depth_input_grid, rc=rc) + call ESMF_FieldDestroy(seaice_fract_input_grid, rc=rc) + call ESMF_FieldDestroy(seaice_skin_temp_input_grid, rc=rc) + call ESMF_FieldDestroy(skin_temp_input_grid, rc=rc) + call ESMF_FieldDestroy(snow_depth_input_grid, rc=rc) + call ESMF_FieldDestroy(snow_liq_equiv_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_temp_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_type_input_grid, rc=rc) + call ESMF_FieldDestroy(soilm_liq_input_grid, rc=rc) + call ESMF_FieldDestroy(soilm_tot_input_grid, rc=rc) + call ESMF_FieldDestroy(srflag_input_grid, rc=rc) + call ESMF_FieldDestroy(t2m_input_grid, rc=rc) + call ESMF_FieldDestroy(tprcp_input_grid, rc=rc) + call ESMF_FieldDestroy(ustar_input_grid, rc=rc) + call ESMF_FieldDestroy(veg_type_input_grid, rc=rc) + call ESMF_FieldDestroy(z0_input_grid, rc=rc) + call ESMF_FieldDestroy(terrain_input_grid, rc=rc) + + end subroutine cleanup_input_sfc_data + +! Jili Dong add sort subroutine +! quicksort.f -*-f90-*- +! Author: t-nissie +! License: GPLv3 +! Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea +!! +recursive subroutine quicksort(a, first, last) + implicit none + real*8 a(*), x, t + integer first, last + integer i, j + + x = a( (first+last) / 2 ) + i = first + j = last + do + do while (a(i) < x) + i=i+1 + end do + do while (x < a(j)) + j=j-1 + end do + if (i >= j) exit + t = a(i); a(i) = a(j); a(j) = t + i=i+1 + j=j-1 + end do + if (first < i-1) call quicksort(a, first, i-1) + if (j+1 < last) call quicksort(a, j+1, last) +end subroutine quicksort + + end module input_data diff --git a/sorc/coldstart.fd/model_grid.F90 b/sorc/coldstart.fd/model_grid.F90 new file mode 100644 index 000000000..84e84a7a3 --- /dev/null +++ b/sorc/coldstart.fd/model_grid.F90 @@ -0,0 +1,1306 @@ + module model_grid + +!-------------------------------------------------------------------------- +! Module model_grid +! +! Abstract: Specify input and target model grids +! +! Public Subroutines: +! ------------------- +! define_target_grid Setup the esmf grid object for the +! target grid. +! define_input_grid Setup the esmf grid object for the +! input grid. +! cleanup_input_target_grid_data Deallocate all esmf grid objects. +! +! Public variables: +! ----------------- +! i/j_input i/j dimension of each cube of the +! input grid. +! ip1/jp1_input i/j dimension plus 1 of input grid. +! i/j_target i/j dimension of each cube or of +! a nest, target grid. +! ip1/jp1_target i/j dimension plus 1 of input grid. +! input_grid input grid esmf grid object +! landmask_target_grid land mask target grid - '1' land; +! '0' non-land +! latitude_input_grid latitude of grid center, input grid +! latitude_target_grid latitude of grid center, target grid +! latitude_s_input_grid latitude of 'south' edge of grid +! box, input grid +! latitude_s_target_grid latitude of 'south' edge of grid +! box, target grid +! latitude_w_input_grid latitude of 'west' edge of grid +! box, input grid +! latitude_w_target_grid latitude of 'west' edge of grid +! box, target grid +! longitude_input_grid longitude of grid center, input grid +! longitude_target_grid longitude of grid center, target grid +! longitude_s_input_grid longitude of 'south' edge of grid +! box, input grid +! longitude_s_target_grid longitude of 'south' edge of grid +! box, target grid +! longitude_w_input_grid longitude of 'west' edge of grid +! box, input grid +! longitude_w_target_grid longitude of 'west' edge of grid +! box, target grid +! lsoil_target Number of soil layers, target grid. +! num_tiles_input_grid Number of tiles, input grid +! num_tiles_target_grid Number of tiles, target grid +! seamask_target_grid sea mask target grid - '1' non-land; +! '0' land +! target_grid target grid esmf grid object. +! terrain_target_grid terrain height target grid +! tiles_target_grid Tile names of target grid. +! +!-------------------------------------------------------------------------- + + use esmf + + implicit none + + private + + character(len=5), allocatable, public :: tiles_target_grid(:) + character(len=10), public :: inv_file = "chgres.inv" + + integer, parameter, public :: lsoil_target = 4 ! # soil layers + integer, public :: i_input, j_input + integer, public :: ip1_input, jp1_input + integer, public :: i_target, j_target + integer, public :: ip1_target, jp1_target + integer, public :: num_tiles_input_grid + integer, public :: num_tiles_target_grid + + type(esmf_grid), public :: input_grid + type(esmf_grid), public :: target_grid + + type(esmf_field), public :: latitude_input_grid + type(esmf_field), public :: longitude_input_grid + type(esmf_field), public :: latitude_s_input_grid + type(esmf_field), public :: longitude_s_input_grid + type(esmf_field), public :: latitude_w_input_grid + type(esmf_field), public :: longitude_w_input_grid + + type(esmf_field), public :: landmask_target_grid + type(esmf_field), public :: latitude_target_grid + type(esmf_field), public :: latitude_s_target_grid + type(esmf_field), public :: latitude_w_target_grid + type(esmf_field), public :: longitude_target_grid + type(esmf_field), public :: longitude_s_target_grid + type(esmf_field), public :: longitude_w_target_grid + type(esmf_field), public :: seamask_target_grid + type(esmf_field), public :: terrain_target_grid + + public :: define_target_grid + public :: define_input_grid + public :: cleanup_input_target_grid_data + + contains + +!-------------------------------------------------------------------------- +! Set up the esmf grid object for the input grid. If the input +! source is tiled fv3 restart or history data, the grid is created +! by reading the mosaic and grid files. If the input source is +! fv3 global gaussian nemsio, spectral gfs global gaussian nemsio, or +! spectral gfs global gaussian sigio/sfcio, the grid is setup by +! computing lat/lons using the sp library. +!-------------------------------------------------------------------------- + + subroutine define_input_grid(localpet, npets) + + use program_setup, only : input_type + + implicit none + + integer, intent(in) :: localpet, npets + + if (trim(input_type) == "gaussian_nemsio" .or. & + trim(input_type) == "gfs_gaussian_nemsio" .or. & + trim(input_type) == "gfs_sigio" .or. & + trim(input_type) == "gaussian_netcdf") then + call define_input_grid_gaussian(localpet, npets) + elseif (trim(input_type) == "grib2") then + call define_input_grid_gfs_grib2(localpet,npets) + else + call define_input_grid_mosaic(localpet, npets) + endif + + end subroutine define_input_grid + +!-------------------------------------------------------------------------- +! Define grid object for input data on global gaussian grids. +! Recognized file formats: +! +! - fv3gfs nemsio +! - spectral gfs nemsio (starting July 19, 2017) +! - spectral gfs sigio (prior to July 19, 2017) +! - spectral gfs sfcio (prior to July 19, 2017) +!-------------------------------------------------------------------------- + + subroutine define_input_grid_gaussian(localpet, npets) + + use nemsio_module + + use program_setup, only : data_dir_input_grid, & + atm_files_input_grid, & + sfc_files_input_grid, & + input_type, & + convert_atm, convert_sfc + + use sfcio_module + use sigio_module + use netcdf + + implicit none + + integer, intent(in) :: localpet, npets + + character(len=250) :: the_file + + integer :: i, j, rc, clb(2), cub(2), ncid, id_grid + integer(sfcio_intkind) :: rc2 + integer(sigio_intkind) :: rc3 + + real(esmf_kind_r8), allocatable :: latitude(:,:) + real(esmf_kind_r8), allocatable :: longitude(:,:) + real(esmf_kind_r8), pointer :: lat_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lon_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lat_corner_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lon_corner_src_ptr(:,:) + real(esmf_kind_r8) :: deltalon + real(esmf_kind_r8), allocatable :: slat(:), wlat(:) + + type(nemsio_gfile) :: gfile + type(esmf_polekind_flag) :: polekindflag(2) + type(sfcio_head) :: sfchead + type(sigio_head) :: sighead + + print*,"- DEFINE INPUT GRID OBJECT FOR GAUSSIAN DATA." + + num_tiles_input_grid = 1 + + if (convert_sfc) then + the_file=trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + elseif (convert_atm) then + the_file=trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + endif + + if (trim(input_type) == "gfs_sigio") then ! sigio/sfcio format, used by + ! spectral gfs prior to 7/19/2017. + + if (convert_sfc) then ! sfcio format + print*,"- OPEN AND READ ", trim(the_file) + call sfcio_sropen(21, trim(the_file), rc2) + if (rc2 /= 0) call error_handler("OPENING FILE", rc2) + call sfcio_srhead(21, sfchead, rc2) + if (rc2 /= 0) call error_handler("READING FILE", rc2) + call sfcio_sclose(21, rc2) + i_input = sfchead%lonb + j_input = sfchead%latb + elseif (convert_atm) then ! sigio format + print*,"- OPEN AND READ ", trim(the_file) + call sigio_sropen(21, trim(the_file), rc3) + if (rc3 /= 0) call error_handler("OPENING FILE", rc3) + call sigio_srhead(21, sighead, rc3) + if (rc3 /= 0) call error_handler("READING FILE", rc3) + call sigio_sclose(21, rc3) + i_input = sighead%lonb + j_input = sighead%latb + endif + + elseif (trim(input_type) == "gaussian_netcdf") then + + print*,'- OPEN AND READ: ',trim(the_file) + rc=nf90_open(trim(the_file),nf90_nowrite,ncid) + call netcdf_err(rc, 'opening file') + + print*,"- READ grid_xt" + rc=nf90_inq_dimid(ncid, 'grid_xt', id_grid) + call netcdf_err(rc, 'reading grid_xt id') + rc=nf90_inquire_dimension(ncid,id_grid,len=i_input) + call netcdf_err(rc, 'reading grid_xt') + + print*,"- READ grid_yt" + rc=nf90_inq_dimid(ncid, 'grid_yt', id_grid) + call netcdf_err(rc, 'reading grid_yt id') + rc=nf90_inquire_dimension(ncid,id_grid,len=j_input) + call netcdf_err(rc, 'reading grid_yt') + + rc = nf90_close(ncid) + + else ! nemsio format + + call nemsio_init(iret=rc) + + print*,"- OPEN AND READ ", trim(the_file) + call nemsio_open(gfile, the_file, "read", iret=rc) + if (rc /= 0) call error_handler("OPENING FILE", rc) + + call nemsio_getfilehead(gfile, iret=rc, dimx=i_input, dimy=j_input) + if (rc /= 0) call error_handler("READING FILE", rc) + + call nemsio_close(gfile) + + endif + + ip1_input = i_input + 1 + jp1_input = j_input + 1 + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + + print*,"- CALL GridCreate1PeriDim FOR INPUT GRID." + input_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/i_input,j_input/), & + polekindflag=polekindflag, & + periodicDim=1, & + poleDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + regDecomp=(/1,npets/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridCreate1PeriDim", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE." + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE." + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + allocate(longitude(i_input,j_input)) + allocate(latitude(i_input,j_input)) + + deltalon = 360.0_esmf_kind_r8 / real(i_input,kind=esmf_kind_r8) + do i = 1, i_input + longitude(i,:) = real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + allocate(slat(j_input)) + allocate(wlat(j_input)) + call splat(4, j_input, slat, wlat) + + do i = 1, j_input + latitude(:,i) = 90.0_esmf_kind_r8 - (acos(slat(i))* 180.0_esmf_kind_r8 / & + (4.0_esmf_kind_r8*atan(1.0_esmf_kind_r8))) + enddo + + deallocate(slat, wlat) + + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE." + call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE." + call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL GridAddCoord FOR INPUT GRID." + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridAddCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." + nullify(lon_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + nullify(lat_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_src_ptr(i,j) = longitude(i,j) + if (lon_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_src_ptr(i,j) = lon_src_ptr(i,j) - 360.0_esmf_kind_r8 + lat_src_ptr(i,j) = latitude(i,j) + enddo + enddo + + print*,"- CALL GridAddCoord FOR INPUT GRID." + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CORNER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridAddCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." + nullify(lon_corner_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CORNER, & + coordDim=1, & + farrayPtr=lon_corner_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + nullify(lat_corner_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CORNER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_corner_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + print*,'bounds for corners ',localpet,clb(1),cub(1),clb(2),cub(2) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_corner_src_ptr(i,j) = longitude(i,1) - (0.5_esmf_kind_r8*deltalon) + if (lon_corner_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_corner_src_ptr(i,j) = lon_corner_src_ptr(i,j) - 360.0_esmf_kind_r8 + if (j == 1) then + lat_corner_src_ptr(i,j) = 90.0_esmf_kind_r8 + cycle + endif + if (j == jp1_input) then + lat_corner_src_ptr(i,j) = -90.0_esmf_kind_r8 + cycle + endif + lat_corner_src_ptr(i,j) = 0.5_esmf_kind_r8 * (latitude(i,j-1)+ latitude(i,j)) + enddo + enddo + + deallocate(latitude,longitude) + + end subroutine define_input_grid_gaussian + + subroutine define_input_grid_mosaic(localpet, npets) + + use netcdf + use program_setup, only : mosaic_file_input_grid, & + orog_dir_input_grid, & + orog_files_input_grid + + implicit none + + character(len=500) :: the_file + + integer, intent(in) :: localpet, npets + + integer :: id_tiles, id_dim, tile + integer :: extra, error, ncid + integer, allocatable :: decomptile(:,:) + + integer(esmf_kind_i8), allocatable :: landmask_one_tile(:,:) + + real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_w_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_w_one_tile(:,:) + + print*,'- OPEN INPUT GRID MOSAIC FILE: ',trim(mosaic_file_input_grid) + error=nf90_open(trim(mosaic_file_input_grid),nf90_nowrite,ncid) + call netcdf_err(error, 'opening grid mosaic file') + + print*,"- READ NUMBER OF TILES" + error=nf90_inq_dimid(ncid, 'ntiles', id_tiles) + call netcdf_err(error, 'reading ntiles id') + error=nf90_inquire_dimension(ncid,id_tiles,len=num_tiles_input_grid) + call netcdf_err(error, 'reading ntiles') + + error = nf90_close(ncid) + + print*,'- NUMBER OF TILES, INPUT MODEL GRID IS ', num_tiles_input_grid + + if (mod(npets,num_tiles_input_grid) /= 0) then + call error_handler("MUST RUN WITH A TASK COUNT THAT IS A MULTIPLE OF 6.", 1) + endif + +!----------------------------------------------------------------------- +! Create ESMF grid object for the model grid. +!----------------------------------------------------------------------- + + extra = npets / num_tiles_input_grid + + allocate(decomptile(2,num_tiles_input_grid)) + + do tile = 1, num_tiles_input_grid + decomptile(:,tile)=(/1,extra/) + enddo + + print*,"- CALL GridCreateMosaic FOR INPUT MODEL GRID" + input_grid = ESMF_GridCreateMosaic(filename=trim(mosaic_file_input_grid), & + regDecompPTile=decomptile, & + staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER, & + ESMF_STAGGERLOC_EDGE1, ESMF_STAGGERLOC_EDGE2/), & + indexflag=ESMF_INDEX_GLOBAL, & + tileFilePath=trim(orog_dir_input_grid), & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridCreateMosaic", error) + +!----------------------------------------------------------------------- +! Read the mask and lat/lons. +!----------------------------------------------------------------------- + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE." + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE." + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE_S." + latitude_s_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="input_grid_latitude_s", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE_S." + longitude_s_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="input_grid_longitude_s", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE_W." + latitude_w_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="input_grid_latitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE_W." + longitude_w_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="input_grid_longitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + the_file = trim(orog_dir_input_grid) // trim(orog_files_input_grid(1)) + + print*,'- OPEN FIRST INPUT GRID OROGRAPHY FILE: ',trim(the_file) + error=nf90_open(trim(the_file),nf90_nowrite,ncid) + call netcdf_err(error, 'opening ororgraphy file') + print*,"- READ GRID DIMENSIONS" + error=nf90_inq_dimid(ncid, 'lon', id_dim) + call netcdf_err(error, 'reading lon id') + error=nf90_inquire_dimension(ncid,id_dim,len=i_input) + call netcdf_err(error, 'reading lon') + error=nf90_inq_dimid(ncid, 'lat', id_dim) + call netcdf_err(error, 'reading lat id') + error=nf90_inquire_dimension(ncid,id_dim,len=j_input) + call netcdf_err(error, 'reading lat') + error = nf90_close(ncid) + + print*,"- I/J DIMENSIONS OF THE INPUT GRID TILES ", i_input, j_input + + ip1_input = i_input + 1 + jp1_input = j_input + 1 + + if (localpet == 0) then + allocate(longitude_one_tile(i_input,j_input)) + allocate(longitude_s_one_tile(i_input,jp1_input)) + allocate(longitude_w_one_tile(ip1_input,j_input)) + allocate(latitude_one_tile(i_input,j_input)) + allocate(latitude_s_one_tile(i_input,jp1_input)) + allocate(latitude_w_one_tile(ip1_input,j_input)) + allocate(landmask_one_tile(i_input,j_input)) + else + allocate(longitude_one_tile(0,0)) + allocate(longitude_s_one_tile(0,0)) + allocate(longitude_w_one_tile(0,0)) + allocate(latitude_one_tile(0,0)) + allocate(latitude_s_one_tile(0,0)) + allocate(latitude_w_one_tile(0,0)) + allocate(landmask_one_tile(0,0)) + endif + + do tile = 1, num_tiles_input_grid + if (localpet == 0) then + call get_model_latlons(mosaic_file_input_grid, orog_dir_input_grid, num_tiles_input_grid, tile, & + i_input, j_input, ip1_input, jp1_input, latitude_one_tile, & + latitude_s_one_tile, latitude_w_one_tile, longitude_one_tile, & + longitude_s_one_tile, longitude_w_one_tile) + endif + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE. TILE IS: ", tile + call ESMF_FieldScatter(latitude_input_grid, latitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE. TILE IS: ", tile + call ESMF_FieldScatter(longitude_input_grid, longitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(latitude_s_input_grid, latitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(longitude_s_input_grid, longitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(latitude_w_input_grid, latitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(longitude_w_input_grid, longitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(longitude_one_tile) + deallocate(longitude_s_one_tile) + deallocate(longitude_w_one_tile) + deallocate(latitude_one_tile) + deallocate(latitude_s_one_tile) + deallocate(latitude_w_one_tile) + deallocate(landmask_one_tile) + + end subroutine define_input_grid_mosaic + +!-------------------------------------------------------------------------- +! Define grid object for GFS grib2 data. Only works for data on +! global lat/lon or gaussian grids. +!-------------------------------------------------------------------------- + + subroutine define_input_grid_gfs_grib2(localpet, npets) + + use mpi + + use wgrib2api + + use program_setup, only : data_dir_input_grid, & + grib2_file_input_grid + + implicit none + + integer, intent(in) :: localpet, npets + + character(len=250) :: the_file + + integer :: i, j, rc, clb(2), cub(2), ierr + + real(esmf_kind_r8), allocatable :: latitude(:,:) + real(esmf_kind_r8), allocatable :: longitude(:,:) + real(esmf_kind_r4), allocatable :: lat4(:,:), lon4(:,:) + real(esmf_kind_r8), pointer :: lat_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lon_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lat_corner_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lon_corner_src_ptr(:,:) + real(esmf_kind_r8) :: deltalon + + type(esmf_polekind_flag) :: polekindflag(2) + + print*,"- DEFINE INPUT GRID OBJECT FOR INPUT GRIB2 DATA." + + num_tiles_input_grid = 1 + + the_file = trim(data_dir_input_grid) // "/" // grib2_file_input_grid + if(localpet == 0) then + print*,'- OPEN AND INVENTORY GRIB2 FILE: ',trim(the_file) + rc=grb2_mk_inv(the_file,inv_file) + if (rc /=0) call error_handler("OPENING GRIB2 FILE",rc) + endif + +! Wait for localpet 0 to create inventory. + call mpi_barrier(mpi_comm_world, ierr) + + rc = grb2_inq(the_file,inv_file,':PRES:',':surface:',nx=i_input, ny=j_input, & + lat=lat4, lon=lon4) + if (rc /= 1) call error_handler("READING GRIB2 FILE", rc) + + ip1_input = i_input + 1 + jp1_input = j_input + 1 + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + + print*,"- CALL GridCreate1PeriDim FOR INPUT GRID." + input_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/i_input,j_input/), & + polekindflag=polekindflag, & + periodicDim=1, & + poleDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + regDecomp=(/1,npets/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridCreate1PeriDim", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE." + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE." + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + allocate(longitude(i_input,j_input)) + allocate(latitude(i_input,j_input)) + + do i = 1, i_input + longitude(i,:) = real(lon4(i,:),kind=esmf_kind_r8) + enddo + + do i = 1, j_input + latitude(:,i) = real(lat4(:,i),kind=esmf_kind_r8) + enddo + + deallocate(lat4, lon4) + + deltalon = abs(longitude(2,1)-longitude(1,1)) + if(localpet==0) print*, "deltalon = ", deltalon + + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE." + call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE." + call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL GridAddCoord FOR INPUT GRID." + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridAddCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." + nullify(lon_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + nullify(lat_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_src_ptr(i,j) = longitude(i,j) + if (lon_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_src_ptr(i,j) = lon_src_ptr(i,j) - 360.0_esmf_kind_r8 + lat_src_ptr(i,j) = latitude(i,j) + enddo + enddo + + if(localpet==0) print*, "lon first = ", lon_src_ptr(1:10,1) + if(localpet==0) print*, "lat first = ", lat_src_ptr(1,1:10) + + print*,"- CALL GridAddCoord FOR INPUT GRID." + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CORNER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridAddCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." + nullify(lon_corner_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CORNER, & + coordDim=1, & + farrayPtr=lon_corner_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + nullify(lat_corner_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CORNER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_corner_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_corner_src_ptr(i,j) = longitude(i,1) - (0.5_esmf_kind_r8*deltalon) + if (lon_corner_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_corner_src_ptr(i,j) = lon_corner_src_ptr(i,j) - 360.0_esmf_kind_r8 + if (j == 1) then + lat_corner_src_ptr(i,j) = -90.0_esmf_kind_r8 + cycle + endif + if (j == jp1_input) then + lat_corner_src_ptr(i,j) = +90.0_esmf_kind_r8 + cycle + endif + lat_corner_src_ptr(i,j) = 0.5_esmf_kind_r8 * (latitude(i,j-1)+ latitude(i,j)) + enddo + enddo + + deallocate(latitude,longitude) + + end subroutine define_input_grid_gfs_grib2 + + subroutine define_target_grid(localpet, npets) + + use netcdf + use program_setup, only : mosaic_file_target_grid, & + orog_dir_target_grid, & + orog_files_target_grid + + implicit none + + integer, intent(in) :: localpet, npets + + character(len=500) :: the_file + + integer :: error, ncid, extra + integer :: id_tiles + integer :: id_dim, id_grid_tiles + integer :: tile + integer, allocatable :: decomptile(:,:) + integer(esmf_kind_i8), allocatable :: landmask_one_tile(:,:) + integer(esmf_kind_i8), allocatable :: seamask_one_tile(:,:) + + real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_w_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_w_one_tile(:,:) + real(esmf_kind_r8), allocatable :: terrain_one_tile(:,:) + + print*,'- OPEN TARGET GRID MOSAIC FILE: ',trim(mosaic_file_target_grid) + error=nf90_open(trim(mosaic_file_target_grid),nf90_nowrite,ncid) + call netcdf_err(error, 'opening grid mosaic file') + + print*,"- READ NUMBER OF TILES" + error=nf90_inq_dimid(ncid, 'ntiles', id_tiles) + call netcdf_err(error, 'reading ntile id') + error=nf90_inquire_dimension(ncid,id_tiles,len=num_tiles_target_grid) + call netcdf_err(error, 'reading ntiles') + error=nf90_inq_varid(ncid, 'gridtiles', id_grid_tiles) + call netcdf_err(error, 'reading gridtiles id') + allocate(tiles_target_grid(num_tiles_target_grid)) + tiles_target_grid="NULL" + print*,"- READ TILE NAMES" + error=nf90_get_var(ncid, id_grid_tiles, tiles_target_grid) + call netcdf_err(error, 'reading gridtiles') + + error = nf90_close(ncid) + + print*,'- NUMBER OF TILES, TARGET MODEL GRID IS ', num_tiles_target_grid + + if (mod(npets,num_tiles_target_grid) /= 0) then + call error_handler("MUST RUN WITH TASK COUNT THAT IS A MULTIPLE OF # OF TILES.", 1) + endif + +!----------------------------------------------------------------------- +! Get the model grid specs and land mask from the orography files. +!----------------------------------------------------------------------- + + the_file = trim(orog_dir_target_grid) // trim(orog_files_target_grid(1)) + + print*,'- OPEN FIRST TARGET GRID OROGRAPHY FILE: ',trim(the_file) + error=nf90_open(trim(the_file),nf90_nowrite,ncid) + call netcdf_err(error, 'opening orography file') + print*,"- READ GRID DIMENSIONS" + error=nf90_inq_dimid(ncid, 'lon', id_dim) + call netcdf_err(error, 'reading lon id') + error=nf90_inquire_dimension(ncid,id_dim,len=i_target) + call netcdf_err(error, 'reading lon') + error=nf90_inq_dimid(ncid, 'lat', id_dim) + call netcdf_err(error, 'reading lat id') + error=nf90_inquire_dimension(ncid,id_dim,len=j_target) + call netcdf_err(error, 'reading lat') + error = nf90_close(ncid) + + print*,"- I/J DIMENSIONS OF THE TARGET GRID TILES ", i_target, j_target + + ip1_target = i_target + 1 + jp1_target = j_target + 1 + +!----------------------------------------------------------------------- +! Create ESMF grid object for the model grid. +!----------------------------------------------------------------------- + + extra = npets / num_tiles_target_grid + + allocate(decomptile(2,num_tiles_target_grid)) + + do tile = 1, num_tiles_target_grid + decomptile(:,tile)=(/1,extra/) + enddo + + print*,"- CALL GridCreateMosaic FOR TARGET GRID" + target_grid = ESMF_GridCreateMosaic(filename=trim(mosaic_file_target_grid), & + regDecompPTile=decomptile, & + staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER, & + ESMF_STAGGERLOC_EDGE1, ESMF_STAGGERLOC_EDGE2/), & + indexflag=ESMF_INDEX_GLOBAL, & + tileFilePath=trim(orog_dir_target_grid), rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridCreateMosaic", error) + +!----------------------------------------------------------------------- +! Set target model landmask (1 - land, 0 - not land) and +! seamask (1 - non-land, 0 -land). Read lat/lon on target grid. +!----------------------------------------------------------------------- + + print*,"- CALL FieldCreate FOR TARGET GRID LANDMASK." + landmask_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_I8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_landmask", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID SEAMASK." + seamask_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_I8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_seamask", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LATITUDE." + latitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_latitude", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LATITUDE_S." + latitude_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="target_grid_latitude_s", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LATITUDE_W." + latitude_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="target_grid_latitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LONGITUDE." + longitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_longitude", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LONGITUDE_S." + longitude_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="target_grid_longitude_s", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LONGITUDE_W." + longitude_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="target_grid_longitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID TERRAIN." + terrain_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_terrain", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + if (localpet == 0) then + allocate(landmask_one_tile(i_target,j_target)) + allocate(seamask_one_tile(i_target,j_target)) + allocate(latitude_one_tile(i_target,j_target)) + allocate(latitude_s_one_tile(i_target,jp1_target)) + allocate(latitude_w_one_tile(ip1_target,j_target)) + allocate(longitude_one_tile(i_target,j_target)) + allocate(longitude_s_one_tile(i_target,jp1_target)) + allocate(longitude_w_one_tile(ip1_target,j_target)) + allocate(terrain_one_tile(i_target,j_target)) + else + allocate(landmask_one_tile(0,0)) + allocate(seamask_one_tile(0,0)) + allocate(longitude_one_tile(0,0)) + allocate(longitude_s_one_tile(0,0)) + allocate(longitude_w_one_tile(0,0)) + allocate(latitude_one_tile(0,0)) + allocate(latitude_s_one_tile(0,0)) + allocate(latitude_w_one_tile(0,0)) + allocate(terrain_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + the_file = trim(orog_dir_target_grid) // trim(orog_files_target_grid(tile)) + call get_model_mask_terrain(trim(the_file), i_target, j_target, landmask_one_tile, & + terrain_one_tile) + seamask_one_tile = 0 + where(landmask_one_tile == 0) seamask_one_tile = 1 + call get_model_latlons(mosaic_file_target_grid, orog_dir_target_grid, num_tiles_target_grid, tile, & + i_target, j_target, ip1_target, jp1_target, latitude_one_tile, & + latitude_s_one_tile, latitude_w_one_tile, longitude_one_tile, & + longitude_s_one_tile, longitude_w_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID LANDMASK. TILE IS: ", tile + call ESMF_FieldScatter(landmask_target_grid, landmask_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID SEAMASK. TILE IS: ", tile + call ESMF_FieldScatter(seamask_target_grid, seamask_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LONGITUDE. TILE IS: ", tile + call ESMF_FieldScatter(longitude_target_grid, longitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LONGITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(longitude_s_target_grid, longitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LONGITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(longitude_w_target_grid, longitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LATITUDE. TILE IS: ", tile + call ESMF_FieldScatter(latitude_target_grid, latitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LATITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(latitude_s_target_grid, latitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LATITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(latitude_w_target_grid, latitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID TERRAIN. TILE IS: ", tile + call ESMF_FieldScatter(terrain_target_grid, terrain_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(landmask_one_tile) + deallocate(seamask_one_tile) + deallocate(longitude_one_tile) + deallocate(longitude_s_one_tile) + deallocate(longitude_w_one_tile) + deallocate(latitude_one_tile) + deallocate(latitude_s_one_tile) + deallocate(latitude_w_one_tile) + deallocate(terrain_one_tile) + + end subroutine define_target_grid + +!----------------------------------------------------------------------- +! Read model lat/lons for a single tile from the "grid" file. +!----------------------------------------------------------------------- + + subroutine get_model_latlons(mosaic_file, orog_dir, num_tiles, tile, & + i_tile, j_tile, ip1_tile, jp1_tile, & + latitude, latitude_s, latitude_w, & + longitude, longitude_s, longitude_w) + + use netcdf + + implicit none + + character(len=*), intent(in) :: mosaic_file, orog_dir + + integer, intent(in) :: num_tiles, tile + integer, intent(in) :: i_tile, j_tile + integer, intent(in) :: ip1_tile, jp1_tile + + real(esmf_kind_r8), intent(out) :: latitude(i_tile, j_tile) + real(esmf_kind_r8), intent(out) :: latitude_s(i_tile, jp1_tile) + real(esmf_kind_r8), intent(out) :: latitude_w(ip1_tile, j_tile) + real(esmf_kind_r8), intent(out) :: longitude(i_tile, j_tile) + real(esmf_kind_r8), intent(out) :: longitude_s(i_tile, jp1_tile) + real(esmf_kind_r8), intent(out) :: longitude_w(ip1_tile, j_tile) + + character(len=25) :: grid_files(num_tiles) + character(len=255) :: grid_file + + integer :: error, id_var, ncid + integer :: id_dim, nxp, nyp, i, j, ii, jj + + real(esmf_kind_r8), allocatable :: tmpvar(:,:) + + print*,"- READ MODEL GRID FILE" + + print*,'- OPEN MOSAIC FILE: ', trim(mosaic_file) + error=nf90_open(trim(mosaic_file), nf90_nowrite, ncid) + call netcdf_err(error, 'opening mosaic file') + + print*,"- READ GRID FILE NAMES" + error=nf90_inq_varid(ncid, 'gridfiles', id_var) + call netcdf_err(error, 'reading gridfiles id') + error=nf90_get_var(ncid, id_var, grid_files) + call netcdf_err(error, 'reading gridfiles') + + error = nf90_close(ncid) + + grid_file = trim(orog_dir) // trim(grid_files(tile)) + + print*,'- OPEN GRID FILE: ', trim(grid_file) + error=nf90_open(trim(grid_file), nf90_nowrite, ncid) + call netcdf_err(error, 'opening grid file') + + print*,'- READ NXP ID' + error=nf90_inq_dimid(ncid, 'nxp', id_dim) + call netcdf_err(error, 'reading nxp id') + + print*,'- READ NXP' + error=nf90_inquire_dimension(ncid,id_dim,len=nxp) + call netcdf_err(error, 'reading nxp') + + print*,'- READ NYP ID' + error=nf90_inq_dimid(ncid, 'nyp', id_dim) + call netcdf_err(error, 'reading nyp id') + + print*,'- READ NYP' + error=nf90_inquire_dimension(ncid,id_dim,len=nyp) + call netcdf_err(error, 'reading nyp') + + if ((nxp/2 /= i_tile) .or. (nyp/2 /= j_tile)) then + call error_handler("DIMENSION MISMATCH IN GRID FILE.", 1) + endif + + allocate(tmpvar(nxp,nyp)) + + print*,'- READ LONGITUDE ID' + error=nf90_inq_varid(ncid, 'x', id_var) + call netcdf_err(error, 'reading longitude id') + + print*,'- READ LONGITUDE' + error=nf90_get_var(ncid, id_var, tmpvar) + call netcdf_err(error, 'reading longitude') + + do j = 1, j_tile + do i = 1, i_tile + ii = 2*i + jj = 2*j + longitude(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, jp1_tile + do i = 1, i_tile + ii = 2*i + jj = (2*j) - 1 + longitude_s(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, j_tile + do i = 1, ip1_tile + ii = (2*i) - 1 + jj = 2*j + longitude_w(i,j) = tmpvar(ii,jj) + enddo + enddo + + print*,'- READ LATITUDE ID' + error=nf90_inq_varid(ncid, 'y', id_var) + call netcdf_err(error, 'reading latitude id') + + print*,'- READ LATIITUDE' + error=nf90_get_var(ncid, id_var, tmpvar) + call netcdf_err(error, 'reading latitude') + + do j = 1, j_tile + do i = 1, i_tile + ii = 2*i + jj = 2*j + latitude(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, jp1_tile + do i = 1, i_tile + ii = 2*i + jj = (2*j) - 1 + latitude_s(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, j_tile + do i = 1, ip1_tile + ii = (2*i) - 1 + jj = 2*j + latitude_w(i,j) = tmpvar(ii,jj) + enddo + enddo + + deallocate(tmpvar) + + error = nf90_close(ncid) + + end subroutine get_model_latlons + +!----------------------------------------------------------------------- +! Read the model land mask and terrain for a single tile. +!----------------------------------------------------------------------- + + subroutine get_model_mask_terrain(orog_file, idim, jdim, mask, terrain) + + use netcdf + + implicit none + + character(len=*), intent(in) :: orog_file + + integer, intent(in) :: idim, jdim + integer(esmf_kind_i8), intent(out) :: mask(idim,jdim) + + real(esmf_kind_i8), intent(out) :: terrain(idim,jdim) + + integer :: error, lat, lon + integer :: ncid, id_dim, id_var + + real(kind=4), allocatable :: dummy(:,:) + + print*,"- READ MODEL LAND MASK FILE" + + print*,'- OPEN LAND MASK FILE: ', orog_file + error=nf90_open(orog_file,nf90_nowrite,ncid) + call netcdf_err(error, 'opening land mask file') + + print*,"- READ I-DIMENSION" + error=nf90_inq_dimid(ncid, 'lon', id_dim) + call netcdf_err(error, 'reading idim id') + error=nf90_inquire_dimension(ncid,id_dim,len=lon) + call netcdf_err(error, 'reading idim') + + print*,"- READ J-DIMENSION" + error=nf90_inq_dimid(ncid, 'lat', id_dim) + call netcdf_err(error, 'reading jdim id') + error=nf90_inquire_dimension(ncid,id_dim,len=lat) + call netcdf_err(error, 'reading jdim') + + print*,"- I/J DIMENSIONS: ", lon, lat + + if ((lon /= idim) .or. (lat /= jdim)) then + call error_handler("MISMATCH IN DIMENSIONS.", 1) + endif + + allocate(dummy(idim,jdim)) + + print*,"- READ LAND MASK" + error=nf90_inq_varid(ncid, 'slmsk', id_var) + call netcdf_err(error, 'reading slmsk id') + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'reading slmsk') + mask = nint(dummy) + + print*,"- READ RAW OROGRAPHY." + error=nf90_inq_varid(ncid, 'orog_raw', id_var) + call netcdf_err(error, 'reading orog_raw id') + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'reading orog_raw') + terrain = dummy + + error = nf90_close(ncid) + + deallocate (dummy) + + end subroutine get_model_mask_terrain + + subroutine cleanup_input_target_grid_data + + implicit none + + integer :: rc + + print*,"- DESTROY MODEL DATA." + + if (ESMF_FieldIsCreated(latitude_s_input_grid)) then + call ESMF_FieldDestroy(latitude_s_input_grid, rc=rc) + endif + if (ESMF_FieldIsCreated(latitude_w_input_grid)) then + call ESMF_FieldDestroy(latitude_w_input_grid, rc=rc) + endif + if (ESMF_FieldIsCreated(longitude_s_input_grid)) then + call ESMF_FieldDestroy(longitude_s_input_grid, rc=rc) + endif + if (ESMF_FieldIsCreated(longitude_w_input_grid)) then + call ESMF_FieldDestroy(longitude_w_input_grid, rc=rc) + endif + call ESMF_FieldDestroy(landmask_target_grid, rc=rc) + call ESMF_FieldDestroy(latitude_target_grid, rc=rc) + call ESMF_FieldDestroy(latitude_s_target_grid, rc=rc) + call ESMF_FieldDestroy(latitude_w_target_grid, rc=rc) + call ESMF_FieldDestroy(longitude_target_grid, rc=rc) + call ESMF_FieldDestroy(longitude_s_target_grid, rc=rc) + call ESMF_FieldDestroy(longitude_w_target_grid, rc=rc) + call ESMF_FieldDestroy(seamask_target_grid, rc=rc) + call ESMF_FieldDestroy(terrain_target_grid, rc=rc) + call ESMF_GridDestroy(input_grid, rc=rc) + call ESMF_GridDestroy(target_grid, rc=rc) + + end subroutine cleanup_input_target_grid_data + + end module model_grid diff --git a/sorc/coldstart.fd/program_setup.f90 b/sorc/coldstart.fd/program_setup.f90 new file mode 100644 index 000000000..ed6935457 --- /dev/null +++ b/sorc/coldstart.fd/program_setup.f90 @@ -0,0 +1,598 @@ + module program_setup + +!-------------------------------------------------------------------------- +! Module program_setup +! +! Abstract: Set up program execution +! +! Public Subroutines: +! ------------------- +! read_setup_namelist Reads configuration namelist +! calc_soil_params_driver Computes soil parameters +! +! Public variables: +! ----------------- +! atm_files_input_grid File names of input atmospheric data. +! Not used for "grib2" or "restart" +! input types. +! atm_core_files_input_grid File names of input atmospheric restart +! core files. Only used for 'restart' +! input type. +! atm_tracer_files_input_grid File names of input atmospheric restart +! tracer files. Only used for 'restart' +! input type. +! atm_weight_file File containing pre-computed weights +! to horizontally interpolate +! atmospheric fields. +! bb_target Soil 'b' parameter, target grid +! convert_atm Convert atmospheric data when true. +! convert_nst Convert nst data when true. +! convert_sfc Convert sfc data when true. +! cres_target_grid Target grid resolution, i.e., C768. +! cycle_mon/day/hour Cycle month/day/hour +! data_dir_input_grid Directory containing input atm or sfc +! files. +! drysmc_input/target Air dry soil moisture content input/ +! target grids. +! fix_dir_target_grid Directory containing target grid +! pre-computed fixed data (ex: soil type) +! grib2_file_input_grid File name of grib2 input data. +! Assumes atmospheric and surface data +! are in a single file. 'grib2' input +! type only. +! halo_blend Number of row/cols of blending halo, +! where model tendencies and lateral +! boundary tendencies are applied. +! Regional target grids only. +! halo_bndy Number of row/cols of lateral halo, +! where pure lateral bndy conditions are +! applied (regional target grids). +! input_type Input data type: +! (1) "restart" for fv3 tiled warm restart +! files (netcdf). +! (2) "history" for fv3 tiled history files +! (netcdf). +! (3) "gaussian_nemsio" for fv3 gaussian +! nemsio files; +! (4) "gaussian_netcdf" for fv3 gaussian +! netcdf files. +! (5) "grib2" for fv3gfs grib2 files. +! (6) "gfs_gaussian_nemsio" for spectral gfs +! gaussian nemsio files +! (7) "gfs_sigio" for spectral gfs +! gfs sigio/sfcio files. +! max_tracers Maximum number of atmospheric tracers +! processed +! maxsmc_input/target Maximum soil moisture content input/ +! target grids +! mosaic_file_input_grid Input grid mosaic file. Only used for +! "restart" or "history" input type. +! mosaic_file_target_grid Target grid mosaic file +! nst_files_input_grid File name of input nst data. Only +! used for input_type "gfs_gaussian_nemsio". +! num_tracers Number of atmospheric tracers to +! be processed. +! orog_dir_input_grid Directory containing the input grid +! orography files. Only used for "restart" +! or "history" input types. +! orog_files_input_grid Input grid orography files. Only used for +! "restart" or "history" input types. +! orog_dir_target_grid Directory containing the target grid +! orography files. +! orog_files_target_grid Target grid orography files. +! refsmc_input/target Reference soil moisture content input/ +! target grids (onset of soil moisture +! stress). +! regional For regional target grids. When '1' +! remove boundary halo region from +! atmospheric/surface data and +! output atmospheric boundary file. +! When '2' output boundary file only. +! Default is '0' (global grids). +! satpsi_target Saturated soil potential, target grid +! sfc_files_input_grid File names containing input surface data. +! Not used for 'grib2' input type. +! thomp_mp_climo_file Path/name to the Thompson MP climatology +! file. +! tracers Name of each atmos tracer to be processed. +! These names will be used to identify +! the tracer records in the output files. +! Follows the convention in the field table. +! tracers_input Name of each atmos tracer record in +! the input file. May be different from +! value in 'tracers'. +! use_thomp_mp_climo When true, read and process Thompson +! MP climatological tracers. False, +! when 'thomp_mp_climo_file' is NULL. +! vcoord_file_target_grid Vertical coordinate definition file +! wltsmc_input/target Wilting point soil moisture content +! input/target grids +! +!-------------------------------------------------------------------------- + + implicit none + + private + + character(len=500), public :: varmap_file = "NULL" + character(len=500), public :: atm_files_input_grid(6) = "NULL" + character(len=500), public :: atm_core_files_input_grid(7) = "NULL" + character(len=500), public :: atm_tracer_files_input_grid(6) = "NULL" + character(len=500), public :: data_dir_input_grid = "NULL" + character(len=500), public :: fix_dir_target_grid = "NULL" + character(len=500), public :: mosaic_file_input_grid = "NULL" + character(len=500), public :: mosaic_file_target_grid = "NULL" + character(len=500), public :: nst_files_input_grid = "NULL" + character(len=500), public :: grib2_file_input_grid = "NULL" + character(len=500), public :: orog_dir_input_grid = "NULL" + character(len=500), public :: orog_files_input_grid(6) = "NULL" + character(len=500), public :: orog_dir_target_grid = "NULL" + character(len=500), public :: orog_files_target_grid(6) = "NULL" + character(len=500), public :: sfc_files_input_grid(6) = "NULL" + character(len=500), public :: vcoord_file_target_grid = "NULL" + character(len=500), public :: thomp_mp_climo_file= "NULL" + character(len=6), public :: cres_target_grid = "NULL" + character(len=500), public :: atm_weight_file="NULL" + character(len=25), public :: input_type="restart" + character(len=20), public :: phys_suite="GFS" !Default to gfs physics suite + + integer, parameter, public :: max_tracers=100 + integer, public :: num_tracers, num_tracers_input + + logical, allocatable, public :: read_from_input(:) + + character(len=20), public :: tracers(max_tracers)="NULL" + character(len=20), public :: tracers_input(max_tracers)="NULL" + character(len=20), allocatable, public :: missing_var_methods(:) + character(len=20), allocatable, public :: chgres_var_names(:) + character(len=20), allocatable, public :: field_var_names(:) + + + integer, public :: cycle_mon = -999 + integer, public :: cycle_day = -999 + integer, public :: cycle_hour = -999 + integer, public :: regional = 0 + integer, public :: halo_bndy = 0 + integer, public :: halo_blend = 0 + + logical, public :: convert_atm = .false. + logical, public :: convert_nst = .false. + logical, public :: convert_sfc = .false. + + logical, public :: use_thomp_mp_climo=.false. + + real, allocatable, public :: drysmc_input(:), drysmc_target(:) + real, allocatable, public :: maxsmc_input(:), maxsmc_target(:) + real, allocatable, public :: refsmc_input(:), refsmc_target(:) + real, allocatable, public :: wltsmc_input(:), wltsmc_target(:) + real, allocatable, public :: bb_target(:), satpsi_target(:) + real, allocatable, public :: missing_var_values(:) + + + public :: read_setup_namelist + public :: calc_soil_params_driver + public :: read_varmap + public :: get_var_cond + + contains + + subroutine read_setup_namelist + + implicit none + + + + integer :: is, ie, ierr + + + namelist /config/ varmap_file, & + mosaic_file_target_grid, & + fix_dir_target_grid, & + orog_dir_target_grid, & + orog_files_target_grid, & + mosaic_file_input_grid, & + orog_dir_input_grid, & + orog_files_input_grid, & + nst_files_input_grid, & + sfc_files_input_grid, & + atm_files_input_grid, & + atm_core_files_input_grid, & + atm_tracer_files_input_grid, & + grib2_file_input_grid, & + data_dir_input_grid, & + vcoord_file_target_grid, & + cycle_mon, cycle_day, & + cycle_hour, convert_atm, & + convert_nst, convert_sfc, & + regional, input_type, & + atm_weight_file, tracers, & + tracers_input,phys_suite, & + halo_bndy, & + halo_blend, thomp_mp_climo_file + + print*,"- READ SETUP NAMELIST" + + open(41, file="./fort.41", iostat=ierr) + if (ierr /= 0) call error_handler("OPENING SETUP NAMELIST.", ierr) + read(41, nml=config, iostat=ierr) + if (ierr /= 0) call error_handler("READING SETUP NAMELIST.", ierr) + close (41) + + call to_lower(input_type) + call to_upper(phys_suite) + + orog_dir_target_grid = trim(orog_dir_target_grid) // '/' + orog_dir_input_grid = trim(orog_dir_input_grid) // '/' + +!------------------------------------------------------------------------- +! Determine CRES of target grid from the name of the mosaic file. +!------------------------------------------------------------------------- + + is = index(mosaic_file_target_grid, "/", .true.) + ie = index(mosaic_file_target_grid, "_mosaic") + + if (is == 0 .or. ie == 0) then + call error_handler("CANT DETERMINE CRES FROM MOSAIC FILE.", 1) + endif + + cres_target_grid = mosaic_file_target_grid(is+1:ie-1) + + if (.not. convert_sfc .and. .not. convert_atm) then + call error_handler("MUST CONVERT EITHER AN ATM OR SFC FILE.", 1) + endif + +!------------------------------------------------------------------------- +! Flag for processing stand-alone regional grid. When '1', +! remove halo from atmospheric and surface data and output +! atmospheric lateral boundary condition file. When '2', +! create lateral boundary file only. When '0' (the default), +! process normally as a global grid. +!------------------------------------------------------------------------- + + if (regional > 0) then + print*,"- PROCESSING A REGIONAL NEST WITH A BOUNDARY HALO OF ",halo_bndy + print*,"- PROCESSING A REGIONAL NEST WITH A BLENDING HALO OF ",halo_blend + else + halo_bndy = 0 + halo_blend = 0 + endif + + num_tracers = 0 + do is = 1, max_tracers + if (trim(tracers(is)) == "NULL") exit + num_tracers = num_tracers + 1 + print*,"- WILL PROCESS TRACER ", trim(tracers(is)) + enddo + + num_tracers_input = 0 + do is = 1, max_tracers + if (trim(tracers_input(is)) == "NULL") exit + num_tracers_input = num_tracers_input + 1 + print*,"- WILL PROCESS INPUT TRACER ", trim(tracers_input(is)) + enddo + +!------------------------------------------------------------------------- +! Ensure program recognizes the input data type. +!------------------------------------------------------------------------- + + select case (trim(input_type)) + case ("restart") + print*,'- INPUT DATA FROM FV3 TILED RESTART FILES.' + case ("history") + print*,'- INPUT DATA FROM FV3 TILED HISTORY FILES.' + case ("gaussian_nemsio") + print*,'- INPUT DATA FROM FV3 GAUSSIAN NEMSIO FILE.' + case ("gfs_gaussian_nemsio") + print*,'- INPUT DATA FROM SPECTRAL GFS GAUSSIAN NEMSIO FILE.' + case ("gfs_sigio") + print*,'- INPUT DATA FROM SPECTRAL GFS SIGIO/SFCIO FILE.' + case ("gaussian_netcdf") + print*,'- INPUT DATA FROM FV3 GAUSSIAN NETCDF FILE.' + case ("grib2") + print*,'- INPUT DATA FROM A GRIB2 FILE' + case default + call error_handler("UNRECOGNIZED INPUT DATA TYPE.", 1) + end select + + if (trim(thomp_mp_climo_file) /= "NULL") then + use_thomp_mp_climo=.true. + print*,"- WILL PROCESS CLIMO THOMPSON MP TRACERS FROM FILE: ", trim(thomp_mp_climo_file) + endif + + end subroutine read_setup_namelist + +subroutine read_varmap + + implicit none + + integer :: istat, k, nvars + character(len=500) :: line + character(len=20),allocatable :: var_type(:) + + if (trim(input_type) == "grib2") then + + print*,"OPEN VARIABLE MAPPING FILE: ", trim(varmap_file) + open(14, file=trim(varmap_file), form='formatted', iostat=istat) + if (istat /= 0) then + call error_handler("OPENING VARIABLE MAPPING FILE", istat) + endif + + num_tracers = 0 + nvars = 0 + + !Loop over lines of file to count the number of variables + do + read(14, '(A)', iostat=istat) line !chgres_var_names_tmp(k)!, field_var_names(k) , & + ! missing_var_methods(k), missing_var_values(k), var_type(k) + if (istat/=0) exit + if ( trim(line) .eq. '' ) cycle + nvars = nvars+1 + enddo + + + allocate(chgres_var_names(nvars)) + allocate(field_var_names(nvars)) + allocate(missing_var_methods(nvars)) + allocate(missing_var_values(nvars)) + allocate(read_from_input(nvars)) + allocate(var_type(nvars)) + + read_from_input(:) = .true. + rewind(14) + do k = 1,nvars + read(14, *, iostat=istat) chgres_var_names(k), field_var_names(k) , & + missing_var_methods(k), missing_var_values(k), var_type(k) + if (istat /= 0) call error_handler("READING VARIABLE MAPPING FILE", istat) + if(trim(var_type(k))=='T') then + num_tracers = num_tracers + 1 + tracers_input(num_tracers)=chgres_var_names(k) + endif + enddo + close(14) + endif +end subroutine read_varmap + +! ---------------------------------------------------------------------------------------- +! Find conditions for handling missing variables from varmap arrays +! ---------------------------------------------------------------------------------------- + +subroutine get_var_cond(var_name,this_miss_var_method,this_miss_var_value, & + this_field_var_name, loc) + use esmf + + implicit none + character(len=20) :: var_name + + character(len=20), optional, intent(out) :: this_miss_var_method, & + this_field_var_name + real(esmf_kind_r4), optional, intent(out):: this_miss_var_value + + integer, optional, intent(out) :: loc + + integer :: i, tmp(size(missing_var_methods)) + + i=0 + + tmp(:)=0 + where(chgres_var_names==var_name) tmp=1 + + i = maxloc(merge(1.,0.,chgres_var_names == var_name),dim=1) !findloc(chgres_var_names,var_name) + print*, i + if (maxval(tmp).eq.0) then + print*, "WARNING: NO ENTRY FOR ", trim(var_name), " IN VARMAP TABLE. WILL SKIP " // & + "VARIABLE IF NOT FOUND IN EXTERNAL MODEL FILE" + + if(present(this_miss_var_method)) this_miss_var_method = "skip" + if(present(this_miss_var_value)) this_miss_var_value = -9999.9_esmf_kind_r4 + if(present(this_field_var_name)) this_field_var_name = "NULL" + if(present(loc)) loc = 9999 + else + if(present(this_miss_var_method)) this_miss_var_method = missing_var_methods(i) + if(present(this_miss_var_value)) this_miss_var_value = missing_var_values(i) + if(present(this_field_var_name)) this_field_var_name = field_var_names(i) + if(present(loc)) loc = i + endif + +end subroutine get_var_cond + + subroutine calc_soil_params_driver(localpet) + + implicit none + + integer, intent(in) :: localpet + + integer, parameter :: num_statsgo = 16 + real, parameter :: smlow_statsgo = 0.5 + real, parameter :: smhigh_statsgo = 6.0 + +! zobler soil type used by spectral gfs prior to June 2017. + integer, parameter :: num_zobler = 9 + real, parameter :: smlow_zobler = 0.5 + real, parameter :: smhigh_zobler = 6.0 + + integer :: num_soil_cats + + real :: bb_statsgo(num_statsgo) + real :: maxsmc_statsgo(num_statsgo) + real :: satdk_statsgo(num_statsgo) + real :: satpsi_statsgo(num_statsgo) + + real :: bb_zobler(num_zobler) + real :: maxsmc_zobler(num_zobler) + real :: satdk_zobler(num_zobler) + real :: satpsi_zobler(num_zobler) + + real, allocatable :: bb(:) + real :: smlow, smhigh + real, allocatable :: f11(:) + real, allocatable :: satdk(:) + real, allocatable :: satpsi(:) + real, allocatable :: satdw(:) + + data bb_statsgo /4.05, 4.26, 4.74, 5.33, 5.33, 5.25, & + 6.77, 8.72, 8.17, 10.73, 10.39, 11.55, & + 5.25, -9.99, 4.05, 4.26/ + + data maxsmc_statsgo /0.395, 0.421, 0.434, 0.476, 0.476, 0.439, & + 0.404, 0.464, 0.465, 0.406, 0.468, 0.457, & + 0.464, -9.99, 0.200, 0.421/ + + data satdk_statsgo /1.7600e-4, 1.4078e-5, 5.2304e-6, 2.8089e-6, 2.8089e-6, & + 3.3770e-6, 4.4518e-6, 2.0348e-6, 2.4464e-6, 7.2199e-6, & + 1.3444e-6, 9.7384e-7, 3.3770e-6, -9.99, 1.4078e-5, & + 1.4078e-5/ + + data satpsi_statsgo /0.0350, 0.0363, 0.1413, 0.7586, 0.7586, 0.3548, & + 0.1349, 0.6166, 0.2630, 0.0977, 0.3236, 0.4677, & + 0.3548, -9.99, 0.0350, 0.0363/ + + data bb_zobler /4.26, 8.72, 11.55, 4.74, 10.73, 8.17, & + 6.77, 5.25, 4.26/ + + data maxsmc_zobler /0.421, 0.464, 0.468, 0.434, 0.406, 0.465, & + 0.404, 0.439, 0.421/ + + data satdk_zobler /1.41e-5, 0.20e-5, 0.10e-5, 0.52e-5, 0.72e-5, & + 0.25e-5, 0.45e-5, 0.34e-5, 1.41e-5/ + + data satpsi_zobler /0.040, 0.620, 0.470, 0.140, 0.100, 0.260, & + 0.140, 0.360, 0.040/ + +!------------------------------------------------------------------------- +! Compute soil parameters for the input grid. +!------------------------------------------------------------------------- + + select case (trim(input_type)) + case ("gfs_sigio") + print*,'- INPUT GRID USED ZOBLER SOIL TYPES.' + num_soil_cats = num_zobler + case default + print*,'- INPUT GRID USED STATSGO SOIL TYPES.' + num_soil_cats = num_statsgo + end select + + allocate(maxsmc_input(num_soil_cats)) + allocate(wltsmc_input(num_soil_cats)) + allocate(drysmc_input(num_soil_cats)) + allocate(refsmc_input(num_soil_cats)) + allocate(bb(num_soil_cats)) + allocate(satdk(num_soil_cats)) + allocate(satpsi(num_soil_cats)) + allocate(satdw(num_soil_cats)) + allocate(f11(num_soil_cats)) + + select case (trim(input_type)) + case ("gfs_sigio") + smlow = smlow_zobler + smhigh = smhigh_zobler + maxsmc_input = maxsmc_zobler + bb = bb_zobler + satdk = satdk_zobler + satpsi = satpsi_zobler + case default + smlow = smlow_statsgo + smhigh = smhigh_statsgo + maxsmc_input = maxsmc_statsgo + bb = bb_statsgo + satdk = satdk_statsgo + satpsi = satpsi_statsgo + end select + + call calc_soil_params(num_soil_cats, smlow, smhigh, satdk, maxsmc_input, & + bb, satpsi, satdw, f11, refsmc_input, drysmc_input, wltsmc_input) + + deallocate(bb, satdk, satpsi, satdw, f11) + + if (localpet == 0) print*,'maxsmc input grid ',maxsmc_input + if (localpet == 0) print*,'wltsmc input grid ',wltsmc_input + +!------------------------------------------------------------------------- +! Compute soil parameters for the target grid. +!------------------------------------------------------------------------- + + print*,'- TARGET GRID USEING STATSGO SOIL TYPES.' + + num_soil_cats = num_statsgo + + allocate(maxsmc_target(num_soil_cats)) + allocate(wltsmc_target(num_soil_cats)) + allocate(drysmc_target(num_soil_cats)) + allocate(refsmc_target(num_soil_cats)) + allocate(bb_target(num_soil_cats)) + allocate(satpsi_target(num_soil_cats)) + allocate(satdk(num_soil_cats)) + allocate(satdw(num_soil_cats)) + allocate(f11(num_soil_cats)) + + smlow = smlow_statsgo + smhigh = smhigh_statsgo + maxsmc_target = maxsmc_statsgo + bb_target = bb_statsgo + satdk = satdk_statsgo + satpsi_target = satpsi_statsgo + + call calc_soil_params(num_soil_cats, smlow, smhigh, satdk, maxsmc_target, & + bb_target, satpsi_target, satdw, f11, refsmc_target, drysmc_target, wltsmc_target) + + deallocate(satdk, satdw, f11) + + if (localpet == 0) print*,'maxsmc target grid ',maxsmc_target + if (localpet == 0) print*,'wltsmc input grid ',wltsmc_target + + end subroutine calc_soil_params_driver + + subroutine calc_soil_params(num_soil_cats, smlow, smhigh, satdk, & + maxsmc, bb, satpsi, satdw, f11, refsmc, drysmc, wltsmc) + + implicit none + + integer, intent(in) :: num_soil_cats + + real, intent(in) :: smlow, smhigh + real, intent(in) :: bb(num_soil_cats) + real, intent(in) :: maxsmc(num_soil_cats) + real, intent(in) :: satdk(num_soil_cats) + real, intent(in) :: satpsi(num_soil_cats) + + real, intent(out) :: f11(num_soil_cats) + real, intent(out) :: satdw(num_soil_cats) + real, intent(out) :: refsmc(num_soil_cats) + real, intent(out) :: drysmc(num_soil_cats) + real, intent(out) :: wltsmc(num_soil_cats) + + integer :: i + + real :: refsmc1 + real :: wltsmc1 + + satdw = 0.0 + f11 = 0.0 + refsmc = 0.0 + wltsmc = 0.0 + drysmc = 0.0 + + do i = 1, num_soil_cats + + if (maxsmc(i) > 0.0) then + + SATDW(I) = BB(I)*SATDK(I)*(SATPSI(I)/MAXSMC(I)) + F11(I) = ALOG10(SATPSI(I)) + BB(I)*ALOG10(MAXSMC(I)) + 2.0 + REFSMC1 = MAXSMC(I)*(5.79E-9/SATDK(I)) **(1.0/(2.0*BB(I)+3.0)) + REFSMC(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / SMHIGH + WLTSMC1 = MAXSMC(I) * (200.0/SATPSI(I))**(-1.0/BB(I)) + WLTSMC(I) = WLTSMC1 - SMLOW * WLTSMC1 + +!---------------------------------------------------------------------- +! CURRENT VERSION DRYSMC VALUES THAT EQUATE TO WLTSMC. +! FUTURE VERSION COULD LET DRYSMC BE INDEPENDENTLY SET VIA NAMELIST. +!---------------------------------------------------------------------- + + DRYSMC(I) = WLTSMC(I) + + end if + + END DO + + end subroutine calc_soil_params + + end module program_setup diff --git a/sorc/coldstart.fd/search_util.f90 b/sorc/coldstart.fd/search_util.f90 new file mode 100644 index 000000000..58bb3cf37 --- /dev/null +++ b/sorc/coldstart.fd/search_util.f90 @@ -0,0 +1,190 @@ + module search_util + +!-------------------------------------------------------------------------- +! Module search +! +! Abstract: Replace undefined values with a valid value. This can +! happen for an isolated lake or island that is unresolved by +! the input grid. +! +! Public Subroutines: +! ------------------- +! search Performs the search and replace. +! +!-------------------------------------------------------------------------- + + private + + public :: search + + contains + + subroutine search (field, mask, idim, jdim, tile, field_num, latitude) + +!----------------------------------------------------------------------- +! Replace undefined values on the model grid with a valid value at +! a nearby neighbor. Undefined values are typically associated +! with isolated islands where there is no source data. +! +! Routine searches a neighborhood with a radius of 100 grid points. +! If no valid value is found, a default value is used. +! +! Note: This routine works for one tile of a cubed sphere grid. It +! does not consider valid values at adjacent faces. That is a +! future upgrade. +!----------------------------------------------------------------------- + + use mpi + use esmf + + implicit none + + integer, intent(in) :: idim, jdim, tile, field_num + integer(esmf_kind_i8), intent(in) :: mask(idim,jdim) + + real(esmf_kind_r8), intent(in), optional :: latitude(idim,jdim) + + real(esmf_kind_r8), intent(inout) :: field(idim,jdim) + + integer :: i, j, krad, ii, jj + integer :: istart, iend + integer :: jstart, jend + integer :: ierr + + real :: default_value + real(esmf_kind_r8) :: field_save(idim,jdim) + +!----------------------------------------------------------------------- +! Set default value. +!----------------------------------------------------------------------- + + select case (field_num) + case (0) ! most nst fields + default_value = 0.0 + case (1) ! ifd + default_value = 1.0 + case (7) ! terrain height, flag value to turn off terrain adjustment + ! of soil temperatures. + default_value = -99999.9 + case (11) ! water temperature will use latitude-dependent value + default_value = -999.0 + case (21) ! ice temperature + default_value = 265.0 + case (30) ! xz + default_value = 30.0 + case (65) ! snow liq equivalent + default_value = 0.0 + case (66) ! snow depth + default_value = 0.0 + case (83) ! z0 (cm) + default_value = 0.01 + case (85) ! soil temp + default_value = 280.0 + case (86) ! soil moisture (volumetric) + default_value = 0.18 + case (91) ! sea ice fraction + default_value = 0.5 + case (92) ! sea ice depth (meters) + default_value = 1.0 + case (223) ! canopy moist + default_value = 0.0 + case (224) ! soil type, flag value to turn off soil moisture rescaling. + default_value = -99999.9 + case default + print*,'- FATAL ERROR. UNIDENTIFIED FIELD NUMBER : ', field + call mpi_abort(mpi_comm_world, 77, ierr) + end select + +!----------------------------------------------------------------------- +! Perform search and replace. +!----------------------------------------------------------------------- + + field_save = field + +!$OMP PARALLEL DO DEFAULT(NONE), & +!$OMP SHARED(IDIM,JDIM,MASK,FIELD_SAVE,FIELD,TILE,LATITUDE,DEFAULT_VALUE,FIELD_NUM), & +!$OMP PRIVATE(I,J,KRAD,ISTART,IEND,JSTART,JEND,II,JJ) + + J_LOOP : do j = 1, jdim + I_LOOP : do i = 1, idim + + if (mask(i,j) == 1 .and. field_save(i,j) < -9999.0) then + + KRAD_LOOP : do krad = 1, 100 + + istart = i - krad + iend = i + krad + jstart = j - krad + jend = j + krad + + JJ_LOOP : do jj = jstart, jend + II_LOOP : do ii = istart, iend + +!----------------------------------------------------------------------- +! Search only along outer square. +!----------------------------------------------------------------------- + + if ((jj == jstart) .or. (jj == jend) .or. & + (ii == istart) .or. (ii == iend)) then + + if (jj < 1 .or. jj > jdim) cycle JJ_LOOP + if (ii < 1 .or. ii > idim) cycle II_LOOP + + if (mask(ii,jj) == 1 .and. field_save(ii,jj) > -9999.0) then + field(i,j) = field_save(ii,jj) + write(6,100) tile,i,j,ii,jj,field(i,j) + cycle I_LOOP + endif + + endif + + enddo II_LOOP + enddo JJ_LOOP + + enddo KRAD_LOOP + + if (field_num == 11) then + call sst_guess(latitude(i,j), field(i,j)) + elseif (field_num == 91) then ! sea ice fract + if (abs(latitude(i,j)) > 55.0) then + field(i,j) = default_value + else + field(i,j) = 0.0 + endif + else + field(i,j) = default_value ! Search failed. Use default value. + endif + + write(6,101) tile,i,j,field(i,j) + + endif + enddo I_LOOP + enddo J_LOOP +!$OMP END PARALLEL DO + + 100 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO VALUE AT: ",i5,i5,". NEW VALUE IS: ",f8.3) + 101 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",f8.3) + + end subroutine search + + subroutine sst_guess(latitude, sst) + + use esmf + + implicit none + + real(esmf_kind_r8), intent(in) :: latitude + + real(esmf_kind_r8), intent(out) :: sst + + if (latitude >= 60.0) then + sst = 273.16 + elseif (abs(latitude) <= 30.0) then + sst = 300.0 + else + sst = (-0.8947) * abs(latitude) + 326.84 + endif + + end subroutine sst_guess + + end module search_util diff --git a/sorc/coldstart.fd/static_data.F90 b/sorc/coldstart.fd/static_data.F90 new file mode 100644 index 000000000..3bd297475 --- /dev/null +++ b/sorc/coldstart.fd/static_data.F90 @@ -0,0 +1,528 @@ + module static_data + +!-------------------------------------------------------------------------- +! Module static data +! +! Abstract: Read pre-computed static/climatological data on the fv3 +! target grid. Time interpolate if necessary (for example a +! monthly climo fields). +! +! Public Subroutines: +! ------------------- +! get_static_fields Driver routine to read/time interpolate +! static/climo fields on the fv3 target +! grid. +! cleanup_static_fields Free up memory for fields in this module. +! +! Public variables: +! ----------------- +! alnsf_target_grid near ir black sky albedo +! alnwf_target_grid near ir white sky albedo +! alvsf_target_grid visible black sky albedo +! alvwf_target_grid visible white sky albedo +! facsf_target_grid fractional coverage for strong +! zenith angle dependent albedo +! facwf_target_grid fractional coverage for weak +! zenith angle dependent albedo +! max_veg_greenness_target_grid maximum annual greenness fraction +! min_veg_greenness_target_grid minimum annual greenness fraction +! mxsno_albedo_target_grid maximum snow albedo +! slope_type_target_grid slope type +! soil_type_target_grid soil type +! substrate_temp_target_grid soil subtrate temperature +! veg_greenness_target_grid vegetation greenness fraction +! veg_type_targe_grid vegetation type +! +!-------------------------------------------------------------------------- + + use esmf + + implicit none + + private + + type(esmf_field), public :: alvsf_target_grid + type(esmf_field), public :: alvwf_target_grid + type(esmf_field), public :: alnsf_target_grid + type(esmf_field), public :: alnwf_target_grid + type(esmf_field), public :: facsf_target_grid + type(esmf_field), public :: facwf_target_grid + type(esmf_field), public :: max_veg_greenness_target_grid + type(esmf_field), public :: min_veg_greenness_target_grid + type(esmf_field), public :: mxsno_albedo_target_grid + type(esmf_field), public :: slope_type_target_grid + type(esmf_field), public :: soil_type_target_grid + type(esmf_field), public :: substrate_temp_target_grid + type(esmf_field), public :: veg_greenness_target_grid + type(esmf_field), public :: veg_type_target_grid + + public :: get_static_fields + public :: cleanup_static_fields + + contains + +!------------------------------------------------------------------------------ +! Read static fields on the target grid. +!------------------------------------------------------------------------------ + + subroutine get_static_fields(localpet) + + use model_grid, only : target_grid, & + num_tiles_target_grid, & + i_target, j_target + + implicit none + + integer, intent(in) :: localpet + + integer :: error, tile, i, j + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: max_data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: min_data_one_tile(:,:) + + if (localpet==0) then + allocate(data_one_tile(i_target,j_target)) + else + allocate(data_one_tile(0,0)) + endif + +!------------------------------------------------------------------------------ +! Slope type +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID SLOPE TYPE." + slope_type_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('slope_type', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID SLOPE TYPE." + call ESMF_FieldScatter(slope_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Maximum snow albedo. +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID MAXIMUM SNOW ALBEDO." + mxsno_albedo_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('maximum_snow_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID MAXIMUM SNOW ALBEDO." + call ESMF_FieldScatter(mxsno_albedo_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Soil type +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID SOIL TYPE." + soil_type_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('soil_type', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Vegetation type +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID VEGETATION TYPE." + veg_type_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('vegetation_type', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldScatter(veg_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Vegetation greenness +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID VEGETATION GREENNESS." + veg_greenness_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID MAXIMUM VEGETATION GREENNESS." + max_veg_greenness_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID MINIMUM VEGETATION GREENNESS." + min_veg_greenness_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + if (localpet == 0) then + allocate(max_data_one_tile(i_target,j_target)) + allocate(min_data_one_tile(i_target,j_target)) + else + allocate(max_data_one_tile(0,0)) + allocate(min_data_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('vegetation_greenness', i_target, j_target, tile, data_one_tile, & + max_data_one_tile, min_data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID VEGETATION GREENNESS." + call ESMF_FieldScatter(veg_greenness_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID MAXIMUM VEGETATION GREENNESS." + call ESMF_FieldScatter(max_veg_greenness_target_grid, max_data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID MINIMUM VEGETATION GREENNESS." + call ESMF_FieldScatter(min_veg_greenness_target_grid, min_data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(max_data_one_tile, min_data_one_tile) + +!------------------------------------------------------------------------------ +! Soil substrate temperature +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID SUBSTRATE TEMPERATURE." + substrate_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('substrate_temperature', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID SUBSTRATE TEMPERATURE." + call ESMF_FieldScatter(substrate_temp_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Four-component albedo. +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR ALVSF." + alvsf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('visible_black_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALVSF." + call ESMF_FieldScatter(alvsf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + + print*,"- CALL FieldCreate FOR ALVWF." + alvwf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('visible_white_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALVWF." + call ESMF_FieldScatter(alvwf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + + print*,"- CALL FieldCreate FOR ALNSF." + alnsf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('near_IR_black_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALNSF." + call ESMF_FieldScatter(alnsf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + + print*,"- CALL FieldCreate FOR ALNWF." + alnwf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('near_IR_white_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALNWF." + call ESMF_FieldScatter(alnwf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! facsf and facwf +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID FACSF." + facsf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID FACWF." + facwf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('facsf', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID FACSF." + call ESMF_FieldScatter(facsf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + if (localpet == 0) then + do j = 1, j_target + do i = 1, i_target + if (data_one_tile(i,j) >= 0.0) then + data_one_tile(i,j) = 1.0 - data_one_tile(i,j) + endif + enddo + enddo + endif + call ESMF_FieldScatter(facwf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(data_one_tile) + + end subroutine get_static_fields + +!------------------------------------------------------------------------------ +! Read data file. +!------------------------------------------------------------------------------ + + subroutine read_static_file(field, i_target, j_target, tile, & + data_one_tile, max_data_one_tile, & + min_data_one_tile) + + use netcdf + use model_grid, only : tiles_target_grid + use program_setup, only : fix_dir_target_grid, cres_target_grid, & + cycle_mon, cycle_day, cycle_hour + + implicit none + + character(len=*), intent(in) :: field + character(len=100) :: filename + character(len=500) :: the_file + + integer, intent(in) :: i_target, j_target, tile + + real(esmf_kind_r8), intent(out) :: data_one_tile(i_target,j_target) + real(esmf_kind_r8), intent(out), optional :: max_data_one_tile(i_target,j_target) + real(esmf_kind_r8), intent(out), optional :: min_data_one_tile(i_target,j_target) + + integer :: bound1, bound2 + integer :: error, ncid, id_var, n + integer :: i, j, id_time, num_times + integer :: idat(8), jdat(8) + integer, allocatable :: days_since(:) + + real(kind=4), allocatable :: dummy(:,:,:) + real(esmf_kind_r8) :: num_days, num_days_rec1, rinc(5) + real(esmf_kind_r8) :: weight_rec1, weight_rec2 + + if (trim(field) == 'facsf') filename = "/" // trim(cres_target_grid) // ".facsf." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'maximum_snow_albedo') filename = "/" // trim(cres_target_grid) // ".maximum_snow_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'slope_type') filename = "/" // trim(cres_target_grid) // ".slope_type." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'soil_type') filename = "/" // trim(cres_target_grid) // ".soil_type." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'substrate_temperature') filename = "/" // trim(cres_target_grid) // ".substrate_temperature." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'vegetation_greenness') filename = "/" // trim(cres_target_grid) // ".vegetation_greenness." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'vegetation_type') filename = "/" // trim(cres_target_grid) // ".vegetation_type." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'visible_black_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'visible_white_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'near_IR_black_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'near_IR_white_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + + the_file = trim(fix_dir_target_grid) // trim(filename) + + print*,'- OPEN FILE ',trim(the_file) + error=nf90_open(trim(the_file),nf90_nowrite,ncid) + call netcdf_err(error, 'OPENING: '//trim(the_file) ) + + error=nf90_inq_dimid(ncid, 'time', id_time) + call netcdf_err(error, 'INQ TIME DIMENSION') + error=nf90_inquire_dimension(ncid, id_time, len=num_times) + call netcdf_err(error, 'READING TIME DIMENSION') + print*,'- FILE CONTAINS ', num_times, ' TIME RECORDS.' + + allocate(dummy(i_target,j_target,num_times)) + error=nf90_inq_varid(ncid, field, id_var) + call netcdf_err(error, 'READING FIELD ID' ) + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'READING FIELD' ) + + if (num_times > 1) then + allocate (days_since(num_times)) + error=nf90_inq_varid(ncid, 'time', id_time) + error=nf90_get_var(ncid, id_time, days_since) + print*,'- TIME RECORDS (DAYS SINCE): ', days_since + idat = 0 + idat(1) = 2015 + idat(2) = 1 + idat(3) = 1 + idat(5) = 0 + jdat = 0 + jdat(1) = 2015 + jdat(2) = cycle_mon + jdat(3) = cycle_day + jdat(5) = cycle_hour + call w3difdat(jdat,idat,1,rinc) + do n = 1, num_times + if (rinc(1) <= days_since(n)) exit + enddo + bound2 = n + bound1 = n - 1 + if (bound1 == 0) bound1 = num_times + if (bound2 == num_times+1) bound2 = 1 + print*,"- BOUNDING TIME RECORDS: ", bound1, bound2 + if (bound2 /= 1) then + num_days = float(days_since(bound2)) - float(days_since(bound1)) + num_days_rec1 = rinc(1) - float(days_since(bound1)) + weight_rec2 = num_days_rec1 / num_days + weight_rec1 = 1.0 - weight_rec2 + print*,"- BOUNDING WEIGHTS ", weight_rec1, weight_rec2 + else + num_days = (float(days_since(bound2)) + 1.0) + (365.0 - float(days_since(bound1)) - 1.0) + if (rinc(1) >= days_since(bound1)) then + num_days_rec1 = rinc(1) - float(days_since(bound1)) + else + num_days_rec1 = (365.0 - float(days_since(bound1))) + rinc(1) + endif + weight_rec2 = num_days_rec1 / num_days + weight_rec1 = 1.0 - weight_rec2 + print*,"- BOUNDING WEIGHTS ", weight_rec1, weight_rec2 + endif + + do j = 1, j_target + do i = 1, i_target + data_one_tile(i,j) = (weight_rec1*dummy(i,j,bound1)) + (weight_rec2*dummy(i,j,bound2)) + enddo + enddo + + deallocate(days_since) + + else ! file contains only one time record + + data_one_tile = dummy(:,:,1) + + endif + + if (trim(field) == 'vegetation_greenness') then + + do j = 1, j_target + do i = 1, i_target + max_data_one_tile(i,j) = maxval(dummy(i,j,:)) + min_data_one_tile(i,j) = minval(dummy(i,j,:)) + enddo + enddo + + endif + + deallocate(dummy) + + error = nf90_close(ncid) + + end subroutine read_static_file + + subroutine cleanup_static_fields + + implicit none + + integer :: rc + + print*,"- DESTROY STATIC FIELDS." + + call ESMF_FieldDestroy(alvsf_target_grid, rc=rc) + call ESMF_FieldDestroy(alvwf_target_grid, rc=rc) + call ESMF_FieldDestroy(alnsf_target_grid, rc=rc) + call ESMF_FieldDestroy(alnwf_target_grid, rc=rc) + call ESMF_FieldDestroy(facsf_target_grid, rc=rc) + call ESMF_FieldDestroy(facwf_target_grid, rc=rc) + call ESMF_FieldDestroy(max_veg_greenness_target_grid, rc=rc) + call ESMF_FieldDestroy(min_veg_greenness_target_grid, rc=rc) + call ESMF_FieldDestroy(mxsno_albedo_target_grid, rc=rc) + call ESMF_FieldDestroy(slope_type_target_grid, rc=rc) + call ESMF_FieldDestroy(soil_type_target_grid, rc=rc) + call ESMF_FieldDestroy(substrate_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(veg_greenness_target_grid, rc=rc) + call ESMF_FieldDestroy(veg_type_target_grid, rc=rc) + + end subroutine cleanup_static_fields + + end module static_data diff --git a/sorc/coldstart.fd/surface.F90 b/sorc/coldstart.fd/surface.F90 new file mode 100644 index 000000000..ce1b64198 --- /dev/null +++ b/sorc/coldstart.fd/surface.F90 @@ -0,0 +1,3797 @@ + module surface + +!-------------------------------------------------------------------------- +! Module surface +! +! Abstract: Process surface and nst fields. Interpolates fields from +! the input to target grids. Adjusts soil temperature according +! to differences in input and target grid terrain. Rescales +! soil moisture for soil type differences between input and target +! grid. Computes frozen portion of total soil moisture. +! +! Public Subroutines: +! ----------------- +! surface_driver Driver routine to process surface/nst data +! +! Public variables: +! ----------------- +! Defined below. "target" indicates field associated with the target grid. +! "input" indicates field associated with the input grid. +! +!-------------------------------------------------------------------------- + + use esmf + + implicit none + + private + +! noah land ice option is applied at these vegetation types. + integer, parameter :: veg_type_landice_target = 15 + +! surface fields (not including nst) + type(esmf_field), public :: canopy_mc_target_grid + ! canopy moisture content + type(esmf_field), public :: f10m_target_grid + ! log((z0+10)*1/z0) + ! See sfc_diff.f for details + type(esmf_field), public :: ffmm_target_grid + ! log((z0+z1)*1/z0) + ! See sfc_diff.f for details + type(esmf_field), public :: q2m_target_grid + ! 2-m specific humidity + type(esmf_field), public :: seaice_depth_target_grid + ! sea ice depth + type(esmf_field), public :: seaice_fract_target_grid + ! sea ice fraction + type(esmf_field), public :: seaice_skin_temp_target_grid + ! sea ice skin temperature + type(esmf_field), public :: skin_temp_target_grid + ! skin temperature/sst + type(esmf_field), public :: srflag_target_grid + ! snow/rain flag + type(esmf_field), public :: snow_liq_equiv_target_grid + ! liquid equiv snow depth + type(esmf_field), public :: snow_depth_target_grid + ! physical snow depth + type(esmf_field), public :: soil_temp_target_grid + ! 3-d soil temperature + type(esmf_field), public :: soilm_liq_target_grid + ! 3-d liquid soil moisture + type(esmf_field), public :: soilm_tot_target_grid + ! 3-d total soil moisture + type(esmf_field), public :: t2m_target_grid + ! 2-m temperatrure + type(esmf_field), public :: tprcp_target_grid + ! precip + type(esmf_field), public :: ustar_target_grid + ! friction velocity + type(esmf_field), public :: z0_target_grid + ! roughness length + +! nst fields + type(esmf_field), public :: c_d_target_grid + type(esmf_field), public :: c_0_target_grid + type(esmf_field), public :: d_conv_target_grid + type(esmf_field), public :: dt_cool_target_grid + type(esmf_field), public :: ifd_target_grid + type(esmf_field), public :: qrain_target_grid + type(esmf_field), public :: tref_target_grid + ! reference temperature + type(esmf_field), public :: w_d_target_grid + type(esmf_field), public :: w_0_target_grid + type(esmf_field), public :: xs_target_grid + type(esmf_field), public :: xt_target_grid + type(esmf_field), public :: xu_target_grid + type(esmf_field), public :: xv_target_grid + type(esmf_field), public :: xz_target_grid + type(esmf_field), public :: xtts_target_grid + type(esmf_field), public :: xzts_target_grid + type(esmf_field), public :: z_c_target_grid + type(esmf_field), public :: zm_target_grid + + type(esmf_field) :: soil_type_from_input_grid + ! soil type interpolated from + ! input grid + type(esmf_field) :: terrain_from_input_grid + ! terrain height interpolated + ! from input grid + + real, parameter, private :: blim = 5.5 + ! soil 'b' parameter limit + real, parameter, private :: frz_h2o = 273.15 + ! melting pt water + real, parameter, private :: frz_ice = 271.21 + ! melting pt sea ice + real, parameter, private :: grav = 9.81 + ! gravity + real, parameter, private :: hlice = 3.335E5 + ! latent heat of fusion + + public :: surface_driver + + contains + + subroutine surface_driver(localpet) + + use input_data, only : cleanup_input_sfc_data, & + cleanup_input_nst_data, & + read_input_sfc_data, & + read_input_nst_data + + use program_setup, only : calc_soil_params_driver, & + convert_nst + + use static_data, only : get_static_fields, & + cleanup_static_fields + + implicit none + + integer, intent(in) :: localpet + +!----------------------------------------------------------------------- +! Compute soil-based parameters. +!----------------------------------------------------------------------- + + call calc_soil_params_driver(localpet) + +!----------------------------------------------------------------------- +! Get static data (like vegetation type) on the target grid. +!----------------------------------------------------------------------- + + call get_static_fields(localpet) + +!----------------------------------------------------------------------- +! Read surface data on input grid. +!----------------------------------------------------------------------- + + call read_input_sfc_data(localpet) + +!----------------------------------------------------------------------- +! Read nst data on input grid. +!----------------------------------------------------------------------- + + if (convert_nst) call read_input_nst_data(localpet) + +!----------------------------------------------------------------------- +! Create surface field objects for target grid. +!----------------------------------------------------------------------- + + call create_surface_esmf_fields + +!----------------------------------------------------------------------- +! Create nst field objects for target grid. +!----------------------------------------------------------------------- + + if (convert_nst) call create_nst_esmf_fields + +!----------------------------------------------------------------------- +! Horizontally interpolate fields. +!----------------------------------------------------------------------- + + call interp(localpet) + +!--------------------------------------------------------------------------------------------- +! Adjust soil/landice column temperatures for any change in elevation between the +! input and target grids. +!--------------------------------------------------------------------------------------------- + + call adjust_soilt_for_terrain + +!--------------------------------------------------------------------------------------------- +! Rescale soil moisture for changes in soil type between the input and target grids. +!--------------------------------------------------------------------------------------------- + + call rescale_soil_moisture + +!--------------------------------------------------------------------------------------------- +! Compute liquid portion of total soil moisture. +!--------------------------------------------------------------------------------------------- + + call calc_liq_soil_moisture + +!--------------------------------------------------------------------------------------------- +! Set z0 at land and sea ice. +!--------------------------------------------------------------------------------------------- + + call roughness + +!--------------------------------------------------------------------------------------------- +! Perform some final qc checks. +!--------------------------------------------------------------------------------------------- + + call qc_check + +!--------------------------------------------------------------------------------------------- +! Set flag values at land for nst fields. +!--------------------------------------------------------------------------------------------- + + if (convert_nst) call nst_land_fill + +!--------------------------------------------------------------------------------------------- +! Free up memory. +!--------------------------------------------------------------------------------------------- + + call cleanup_input_sfc_data + + if (convert_nst) call cleanup_input_nst_data + +!--------------------------------------------------------------------------------------------- +! Write data to file. +!--------------------------------------------------------------------------------------------- + + call write_fv3_sfc_data_netcdf(localpet) + +!--------------------------------------------------------------------------------------------- +! Free up memory. +!--------------------------------------------------------------------------------------------- + + if (convert_nst) call cleanup_target_nst_data + + call cleanup_target_sfc_data + + call cleanup_static_fields + + return + + end subroutine surface_driver + +!--------------------------------------------------------------------------------------------- +! Horizontally interpolate surface fields using esmf routines. +!--------------------------------------------------------------------------------------------- + + subroutine interp(localpet) + + use mpi + use esmf + + use input_data, only : canopy_mc_input_grid, & + f10m_input_grid, & + ffmm_input_grid, & + landsea_mask_input_grid, & + q2m_input_grid, & + seaice_depth_input_grid, & + seaice_fract_input_grid, & + seaice_skin_temp_input_grid, & + skin_temp_input_grid, & + snow_depth_input_grid, & + snow_liq_equiv_input_grid, & + soil_temp_input_grid, & + soil_type_input_grid, & + soilm_tot_input_grid, & + srflag_input_grid, & + t2m_input_grid, & + tprcp_input_grid, & + ustar_input_grid, & + veg_type_input_grid, & + z0_input_grid, & + c_d_input_grid, & + c_0_input_grid, & + d_conv_input_grid, & + dt_cool_input_grid, & + ifd_input_grid, & + qrain_input_grid, & + tref_input_grid, & + w_d_input_grid, & + w_0_input_grid, & + xs_input_grid, & + xt_input_grid, & + xu_input_grid, & + xv_input_grid, & + xz_input_grid, & + xtts_input_grid, & + xzts_input_grid, & + z_c_input_grid, & + zm_input_grid, terrain_input_grid, & + veg_type_landice_input + + use model_grid, only : input_grid, target_grid, & + i_target, j_target, & + lsoil_target, & + num_tiles_target_grid, & + landmask_target_grid, & + seamask_target_grid, & + latitude_target_grid + + use program_setup, only : convert_nst, input_type + + use static_data, only : veg_type_target_grid, & + soil_type_target_grid + + use search_util + + implicit none + + integer, intent(in) :: localpet + + integer :: l(1), u(1) + integer :: i, j, ij, rc, tile + integer :: clb_target(2), cub_target(2) + integer :: isrctermprocessing + integer(esmf_kind_i4), pointer :: unmapped_ptr(:) + integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:) + integer(esmf_kind_i4), pointer :: mask_target_ptr(:,:) + integer(esmf_kind_i8), pointer :: landmask_target_ptr(:,:) + integer(esmf_kind_i8), allocatable :: mask_target_one_tile(:,:) + integer(esmf_kind_i8), allocatable :: water_target_one_tile(:,:) + integer(esmf_kind_i8), allocatable :: land_target_one_tile(:,:) + integer(esmf_kind_i8), pointer :: seamask_target_ptr(:,:) + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile2(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) + real(esmf_kind_r8), pointer :: canopy_mc_target_ptr(:,:) + real(esmf_kind_r8), pointer :: c_d_target_ptr(:,:) + real(esmf_kind_r8), pointer :: c_0_target_ptr(:,:) + real(esmf_kind_r8), pointer :: d_conv_target_ptr(:,:) + real(esmf_kind_r8), pointer :: dt_cool_target_ptr(:,:) + real(esmf_kind_r8), pointer :: ifd_target_ptr(:,:) + real(esmf_kind_r8), pointer :: qrain_target_ptr(:,:) + real(esmf_kind_r8), pointer :: tref_target_ptr(:,:) + real(esmf_kind_r8), pointer :: w_d_target_ptr(:,:) + real(esmf_kind_r8), pointer :: w_0_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xs_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xt_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xu_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xv_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xz_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xtts_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xzts_target_ptr(:,:) + real(esmf_kind_r8), pointer :: z_c_target_ptr(:,:) + real(esmf_kind_r8), pointer :: zm_target_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_depth_target_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_fract_target_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_skin_temp_target_ptr(:,:) + real(esmf_kind_r8), pointer :: skin_temp_target_ptr(:,:) + real(esmf_kind_r8), pointer :: snow_depth_target_ptr(:,:) + real(esmf_kind_r8), pointer :: snow_liq_equiv_target_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_type_from_input_ptr(:,:) + real(esmf_kind_r8), pointer :: soilm_tot_target_ptr(:,:,:) + real(esmf_kind_r8), pointer :: srflag_target_ptr(:,:) + real(esmf_kind_r8), pointer :: terrain_from_input_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:) + real(esmf_kind_r8), pointer :: z0_target_ptr(:,:) + real(esmf_kind_r8), pointer :: landmask_input_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_input_ptr(:,:) + real(esmf_kind_r8), allocatable :: veg_type_target_one_tile(:,:) + + type(esmf_regridmethod_flag) :: method + type(esmf_routehandle) :: regrid_bl_no_mask + type(esmf_routehandle) :: regrid_all_land + type(esmf_routehandle) :: regrid_land + type(esmf_routehandle) :: regrid_landice + type(esmf_routehandle) :: regrid_nonland + type(esmf_routehandle) :: regrid_seaice + type(esmf_routehandle) :: regrid_water + +!----------------------------------------------------------------------- +! Interpolate fieids that do not require 'masked' interpolation. +!----------------------------------------------------------------------- + + method=ESMF_REGRIDMETHOD_BILINEAR + + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore FOR NON-MASKED BILINEAR INTERPOLATION." + call ESMF_FieldRegridStore(t2m_input_grid, & + t2m_target_grid, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + srctermprocessing=isrctermprocessing, & + routehandle=regrid_bl_no_mask, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid T2M." + call ESMF_FieldRegrid(t2m_input_grid, & + t2m_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid Q2M." + call ESMF_FieldRegrid(q2m_input_grid, & + q2m_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid TPRCP." + call ESMF_FieldRegrid(tprcp_input_grid, & + tprcp_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid F10M." + call ESMF_FieldRegrid(f10m_input_grid, & + f10m_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FFMM." + call ESMF_FieldRegrid(ffmm_input_grid, & + ffmm_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid USTAR." + call ESMF_FieldRegrid(ustar_input_grid, & + ustar_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid SRFLAG." + call ESMF_FieldRegrid(srflag_input_grid, & + srflag_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR SRFLAG." + call ESMF_FieldGet(srflag_target_grid, & + farrayPtr=srflag_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +!----------------------------------------------------------------------- +! This is a flag field. Using neighbor was expensive. So use +! bilinear and 'nint'. +!----------------------------------------------------------------------- + + srflag_target_ptr = nint(srflag_target_ptr) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl_no_mask, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!----------------------------------------------------------------------- +! Next, determine the sea ice fraction on target grid. +! +! First, set the mask on the target and input grids. +!----------------------------------------------------------------------- + + print*,"- CALL GridAddItem FOR TARGET GRID." + call ESMF_GridAddItem(target_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridAddItem", rc) + + print*,"- CALL GridGetItem FOR TARGET GRID." + call ESMF_GridGetItem(target_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + farrayPtr=mask_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetItem", rc) + + print*,"- CALL FieldGet FOR TARGET GRID SEAMASK." + call ESMF_FieldGet(seamask_target_grid, & + computationalLBound=clb_target, & + computationalUBound=cub_target, & + farrayPtr=seamask_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + mask_target_ptr = seamask_target_ptr + + print*,"- CALL GridAddItem FOR INPUT GRID SEAMASK." + call ESMF_GridAddItem(input_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridAddItem", rc) + + print*,"- CALL FieldGet FOR INPUT GRID LANDMASK." + call ESMF_FieldGet(landsea_mask_input_grid, & + farrayPtr=landmask_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL GridGetItem FOR INPUT GRID LANDMASK." + call ESMF_GridGetItem(input_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + farrayPtr=mask_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetItem", rc) + + mask_input_ptr = 1 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 0 + +!----------------------------------------------------------------------- +! Interpolate. +!----------------------------------------------------------------------- + + if (localpet == 0) then + allocate(data_one_tile(i_target,j_target)) + allocate(data_one_tile2(i_target,j_target)) + allocate(data_one_tile_3d(i_target,j_target,lsoil_target)) + allocate(mask_target_one_tile(i_target,j_target)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile2(0,0)) + allocate(data_one_tile_3d(0,0,0)) + allocate(mask_target_one_tile(0,0)) + endif + + method=ESMF_REGRIDMETHOD_CONSERVE + + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for sea ice fraction." + call ESMF_FieldRegridStore(seaice_fract_input_grid, & + seaice_fract_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_nonland, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for sea ice fraction." + call ESMF_FieldRegrid(seaice_fract_input_grid, & + seaice_fract_target_grid, & + routehandle=regrid_nonland, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid sea ice fraction." + call ESMF_FieldGet(seaice_fract_target_grid, & + farrayPtr=seaice_fract_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + seaice_fract_target_ptr(i,j) = -9999.9 ! flag value for missing point + ! which will be replaced in routine + ! "search". + enddo + + if (localpet == 0) then + allocate(latitude_one_tile(i_target,j_target)) + else + allocate(latitude_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE FRACTION TILE: ", tile + call ESMF_FieldGather(seaice_fract_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET GRID MASK TILE: ", tile + call ESMF_FieldGather(seamask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 91, & + latitude=latitude_one_tile) + endif + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + + if (localpet == 0) then + do j = 1, j_target + do i = 1, i_target + if (data_one_tile(i,j) > 1.0_esmf_kind_r8) then + data_one_tile(i,j) = 1.0_esmf_kind_r8 + endif + if (data_one_tile(i,j) < 0.15_esmf_kind_r8) data_one_tile(i,j) = 0.0_esmf_kind_r8 + if (data_one_tile(i,j) >= 0.15_esmf_kind_r8) mask_target_one_tile(i,j) = 2 + enddo + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE FRACTION TILE: ", tile + call ESMF_FieldScatter(seaice_fract_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldScatter(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + deallocate(latitude_one_tile) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_nonland, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate other sea ice related fields. Since we know what points are ice on +! the target grid, reset the target grid mask. +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 2) mask_input_ptr = 1 + + print*,"- CALL FieldGet FOR TARGET land sea mask." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + mask_target_ptr = 0 + do j = clb_target(2), cub_target(2) + do i = clb_target(1), cub_target(1) + if (landmask_target_ptr(i,j) == 2) mask_target_ptr(i,j) = 1 + enddo + enddo + + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for 3d seaice fields." + call ESMF_FieldRegridStore(soil_temp_input_grid, & + soil_temp_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_seaice, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for soil temperature over seaice." + call ESMF_FieldRegrid(soil_temp_input_grid, & + soil_temp_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for sea ice depth." + call ESMF_FieldRegrid(seaice_depth_input_grid, & + seaice_depth_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid sea ice depth." + call ESMF_FieldGet(seaice_depth_target_grid, & + farrayPtr=seaice_depth_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for snow depth." + call ESMF_FieldRegrid(snow_depth_input_grid, & + snow_depth_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid snow depth." + call ESMF_FieldGet(snow_depth_target_grid, & + farrayPtr=snow_depth_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for snow liq equiv." + call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & + snow_liq_equiv_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid snow liq equiv." + call ESMF_FieldGet(snow_liq_equiv_target_grid, & + farrayPtr=snow_liq_equiv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for sea ice skin temp." + call ESMF_FieldRegrid(seaice_skin_temp_input_grid, & + seaice_skin_temp_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid sea ice skin temp." + call ESMF_FieldGet(seaice_skin_temp_target_grid, & + farrayPtr=seaice_skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + seaice_depth_target_ptr(i,j) = -9999.9 + snow_depth_target_ptr(i,j) = -9999.9 + snow_liq_equiv_target_ptr(i,j) = -9999.9 + seaice_skin_temp_target_ptr(i,j) = -9999.9 + soil_temp_target_ptr(i,j,:) = -9999.9 + enddo + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE DEPTH TILE: ", tile + call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + where(mask_target_one_tile == 1) mask_target_one_tile = 0 + where(mask_target_one_tile == 2) mask_target_one_tile = 1 + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 92) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE DEPTH TILE: ", tile + call ESMF_FieldScatter(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 66) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile + call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 65) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile + call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE SKIN TEMP: ", tile + call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE SKIN TEMP: ", tile + call ESMF_FieldScatter(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE COLUMN TEMP: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile + call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_seaice, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate water fields. +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 0) mask_input_ptr = 1 + + mask_target_ptr = 0 + where (landmask_target_ptr == 0) mask_target_ptr = 1 + + method=ESMF_REGRIDMETHOD_CONSERVE + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for water fields." + call ESMF_FieldRegridStore(skin_temp_input_grid, & + skin_temp_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_water, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for skin temperature over water." + call ESMF_FieldRegrid(skin_temp_input_grid, & + skin_temp_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET skin temperature." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for z0 over water." + call ESMF_FieldRegrid(z0_input_grid, & + z0_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET z0." + call ESMF_FieldGet(z0_target_grid, & + farrayPtr=z0_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + skin_temp_target_ptr(i,j) = -9999.9 + z0_target_ptr(i,j) = -9999.9 + enddo + + if (convert_nst) then + + print*,"- CALL Field_Regrid for c_d over water." + call ESMF_FieldRegrid(c_d_input_grid, & + c_d_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for c_0 over water." + call ESMF_FieldRegrid(c_0_input_grid, & + c_0_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for d_conv over water." + call ESMF_FieldRegrid(d_conv_input_grid, & + d_conv_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for dt_cool over water." + call ESMF_FieldRegrid(dt_cool_input_grid, & + dt_cool_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for ifd over water." + call ESMF_FieldRegrid(ifd_input_grid, & + ifd_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for qrain over water." + call ESMF_FieldRegrid(qrain_input_grid, & + qrain_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for tref over water." + call ESMF_FieldRegrid(tref_input_grid, & + tref_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for w_d over water." + call ESMF_FieldRegrid(w_d_input_grid, & + w_d_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for w_0 over water." + call ESMF_FieldRegrid(w_0_input_grid, & + w_0_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xs over water." + call ESMF_FieldRegrid(xs_input_grid, & + xs_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xt over water." + call ESMF_FieldRegrid(xt_input_grid, & + xt_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xu over water." + call ESMF_FieldRegrid(xu_input_grid, & + xu_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xv over water." + call ESMF_FieldRegrid(xv_input_grid, & + xv_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xz over water." + call ESMF_FieldRegrid(xz_input_grid, & + xz_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xtts over water." + call ESMF_FieldRegrid(xtts_input_grid, & + xtts_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xzts over water." + call ESMF_FieldRegrid(xzts_input_grid, & + xzts_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for z_c over water." + call ESMF_FieldRegrid(z_c_input_grid, & + z_c_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for zm over water." + call ESMF_FieldRegrid(zm_input_grid, & + zm_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + +! Tag unmapped points + + print*,"- CALL FieldGet FOR TARGET c_d." + call ESMF_FieldGet(c_d_target_grid, & + farrayPtr=c_d_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET c_0." + call ESMF_FieldGet(c_0_target_grid, & + farrayPtr=c_0_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET d_conv." + call ESMF_FieldGet(d_conv_target_grid, & + farrayPtr=d_conv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET dt_cool." + call ESMF_FieldGet(dt_cool_target_grid, & + farrayPtr=dt_cool_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET ifd." + call ESMF_FieldGet(ifd_target_grid, & + farrayPtr=ifd_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + ifd_target_ptr = float(nint(ifd_target_ptr)) + + print*,"- CALL FieldGet FOR TARGET qrain." + call ESMF_FieldGet(qrain_target_grid, & + farrayPtr=qrain_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET tref." + call ESMF_FieldGet(tref_target_grid, & + farrayPtr=tref_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET w_d." + call ESMF_FieldGet(w_d_target_grid, & + farrayPtr=w_d_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET w_0." + call ESMF_FieldGet(w_0_target_grid, & + farrayPtr=w_0_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xs." + call ESMF_FieldGet(xs_target_grid, & + farrayPtr=xs_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xt." + call ESMF_FieldGet(xt_target_grid, & + farrayPtr=xt_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xu." + call ESMF_FieldGet(xu_target_grid, & + farrayPtr=xu_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xv." + call ESMF_FieldGet(xv_target_grid, & + farrayPtr=xv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xz." + call ESMF_FieldGet(xz_target_grid, & + farrayPtr=xz_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xtts." + call ESMF_FieldGet(xtts_target_grid, & + farrayPtr=xtts_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xzts." + call ESMF_FieldGet(xzts_target_grid, & + farrayPtr=xzts_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET z_c." + call ESMF_FieldGet(z_c_target_grid, & + farrayPtr=z_c_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET zm." + call ESMF_FieldGet(zm_target_grid, & + farrayPtr=zm_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + c_d_target_ptr(i,j) = -9999.9 + c_0_target_ptr(i,j) = -9999.9 + d_conv_target_ptr(i,j) = -9999.9 + dt_cool_target_ptr(i,j) = -9999.9 + ifd_target_ptr(i,j) = -9999.9 + qrain_target_ptr(i,j) = -9999.9 + tref_target_ptr(i,j) = -9999.9 + w_d_target_ptr(i,j) = -9999.9 + w_0_target_ptr(i,j) = -9999.9 + xs_target_ptr(i,j) = -9999.9 + xt_target_ptr(i,j) = -9999.9 + xu_target_ptr(i,j) = -9999.9 + xv_target_ptr(i,j) = -9999.9 + xz_target_ptr(i,j) = -9999.9 + xtts_target_ptr(i,j) = -9999.9 + xzts_target_ptr(i,j) = -9999.9 + z_c_target_ptr(i,j) = -9999.9 + zm_target_ptr(i,j) = -9999.9 + enddo + + endif + + if (localpet == 0) then + allocate(latitude_one_tile(i_target,j_target)) + else + allocate(latitude_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + +! skin temp + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + allocate(water_target_one_tile(i_target,j_target)) + water_target_one_tile = 0 + where(mask_target_one_tile == 0) water_target_one_tile = 1 + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & + latitude=latitude_one_tile) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP: ", tile + call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! z0 + + print*,"- CALL FieldGather FOR TARGET GRID Z0 TILE: ", tile + call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 83) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID Z0: ", tile + call ESMF_FieldScatter(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (convert_nst) then + +! c_d + + print*,"- CALL FieldGather FOR TARGET GRID C_D TILE: ", tile + call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID C_D: ", tile + call ESMF_FieldScatter(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! c_0 + + print*,"- CALL FieldGather FOR TARGET GRID C_0 TILE: ", tile + call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID C_0: ", tile + call ESMF_FieldScatter(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! d_conv + + print*,"- CALL FieldGather FOR TARGET GRID D_CONV TILE: ", tile + call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID D_CONV: ", tile + call ESMF_FieldScatter(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! dt_cool + + print*,"- CALL FieldGather FOR TARGET GRID DT_COOL TILE: ", tile + call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID DT_COOL: ", tile + call ESMF_FieldScatter(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! ifd + + print*,"- CALL FieldGather FOR TARGET GRID IFD TILE: ", tile + call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 1) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID IFD: ", tile + call ESMF_FieldScatter(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! qrain + + print*,"- CALL FieldGather FOR TARGET GRID QRAIN TILE: ", tile + call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID QRAIN: ", tile + call ESMF_FieldScatter(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! tref + + print*,"- CALL FieldGather FOR TARGET GRID TREF TILE: ", tile + call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & + latitude=latitude_one_tile) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID TREF: ", tile + call ESMF_FieldScatter(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! w_d + + print*,"- CALL FieldGather FOR TARGET GRID W_D TILE: ", tile + call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID W_D: ", tile + call ESMF_FieldScatter(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! w_0 + + print*,"- CALL FieldGather FOR TARGET GRID W_0 TILE: ", tile + call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID W_0: ", tile + call ESMF_FieldScatter(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xs + + print*,"- CALL FieldGather FOR TARGET GRID XS TILE: ", tile + call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XS: ", tile + call ESMF_FieldScatter(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xt + + print*,"- CALL FieldGather FOR TARGET GRID XT TILE: ", tile + call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XT: ", tile + call ESMF_FieldScatter(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xu + + print*,"- CALL FieldGather FOR TARGET GRID XU TILE: ", tile + call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XU: ", tile + call ESMF_FieldScatter(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xv + + print*,"- CALL FieldGather FOR TARGET GRID XV TILE: ", tile + call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XV: ", tile + call ESMF_FieldScatter(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xz + + print*,"- CALL FieldGather FOR TARGET GRID XZ TILE: ", tile + call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 30) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XZ: ", tile + call ESMF_FieldScatter(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xtts + + print*,"- CALL FieldGather FOR TARGET GRID XTTS TILE: ", tile + call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XTTS: ", tile + call ESMF_FieldScatter(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! xzts + + print*,"- CALL FieldGather FOR TARGET GRID XZTS TILE: ", tile + call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XZTS: ", tile + call ESMF_FieldScatter(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! z_c + + print*,"- CALL FieldGather FOR TARGET GRID Z_C TILE: ", tile + call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID Z_C: ", tile + call ESMF_FieldScatter(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + +! zm + + print*,"- CALL FieldGather FOR TARGET GRID ZM TILE: ", tile + call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID ZM: ", tile + call ESMF_FieldScatter(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + endif + + if (localpet == 0) deallocate(water_target_one_tile) + + enddo + + deallocate(latitude_one_tile) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_water, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice. +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 + + mask_target_ptr = 0 + where (landmask_target_ptr == 1) mask_target_ptr = 1 + + method=ESMF_REGRIDMETHOD_CONSERVE + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for land fields." + call ESMF_FieldRegridStore(snow_depth_input_grid, & + snow_depth_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_all_land, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for snow depth over land." + call ESMF_FieldRegrid(snow_depth_input_grid, & + snow_depth_target_grid, & + routehandle=regrid_all_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, & ! flag needed so snow over sea + ! ice is not zeroed out. + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for snow liq equiv over land." + call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & + snow_liq_equiv_target_grid, & + routehandle=regrid_all_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for canopy mc." + call ESMF_FieldRegrid(canopy_mc_input_grid, & + canopy_mc_target_grid, & + routehandle=regrid_all_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET snow depth." + call ESMF_FieldGet(snow_depth_target_grid, & + farrayPtr=snow_depth_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET snow liq equiv." + call ESMF_FieldGet(snow_liq_equiv_target_grid, & + farrayPtr=snow_liq_equiv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET canopy moisture." + call ESMF_FieldGet(canopy_mc_target_grid, & + farrayPtr=canopy_mc_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + snow_depth_target_ptr(i,j) = -9999.9 + snow_liq_equiv_target_ptr(i,j) = -9999.9 + canopy_mc_target_ptr(i,j) = -9999.9 + enddo + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + allocate(land_target_one_tile(i_target,j_target)) + land_target_one_tile = 0 + where(mask_target_one_tile == 1) land_target_one_tile = 1 + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 66) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH: ", tile + call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQUID EQUIV: ", tile + call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 65) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQUID EQUIV: ", tile + call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID CANOPY MC: ", tile + call ESMF_FieldGather(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 223) + deallocate(land_target_one_tile) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID CANOPY MC: ", tile + call ESMF_FieldScatter(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_all_land, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate landice points to landice points. +!--------------------------------------------------------------------------------------------- + + print*,"- CALL FieldGet FOR INPUT GRID VEG TYPE." + call ESMF_FieldGet(veg_type_input_grid, & + farrayPtr=veg_type_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,'land ice check ',veg_type_landice_input + + mask_input_ptr = 0 + where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 1 + + print*,"- CALL FieldGet FOR TARGET GRID VEG TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + mask_target_ptr = 0 + where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 1 + + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for landice fields." + call ESMF_FieldRegridStore(soil_temp_input_grid, & + soil_temp_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_landice, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for soil temperature over landice." + call ESMF_FieldRegrid(soil_temp_input_grid, & + soil_temp_target_grid, & + routehandle=regrid_landice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for skin temperature over landice." + call ESMF_FieldRegrid(skin_temp_input_grid, & + skin_temp_target_grid, & + routehandle=regrid_landice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for terrain over landice." + call ESMF_FieldRegrid(terrain_input_grid, & + terrain_from_input_grid, & + routehandle=regrid_landice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid column temperature over landice." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET skin temperature." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR terrain from input grid." + call ESMF_FieldGet(terrain_from_input_grid, & + farrayPtr=terrain_from_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + soil_temp_target_ptr(i,j,:) = -9999.9 + skin_temp_target_ptr(i,j) = -9999.9 + terrain_from_input_ptr(i,j) = -9999.9 + enddo + + if (localpet == 0) then + allocate (veg_type_target_one_tile(i_target,j_target)) + allocate (land_target_one_tile(i_target,j_target)) + else + allocate (veg_type_target_one_tile(0,0)) + allocate (land_target_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMP TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile + call ESMF_FieldGather(veg_type_target_grid, veg_type_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + land_target_one_tile = 0 + where(nint(veg_type_target_one_tile) == veg_type_landice_target) land_target_one_tile = 1 + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP, TILE: ", tile + call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 7) + endif + + print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID LANDICE COLUMN TEMP: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile + call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + deallocate (veg_type_target_one_tile) + deallocate (land_target_one_tile) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_landice, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate land (not including landice pts) to land (not including landice). +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 + where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 0 + + mask_target_ptr = 0 + where (landmask_target_ptr == 1) mask_target_ptr = 1 + where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0 + + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields." + call ESMF_FieldRegridStore(soilm_tot_input_grid, & + soilm_tot_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_land, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for total soil moisture over land." + call ESMF_FieldRegrid(soilm_tot_input_grid, & + soilm_tot_target_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for soil temperature over land." + call ESMF_FieldRegrid(soil_temp_input_grid, & + soil_temp_target_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for skin temperature over land." + call ESMF_FieldRegrid(skin_temp_input_grid, & + skin_temp_target_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for terrain over land." + call ESMF_FieldRegrid(terrain_input_grid, & + terrain_from_input_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for soil type over land." + call ESMF_FieldRegrid(soil_type_input_grid, & + soil_type_from_input_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid total soil moisture over land." + call ESMF_FieldGet(soilm_tot_target_grid, & + farrayPtr=soilm_tot_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET grid soil temp over ice." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET skin temperature." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR terrain from input grid." + call ESMF_FieldGet(terrain_from_input_grid, & + farrayPtr=terrain_from_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR soil type from input grid." + call ESMF_FieldGet(soil_type_from_input_grid, & + farrayPtr=soil_type_from_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + soilm_tot_target_ptr(i,j,:) = -9999.9 + soil_temp_target_ptr(i,j,:) = -9999.9 + skin_temp_target_ptr(i,j) = -9999.9 + terrain_from_input_ptr(i,j) = -9999.9 + soil_type_from_input_ptr(i,j) = -9999.9 + enddo + + if (localpet == 0) then + allocate (veg_type_target_one_tile(i_target,j_target)) + else + allocate (veg_type_target_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile + call ESMF_FieldGather(veg_type_target_grid, veg_type_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + where(nint(veg_type_target_one_tile) == veg_type_landice_target) mask_target_one_tile = 0 + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 7) + endif + + print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile + call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile + call ESMF_FieldGather(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile + call ESMF_FieldGather(soil_type_target_grid, data_one_tile2, rootPet=0,tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + +!--------------------------------------------------------------------------------------- +! grib2 data does not have soil type. Set soil type interpolated from input +! grid to the target (model) grid soil type. This turns off the soil moisture +! rescaling. +!--------------------------------------------------------------------------------------- + + if (localpet == 0) then + if (trim(input_type) .ne. "grib2") then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 224) + else + data_one_tile = data_one_tile2 + endif + endif + + print*,"- CALL FieldScatter FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile + call ESMF_FieldScatter(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile + call ESMF_FieldGather(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 86) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile + call ESMF_FieldScatter(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile + call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_land, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", rc) + + deallocate(veg_type_target_one_tile) + + deallocate(data_one_tile, data_one_tile2) + deallocate(data_one_tile_3d) + deallocate(mask_target_one_tile) + + return + + end subroutine interp + +!--------------------------------------------------------------------------------------------- +! Compute liquid portion of the total soil moisture. +!--------------------------------------------------------------------------------------------- + + subroutine calc_liq_soil_moisture + + use esmf + + use model_grid, only : landmask_target_grid + + use program_setup, only : maxsmc_target, & + bb_target, & + satpsi_target + + use static_data, only : soil_type_target_grid, & + veg_type_target_grid + + implicit none + + integer :: clb(3), cub(3), rc + integer :: i, j, n, soil_type + + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real :: bx, fk + real(esmf_kind_r8), pointer :: soilm_liq_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_temp_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_type_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + + print*,"- COMPUTE LIQUID PORTION OF TOTAL SOIL MOISTURE." + + print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE." + call ESMF_FieldGet(soilm_tot_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=soilm_tot_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LIQUID SOIL MOISTURE." + call ESMF_FieldGet(soilm_liq_target_grid, & + farrayPtr=soilm_liq_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TEMPERATURE." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TYPE." + call ESMF_FieldGet(soil_type_target_grid, & + farrayPtr=soil_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LANDMASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + +!--------------------------------------------------------------------------------------------- +! Check land points that are not permanent land ice. +!--------------------------------------------------------------------------------------------- + + if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then + + soil_type = nint(soil_type_ptr(i,j)) + + do n = clb(3), cub(3) + + if (soil_temp_ptr(i,j,n) < (frz_h2o-0.0001)) then + + bx = bb_target(soil_type) + + if (bx .gt. blim) bx = blim + + fk=(((hlice/(grav*(-satpsi_target(soil_type))))* & + ((soil_temp_ptr(i,j,n)-frz_h2o)/soil_temp_ptr(i,j,n)))** & + (-1/bx))*maxsmc_target(soil_type) + + if (fk .lt. 0.02) fk = 0.02 + + soilm_liq_ptr(i,j,n) = min ( fk, soilm_tot_ptr(i,j,n) ) + +!----------------------------------------------------------------------- +! now use iterative solution for liquid soil water content using +! FUNCTION FRH2O with the initial guess for SH2O from above explicit +! first guess. +!----------------------------------------------------------------------- + + soilm_liq_ptr(i,j,n) = frh2O(soil_temp_ptr(i,j,n), & + soilm_tot_ptr(i,j,n), soilm_liq_ptr(i,j,n), & + maxsmc_target(soil_type),bb_target(soil_type), & + satpsi_target(soil_type)) + + else ! temp above freezing. all moisture is liquid + + soilm_liq_ptr(i,j,n) = soilm_tot_ptr(i,j,n) + + end if ! is soil layer below freezing? + + enddo ! soil layer + + end if ! is this point land? + + enddo + enddo + + end subroutine calc_liq_soil_moisture + + FUNCTION FRH2O (TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS) +!$$$ function documentation block +! +! function: frh2o +! prgmmr: gayno org: w/np2 date: 2005-05-20 +! +! abstract: calculate supercooled soil moisture +! +! program history log: +! 2005-05-20 gayno - initial version +! +! usage: x = frh2o (tkelv,smc,sh2o,smcmax,bexp,psis) +! +! input argument list: +! tkelv - temperature (Kelvin) +! smc - total soil moisture content (volumetric) +! sh2O - liquid soil moisture content (volumetric) +! smcmax - saturation soil moisture content +! b - soil type "b" parameter +! psis - saturated soil matric potential +! +! output argument list: +! frh2O - supercooled liquid water content +! +! remarks: stolen from noah lsm code +! +! CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT IF +! TEMPERATURE IS BELOW 273.15K (T0). REQUIRES NEWTON-TYPE ITERATION TO +! SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF KOREN ET AL +! (1999, JGR, VOL 104(D16), 19569-19585). +! +! NEW VERSION (JUNE 2001): MUCH FASTER AND MORE ACCURATE NEWTON +! ITERATION ACHIEVED BY FIRST TAKING LOG OF EQN CITED ABOVE -- LESS THAN +! 4 (TYPICALLY 1 OR 2) ITERATIONS ACHIEVES CONVERGENCE. ALSO, EXPLICIT +! 1-STEP SOLUTION OPTION FOR SPECIAL CASE OF PARAMETER CK=0, WHICH +! REDUCES THE ORIGINAL IMPLICIT EQUATION TO A SIMPLER EXPLICIT FORM, +! KNOWN AS THE "FLERCHINGER EQN". IMPROVED HANDLING OF SOLUTION IN THE +! LIMIT OF FREEZING POINT TEMPERATURE [AT0. +! +! attributes: +! language: fortran 90 +! machine: IBM SP +! +!$$$ + + use esmf + + IMPLICIT NONE + + INTEGER NLOG + INTEGER KCOUNT + + REAL BEXP + REAL BX + REAL DENOM + REAL DF + REAL DSWL + REAL FK + REAL FRH2O + REAL PSIS + REAL(esmf_kind_r8) :: SH2O + REAL(esmf_kind_r8) :: SMC + REAL SMCMAX + REAL SWL + REAL SWLK + REAL(esmf_kind_r8) :: TKELV + + REAL, PARAMETER :: CK = 8.0 + REAL, PARAMETER :: ERROR = 0.005 + +! ---------------------------------------------------------------------- +! LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM) +! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS +! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES. +! ---------------------------------------------------------------------- + + BX = BEXP + IF (BEXP .GT. BLIM) BX = BLIM + +! ---------------------------------------------------------------------- +! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG. +! ---------------------------------------------------------------------- + + NLOG=0 + KCOUNT=0 + + IF (CK .NE. 0.0) THEN + +! ---------------------------------------------------------------------- +! OPTION 1: ITERATED SOLUTION FOR NONZERO CK +! IN KOREN ET AL, JGR, 1999, EQN 17 +! ---------------------------------------------------------------------- +! INITIAL GUESS FOR SWL (frozen content) +! ---------------------------------------------------------------------- + + SWL = SMC-SH2O + +! ---------------------------------------------------------------------- +! KEEP WITHIN BOUNDS. +! ---------------------------------------------------------------------- + + IF (SWL .GT. (SMC-0.02)) SWL = SMC-0.02 + IF (SWL .LT. 0.) SWL = 0. + +! ---------------------------------------------------------------------- +! START OF ITERATIONS +! ---------------------------------------------------------------------- + + DO WHILE ( (NLOG .LT. 10) .AND. (KCOUNT .EQ. 0) ) + + NLOG = NLOG+1 + DF = LOG(( PSIS*GRAV/HLICE ) * ( ( 1.+CK*SWL )**2. ) * & + ( SMCMAX/(SMC-SWL) )**BX) - LOG(-(TKELV-frz_h2o)/TKELV) + DENOM = 2. * CK / ( 1.+CK*SWL ) + BX / ( SMC - SWL ) + SWLK = SWL - DF/DENOM + +! ---------------------------------------------------------------------- +! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION. +! ---------------------------------------------------------------------- + + IF (SWLK .GT. (SMC-0.02)) SWLK = SMC - 0.02 + IF (SWLK .LT. 0.) SWLK = 0. + +! ---------------------------------------------------------------------- +! MATHEMATICAL SOLUTION BOUNDS APPLIED. +! ---------------------------------------------------------------------- + + DSWL = ABS(SWLK-SWL) + SWL = SWLK + +! ---------------------------------------------------------------------- +! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.) +! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED. +! ---------------------------------------------------------------------- + + IF ( DSWL .LE. ERROR ) THEN + KCOUNT = KCOUNT+1 + ENDIF + + END DO + +! ---------------------------------------------------------------------- +! END OF ITERATIONS +! ---------------------------------------------------------------------- +! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION. +! ---------------------------------------------------------------------- + + FRH2O = SMC - SWL + +! ---------------------------------------------------------------------- +! END OPTION 1 +! ---------------------------------------------------------------------- + + ENDIF + +!----------------------------------------------------------------------- +! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0 +! IN KOREN ET AL., JGR, 1999, EQN 17 +! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION +! ---------------------------------------------------------------------- + + IF (KCOUNT .EQ. 0) THEN + + FK = (((HLICE/(GRAV*(-PSIS)))* & + ((TKELV-frz_h2o)/TKELV))**(-1/BX))*SMCMAX + + IF (FK .LT. 0.02) FK = 0.02 + + FRH2O = MIN (FK, SMC) + + ENDIF + + RETURN + + END function frh2o + +!--------------------------------------------------------------------------------------------- +! Adjust soil moisture for changes in soil type between the input and target grids. +!--------------------------------------------------------------------------------------------- + + subroutine rescale_soil_moisture + + use esmf + + use model_grid, only : landmask_target_grid + + use program_setup, only : drysmc_input, drysmc_target, & + maxsmc_input, maxsmc_target, & + refsmc_input, refsmc_target, & + wltsmc_input, wltsmc_target + + use static_data, only : soil_type_target_grid, & + veg_greenness_target_grid, & + veg_type_target_grid + + implicit none + + integer :: clb(3), cub(3), i, j, k, rc + integer :: soilt_input, soilt_target + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_type_input_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + real :: f1, fn, smcdir, smctra + + print*,"- RESCALE SOIL MOISTURE FOR CHANGES IN SOIL TYPE." + + print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE." + call ESMF_FieldGet(soilm_tot_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=soilm_tot_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LAND MASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR VEGETATION GREENNESS." + call ESMF_FieldGet(veg_greenness_target_grid, & + farrayPtr=veg_greenness_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID SOIL TYPE." + call ESMF_FieldGet(soil_type_target_grid, & + farrayPtr=soil_type_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TYPE FROM INPUT GRID." + call ESMF_FieldGet(soil_type_from_input_grid, & + farrayPtr=soil_type_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + +!--------------------------------------------------------------------------------------------- +! Check land points that are not permanent land ice. +!--------------------------------------------------------------------------------------------- + + if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then + + soilt_target = nint(soil_type_target_ptr(i,j)) + soilt_input = nint(soil_type_input_ptr(i,j)) + +!--------------------------------------------------------------------------------------------- +! Rescale soil moisture at points where the soil type between the input and output +! grids is different. Caution, this logic assumes the input and target grids use the same +! soil type dataset. +!--------------------------------------------------------------------------------------------- + + if (soilt_target /= soilt_input) then + +!--------------------------------------------------------------------------------------------- +! Rescale top layer. First, determine direct evaporation part: +!--------------------------------------------------------------------------------------------- + + f1=(soilm_tot_ptr(i,j,1)-drysmc_input(soilt_input)) / & + (maxsmc_input(soilt_input)-drysmc_input(soilt_input)) + + smcdir=drysmc_target(soilt_target) + f1 * & + (maxsmc_target(soilt_target) - drysmc_target(soilt_target)) + +!--------------------------------------------------------------------------------------------- +! Continue top layer rescale. Now determine transpiration part: +!--------------------------------------------------------------------------------------------- + + if (soilm_tot_ptr(i,j,1) < refsmc_input(soilt_input)) then + f1=(soilm_tot_ptr(i,j,1) - wltsmc_input(soilt_input)) / & + (refsmc_input(soilt_input) - wltsmc_input(soilt_input)) + smctra=wltsmc_target(soilt_target) + f1 * & + (refsmc_target(soilt_target) - wltsmc_target(soilt_target)) + else + f1=(soilm_tot_ptr(i,j,1) - refsmc_input(soilt_input)) / & + (maxsmc_input(soilt_input) - refsmc_input(soilt_input)) + smctra=refsmc_target(soilt_target) + f1 * & + (maxsmc_target(soilt_target) - refsmc_target(soilt_target)) + endif + +!--------------------------------------------------------------------------------------------- +! Top layer is weighted by green vegetation fraction: +!--------------------------------------------------------------------------------------------- + + soilm_tot_ptr(i,j,1) = ((1.0 - veg_greenness_ptr(i,j)) * smcdir) + & + (veg_greenness_ptr(i,j) * smctra) + +!--------------------------------------------------------------------------------------------- +! Rescale bottom layers as follows: +! +! - Rescale between wilting point and reference value when wilting < soil m < reference, or +! - Rescale between reference point and maximum value when reference < soil m < max. +!--------------------------------------------------------------------------------------------- + + do k = 2, cub(3) + if (soilm_tot_ptr(i,j,k) < refsmc_input(soilt_input)) then + fn = (soilm_tot_ptr(i,j,k) - wltsmc_input(soilt_input)) / & + (refsmc_input(soilt_input) - wltsmc_input(soilt_input)) + soilm_tot_ptr(i,j,k) = wltsmc_target(soilt_target) + fn * & + (refsmc_target(soilt_target) - wltsmc_target(soilt_target)) + else + fn = (soilm_tot_ptr(i,j,k) - refsmc_input(soilt_input)) / & + (maxsmc_input(soilt_input) - refsmc_input(soilt_input)) + soilm_tot_ptr(i,j,k) = refsmc_target(soilt_target) + fn * & + (maxsmc_target(soilt_target) - refsmc_target(soilt_target)) + endif + enddo + + endif ! is soil type different? + +!--------------------------------------------------------------------------------------------- +! Range check all layers. +!--------------------------------------------------------------------------------------------- + + soilm_tot_ptr(i,j,1)=min(soilm_tot_ptr(i,j,1),maxsmc_target(soilt_target)) + soilm_tot_ptr(i,j,1)=max(drysmc_target(soilt_target),soilm_tot_ptr(i,j,1)) + + do k = 2, cub(3) + soilm_tot_ptr(i,j,k)=min(soilm_tot_ptr(i,j,k),maxsmc_target(soilt_target)) + soilm_tot_ptr(i,j,k)=max(wltsmc_target(soilt_target),soilm_tot_ptr(i,j,k)) + enddo + + endif ! is this a land point? + + enddo + enddo + + return + + end subroutine rescale_soil_moisture + +!--------------------------------------------------------------------------------------------- +! Adjust soil temperature for changes in terrain height between the input and +! target grids. +!--------------------------------------------------------------------------------------------- + + subroutine adjust_soilt_for_terrain + + use model_grid, only : landmask_target_grid, & + terrain_target_grid + + use static_data, only : veg_type_target_grid + + implicit none + + integer :: clb(3), cub(3), i, j, k, rc + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real, parameter :: lapse_rate = 6.5e-03 + real :: terrain_diff + real(esmf_kind_r8), pointer :: terrain_input_ptr(:,:) + real(esmf_kind_r8), pointer :: terrain_target_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:) + + print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID TERRAIN." + call ESMF_FieldGet(terrain_target_grid, & + farrayPtr=terrain_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TERRAIN INTERP TO TARGET GRID." + call ESMF_FieldGet(terrain_from_input_grid, & + farrayPtr=terrain_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TEMP TARGET GRID." + call ESMF_FieldGet(soil_temp_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 1) then + terrain_diff = abs(terrain_input_ptr(i,j) - terrain_target_ptr(i,j)) + if (terrain_diff > 100.0) then + do k = clb(3), cub(3) + soil_temp_target_ptr(i,j,k) = soil_temp_target_ptr(i,j,k) + & + ((terrain_input_ptr(i,j) - terrain_target_ptr(i,j)) * lapse_rate) + if (nint(veg_type_target_ptr(i,j)) == veg_type_landice_target) then + soil_temp_target_ptr(i,j,k) = min(soil_temp_target_ptr(i,j,k), 273.16) + endif + enddo + endif + endif + enddo + enddo + + end subroutine adjust_soilt_for_terrain + +!--------------------------------------------------------------------------------------------- +! Set roughness at land and sea ice. +!--------------------------------------------------------------------------------------------- + + subroutine roughness + + use model_grid, only : landmask_target_grid + use static_data, only : veg_type_target_grid + + implicit none + + integer :: clb(2), cub(2), i, j, rc + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real :: z0_igbp(20) + real(esmf_kind_r8), pointer :: data_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + + data z0_igbp /1.089, 2.653, 0.854, 0.826, 0.800, 0.050, & + 0.030, 0.856, 0.856, 0.150, 0.040, 0.130, & + 1.000, 0.250, 0.011, 0.011, 0.001, 0.076, & + 0.050, 0.030/ + + print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." + call ESMF_FieldGet(landmask_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID Z0." + call ESMF_FieldGet(z0_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 2) then + data_ptr(i,j) = 1.0 + elseif (landmask_ptr(i,j) == 1) then + data_ptr(i,j) = z0_igbp(nint(veg_type_ptr(i,j))) * 100.0 + endif + enddo + enddo + + end subroutine roughness + +!--------------------------------------------------------------------------------------------- +! QC data before output. +!--------------------------------------------------------------------------------------------- + + subroutine qc_check + + use model_grid, only : landmask_target_grid + + use static_data, only : alvsf_target_grid, & + alvwf_target_grid, & + alnsf_target_grid, & + alnwf_target_grid, & + facsf_target_grid, & + facwf_target_grid, & + mxsno_albedo_target_grid, & + max_veg_greenness_target_grid, & + min_veg_greenness_target_grid, & + slope_type_target_grid, & + soil_type_target_grid, & + substrate_temp_target_grid, & + veg_greenness_target_grid, & + veg_type_target_grid + + implicit none + + integer :: clb(2), cub(2), i, j, rc + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real(esmf_kind_r8), pointer :: data_ptr(:,:) + real(esmf_kind_r8), pointer :: data3d_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soilmt_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soilml_ptr(:,:,:) + real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_skint_ptr(:,:) + real(esmf_kind_r8), pointer :: skint_ptr(:,:) + real(esmf_kind_r8), pointer :: fice_ptr(:,:) + real(esmf_kind_r8), pointer :: hice_ptr(:,:) + + print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." + call ESMF_FieldGet(landmask_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- SET NON-LAND FLAG FOR TARGET GRID SLOPE TYPE." + call ESMF_FieldGet(slope_type_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID SOIL TYPE." + call ESMF_FieldGet(soil_type_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) veg_type_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET TARGET GRID ALVSF AT NON-LAND." + call ESMF_FieldGet(alvsf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- SET TARGET GRID ALVWF AT NON-LAND." + call ESMF_FieldGet(alvwf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- SET TARGET GRID ALNSF AT NON-LAND." + call ESMF_FieldGet(alnsf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- SET TARGET GRID ALNWF AT NON-LAND." + call ESMF_FieldGet(alnwf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID FACSF." + call ESMF_FieldGet(facsf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID FACSF." + call ESMF_FieldGet(facwf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID MAXIMUM GREENNESS." + call ESMF_FieldGet(max_veg_greenness_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID MINIMUM GREENNESS." + call ESMF_FieldGet(min_veg_greenness_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID VEGETATION GREENNESS." + call ESMF_FieldGet(veg_greenness_target_grid, & + farrayPtr=veg_greenness_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) veg_greenness_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- SET NON-LAND FLAG FOR TARGET GRID MAX SNOW ALBEDO." + call ESMF_FieldGet(mxsno_albedo_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- ZERO OUT TARGET GRID CANOPY MOISTURE CONTENT WHERE NO PLANTS." + call ESMF_FieldGet(canopy_mc_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (veg_greenness_ptr(i,j) <= 0.01) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID ICE SKIN TEMP." + call ESMF_FieldGet(seaice_skin_temp_target_grid, & + farrayPtr=seaice_skint_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- SET TARGET GRID SKIN TEMP AT ICE POINTS." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skint_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID SEA ICE FRACTION." + call ESMF_FieldGet(seaice_fract_target_grid, & + farrayPtr=fice_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- SET TARGET GRID SEA ICE DEPTH TO ZERO AT NON-ICE POINTS." + call ESMF_FieldGet(seaice_depth_target_grid, & + farrayPtr=hice_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (fice_ptr(i,j) > 0.0) then + skint_ptr(i,j) = (fice_ptr(i,j) * seaice_skint_ptr(i,j)) + & + ( (1.0 - fice_ptr(i,j)) * frz_ice ) + else + seaice_skint_ptr(i,j) = skint_ptr(i,j) + hice_ptr(i,j) = 0.0 + endif + enddo + enddo + + print*,"- SET TARGET GRID SUBSTRATE TEMP AT ICE." + call ESMF_FieldGet(substrate_temp_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 2) then ! sea ice + data_ptr(i,j) = frz_ice + elseif (landmask_ptr(i,j) == 0) then ! open water flag value. + data_ptr(i,j) = skint_ptr(i,j) + endif + enddo + enddo + + print*,"- ZERO OUT TARGET GRID SNOW DEPTH AT OPEN WATER." + call ESMF_FieldGet(snow_depth_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 0) then ! open water + data_ptr(i,j) = 0.0 + end if + enddo + enddo + + print*,"- ZERO OUT TARGET GRID SNOW LIQ AT OPEN WATER." + call ESMF_FieldGet(snow_liq_equiv_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 0) then ! open water + data_ptr(i,j) = 0.0 + endif + enddo + enddo + + print*,"- SET NON-LAND FLAG VALUE FOR TARGET GRID TOTAL SOIL MOISTURE." + call ESMF_FieldGet(soilm_tot_target_grid, & + farrayPtr=soilmt_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- SET NON-LAND FLAG VALUE FOR TARGET GRID LIQUID SOIL MOISTURE." + call ESMF_FieldGet(soilm_liq_target_grid, & + farrayPtr=soilml_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 2 .or. landmask_ptr(i,j) == 0 .or. & + nint(veg_type_ptr(i,j)) == veg_type_landice_target) then + soilmt_ptr(i,j,:) = 1.0 + soilml_ptr(i,j,:) = 1.0 + endif + enddo + enddo + + print*,"- SET OPEN WATER FLAG FOR TARGET GRID SOIL TEMPERATURE." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=data3d_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 0) then + data3d_ptr(i,j,:) = skint_ptr(i,j) ! open water flag value. + endif + enddo + enddo + + return + + end subroutine qc_check + +!--------------------------------------------------------------------------------------------- +! nst is not active at land or sea ice points. Set nst fields to flag values at these +! points. +!--------------------------------------------------------------------------------------------- + + subroutine nst_land_fill + + use model_grid, only : landmask_target_grid + + implicit none + + integer(esmf_kind_i8), pointer :: mask_ptr(:,:) + integer :: rc + + real(esmf_kind_r8), pointer :: data_ptr(:,:) + real(esmf_kind_r8), pointer :: skint_ptr(:,:) + + print*,"- CALL FieldGet FOR TARGET GRID LANDMASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=mask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + +! c_d + + print*,"- CALL FieldGet FOR C_D." + call ESMF_FieldGet(c_d_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! c_0 + + print*,"- CALL FieldGet FOR C_0." + call ESMF_FieldGet(c_0_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! d_conv + + print*,"- CALL FieldGet FOR D_CONV." + call ESMF_FieldGet(d_conv_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! dt_cool + + print*,"- CALL FieldGet FOR DT_COOL." + call ESMF_FieldGet(dt_cool_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! ifd + + print*,"- CALL FieldGet FOR IFD." + call ESMF_FieldGet(ifd_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! qrain + + print*,"- CALL FieldGet FOR QRAIN." + call ESMF_FieldGet(qrain_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! tref + + print*,"- CALL FieldGet FOR TREF." + call ESMF_FieldGet(tref_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SKIN T." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skint_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = skint_ptr + +! w_d + + print*,"- CALL FieldGet FOR W_D." + call ESMF_FieldGet(w_d_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! w_0 + + print*,"- CALL FieldGet FOR W_0." + call ESMF_FieldGet(w_0_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xs + + print*,"- CALL FieldGet FOR XS." + call ESMF_FieldGet(xs_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xt + + print*,"- CALL FieldGet FOR XT." + call ESMF_FieldGet(xt_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xu + + print*,"- CALL FieldGet FOR XU." + call ESMF_FieldGet(xu_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xv + + print*,"- CALL FieldGet FOR XV." + call ESMF_FieldGet(xv_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xz + + print*,"- CALL FieldGet FOR XZ." + call ESMF_FieldGet(xz_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 30.0 + +! xtts + + print*,"- CALL FieldGet FOR XTTS." + call ESMF_FieldGet(xtts_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xzts + + print*,"- CALL FieldGet FOR XZTS." + call ESMF_FieldGet(xzts_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! z_c + + print*,"- CALL FieldGet FOR Z_C." + call ESMF_FieldGet(z_c_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! zm + + print*,"- CALL FieldGet FOR ZM." + call ESMF_FieldGet(zm_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + + end subroutine nst_land_fill + + subroutine create_surface_esmf_fields + + use model_grid, only : target_grid, lsoil_target + + implicit none + + integer :: rc + + real(esmf_kind_r8), pointer :: target_ptr(:,:), target_ptr_3d(:,:,:) + real :: init_val = -999.9 + + print*,"- CALL FieldCreate FOR TARGET GRID T2M." + t2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid t2m." + call ESMF_FieldGet(t2m_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID Q2M." + q2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid q2m." + call ESMF_FieldGet(q2m_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID TPRCP." + tprcp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid tprcp." + call ESMF_FieldGet(tprcp_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID F10M." + f10m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid f10m." + call ESMF_FieldGet(f10m_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID FFMM." + ffmm_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid ffmm." + call ESMF_FieldGet(ffmm_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID USTAR." + ustar_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid ustar." + call ESMF_FieldGet(ustar_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SNOW LIQ EQUIV." + snow_liq_equiv_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid snow liq equiv." + call ESMF_FieldGet(snow_liq_equiv_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SNOW DEPTH." + snow_depth_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid snow depth." + call ESMF_FieldGet(snow_depth_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE FRACTION." + seaice_fract_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid sea ice fraction." + call ESMF_FieldGet(seaice_fract_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE DEPTH." + seaice_depth_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET sea ice depth." + call ESMF_FieldGet(seaice_depth_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE SKIN TEMP." + seaice_skin_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET sea ice skin temp." + call ESMF_FieldGet(seaice_skin_temp_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SRFLAG." + srflag_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET srflag." + call ESMF_FieldGet(srflag_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SKIN TEMPERATURE." + skin_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid skin temp." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID CANOPY MOISTURE CONTENT." + canopy_mc_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid canopy moisture." + call ESMF_FieldGet(canopy_mc_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID Z0." + z0_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid z0." + call ESMF_FieldGet(z0_target_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID TERRAIN." + terrain_from_input_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid interpolated terrain." + call ESMF_FieldGet(terrain_from_input_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID SOIL TYPE." + soil_type_from_input_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid soil type" + call ESMF_FieldGet(soil_type_from_input_grid, & + farrayPtr=target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID SOIL TEMPERATURE." + soil_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid soil temp" + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=target_ptr_3d, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr_3d = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID TOTAL SOIL MOISTURE." + soilm_tot_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid soil moist" + call ESMF_FieldGet(soilm_tot_target_grid, & + farrayPtr=target_ptr_3d, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr_3d = init_val + + print*,"- CALL FieldCreate FOR TARGET GRID LIQUID SOIL MOISTURE." + soilm_liq_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- INITIALIZE TARGET grid soil liq" + call ESMF_FieldGet(soilm_liq_target_grid, & + farrayPtr=target_ptr_3d, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + + target_ptr_3d = init_val + + end subroutine create_surface_esmf_fields + + subroutine create_nst_esmf_fields + + use model_grid, only : target_grid + + implicit none + + integer :: rc + + print*,"- CALL FieldCreate FOR TARGET GRID C_D." + c_d_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID C_0." + c_0_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID D_CONV." + d_conv_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID DT_COOL." + dt_cool_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID IFD." + ifd_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID QRAIN." + qrain_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID TREF." + tref_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID W_D." + w_d_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID W_0." + w_0_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XS." + xs_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XT." + xt_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XU." + xu_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XV." + xv_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XZ." + xz_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XTTS." + xtts_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XZTS." + xzts_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID Z_C." + z_c_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID ZM." + zm_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine create_nst_esmf_fields + + subroutine ij_to_i_j(ij, itile, jtile, i, j) + + implicit none + + integer(esmf_kind_i4), intent(in) :: ij + integer , intent(in) :: itile, jtile + + integer , intent(out) :: i, j + + integer :: tile_num + integer :: pt_loc_this_tile + + tile_num = ((ij-1) / (itile*jtile)) ! tile number minus 1 + pt_loc_this_tile = ij - (tile_num * itile * jtile) + ! "ij" location of point within tile. + + j = (pt_loc_this_tile - 1) / itile + 1 + i = mod(pt_loc_this_tile, itile) + + if (i==0) i = itile + + return + + end subroutine ij_to_i_j + + subroutine cleanup_target_sfc_data + + implicit none + + integer :: rc + + print*,"- DESTROY TARGET GRID SURFACE FIELDS." + + call ESMF_FieldDestroy(t2m_target_grid, rc=rc) + call ESMF_FieldDestroy(q2m_target_grid, rc=rc) + call ESMF_FieldDestroy(tprcp_target_grid, rc=rc) + call ESMF_FieldDestroy(f10m_target_grid, rc=rc) + call ESMF_FieldDestroy(ffmm_target_grid, rc=rc) + call ESMF_FieldDestroy(ustar_target_grid, rc=rc) + call ESMF_FieldDestroy(snow_liq_equiv_target_grid, rc=rc) + call ESMF_FieldDestroy(snow_depth_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_fract_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_depth_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_skin_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(srflag_target_grid, rc=rc) + call ESMF_FieldDestroy(skin_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(canopy_mc_target_grid, rc=rc) + call ESMF_FieldDestroy(z0_target_grid, rc=rc) + call ESMF_FieldDestroy(terrain_from_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_type_from_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(soilm_tot_target_grid, rc=rc) + call ESMF_FieldDestroy(soilm_liq_target_grid, rc=rc) + + end subroutine cleanup_target_sfc_data + + subroutine cleanup_target_nst_data + + implicit none + + integer :: rc + + print*,"- DESTROY TARGET GRID NST DATA." + + call ESMF_FieldDestroy(c_d_target_grid, rc=rc) + call ESMF_FieldDestroy(c_0_target_grid, rc=rc) + call ESMF_FieldDestroy(d_conv_target_grid, rc=rc) + call ESMF_FieldDestroy(dt_cool_target_grid, rc=rc) + call ESMF_FieldDestroy(ifd_target_grid, rc=rc) + call ESMF_FieldDestroy(qrain_target_grid, rc=rc) + call ESMF_FieldDestroy(tref_target_grid, rc=rc) + call ESMF_FieldDestroy(w_d_target_grid, rc=rc) + call ESMF_FieldDestroy(w_0_target_grid, rc=rc) + call ESMF_FieldDestroy(xs_target_grid, rc=rc) + call ESMF_FieldDestroy(xt_target_grid, rc=rc) + call ESMF_FieldDestroy(xu_target_grid, rc=rc) + call ESMF_FieldDestroy(xv_target_grid, rc=rc) + call ESMF_FieldDestroy(xz_target_grid, rc=rc) + call ESMF_FieldDestroy(xtts_target_grid, rc=rc) + call ESMF_FieldDestroy(xzts_target_grid, rc=rc) + call ESMF_FieldDestroy(z_c_target_grid, rc=rc) + call ESMF_FieldDestroy(zm_target_grid, rc=rc) + + end subroutine cleanup_target_nst_data + + end module surface diff --git a/sorc/coldstart.fd/thompson_mp_climo_data.F90 b/sorc/coldstart.fd/thompson_mp_climo_data.F90 new file mode 100644 index 000000000..82104324a --- /dev/null +++ b/sorc/coldstart.fd/thompson_mp_climo_data.F90 @@ -0,0 +1,329 @@ + module thompson_mp_climo_data + +!----------------------------------------------------------------------------------- +! Module to read the Thompson climatological MP data file and set up the +! associated esmf field and grid objects. +!----------------------------------------------------------------------------------- + + use esmf + use netcdf + use program_setup, only : cycle_mon, cycle_day, cycle_hour, & + thomp_mp_climo_file + + implicit none + + private + + integer :: i_thomp_mp_climo + integer :: j_thomp_mp_climo + integer, public :: lev_thomp_mp_climo + + type(esmf_grid) :: thomp_mp_climo_grid + + type(esmf_field), public :: qnifa_climo_input_grid + type(esmf_field), public :: qnwfa_climo_input_grid + type(esmf_field), public :: thomp_pres_climo_input_grid + + public :: read_thomp_mp_climo_data + public :: cleanup_thomp_mp_climo_input_data + + contains + +!----------------------------------------------------------------------------------- +! Read Thompson climatological MP data file and time interpolate data to current +! cycle time. +!----------------------------------------------------------------------------------- + + subroutine read_thomp_mp_climo_data + + implicit none + + integer :: error, ncid, rc, clb(2), cub(2) + integer :: i, j, localpet, npets, id_var + integer :: jda(8), jdow, jdoy, jday, id_dim + integer :: mm, mmm, mmp, mon1, mon2 + + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + real(esmf_kind_r8), allocatable :: dummy3d_mon1(:,:,:) + real(esmf_kind_r8), allocatable :: dummy3d_mon2(:,:,:) + real(esmf_kind_r8), pointer :: lat_ptr(:,:), lon_ptr(:,:) + real(esmf_kind_r8), allocatable :: lons(:), lats(:) + real :: rjday, dayhf(13), wei1m, wei2m + + type(esmf_vm) :: vm + + type(esmf_polekind_flag) :: polekindflag(2) + + data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0, & + 196.5,227.5,258.0,288.5,319.0,349.5,380.5/ + +!----------------------------------------------------------------------------------- +! Open the file and read the grid dimensions and latitude/longitude. +!----------------------------------------------------------------------------------- + + print*,"- READ THOMP_MP_CLIMO_FILE: ", trim(thomp_mp_climo_file) + error=nf90_open(trim(thomp_mp_climo_file),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(thomp_mp_climo_file) ) + + error=nf90_inq_dimid(ncid, 'lat', id_dim) + call netcdf_err(error, 'reading lat id') + error=nf90_inquire_dimension(ncid,id_dim,len=j_thomp_mp_climo) + call netcdf_err(error, 'reading lat') + + error=nf90_inq_dimid(ncid, 'lon', id_dim) + call netcdf_err(error, 'reading lon id') + error=nf90_inquire_dimension(ncid,id_dim,len=i_thomp_mp_climo) + call netcdf_err(error, 'reading lon') + + error=nf90_inq_dimid(ncid, 'plev', id_dim) + call netcdf_err(error, 'reading plev id') + error=nf90_inquire_dimension(ncid,id_dim,len=lev_thomp_mp_climo) + call netcdf_err(error, 'reading plev') + + allocate(lons(i_thomp_mp_climo)) + allocate(lats(j_thomp_mp_climo)) + error=nf90_inq_varid(ncid, 'lon', id_var) + call netcdf_err(error, 'reading lon field id' ) + error=nf90_get_var(ncid, id_var, lons) + call netcdf_err(error, 'reading grid longitude' ) + error=nf90_inq_varid(ncid, 'lat', id_var) + call netcdf_err(error, 'reading lat field id' ) + error=nf90_get_var(ncid, id_var, lats) + call netcdf_err(error, 'reading grid latitude' ) + +!----------------------------------------------------------------------------------- +! Now that we have the grid information, create the esmf grid object. +!----------------------------------------------------------------------------------- + + print*,"- CALL VMGetGlobal" + call ESMF_VMGetGlobal(vm, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN VMGetGlobal", rc) + + print*,"- CALL VMGet" + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN VMGet", rc) + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + + print*,"- CALL GridCreate1PeriDim FOR THOMP MP CLIMO GRID." + thomp_mp_climo_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/i_thomp_mp_climo,j_thomp_mp_climo/), & + polekindflag=polekindflag, & + periodicDim=1, & + poleDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + regDecomp=(/1,npets/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridCreate1PeriDim", rc) + + print*,"- CALL GridAddCoord FOR THOMP MP CLIMO GRID." + call ESMF_GridAddCoord(thomp_mp_climo_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridAddCoord", rc) + +!----------------------------------------------------------------------------------- +! Set the grid object lat/lon. +!----------------------------------------------------------------------------------- + + print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." + nullify(lon_ptr) + call ESMF_GridGetCoord(thomp_mp_climo_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + nullify(lat_ptr) + call ESMF_GridGetCoord(thomp_mp_climo_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN GridGetCoord", rc) + + do i = clb(1), cub(1) + lon_ptr(i,:) = lons(i) + enddo + + do j = clb(2), cub(2) + lat_ptr(:,j) = lats(j) + enddo + +!----------------------------------------------------------------------------------- +! Create esmf fields for the two tracers and 3-d pressure. +!----------------------------------------------------------------------------------- + + print*,"- CALL FieldCreate FOR QNIFA INPUT CLIMO." + qnifa_climo_input_grid = ESMF_FieldCreate(thomp_mp_climo_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_thomp_mp_climo/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR QNWFA INPUT CLIMO." + qnwfa_climo_input_grid = ESMF_FieldCreate(thomp_mp_climo_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_thomp_mp_climo/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR THOMP PRESS CLIMO." + thomp_pres_climo_input_grid = ESMF_FieldCreate(thomp_mp_climo_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_thomp_mp_climo/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldCreate", rc) + +!----------------------------------------------------------------------------------- +! Data are monthly and valid at the 15th of the month. Compute time interpolation +! weights for the current cycle. +!----------------------------------------------------------------------------------- + + jda=0 + jda(1) = 2007 + if (cycle_mon == 2 .and. cycle_day == 29) then ! leap year + jda(2) = 3 + jda(3) = 1 + else + jda(2) = cycle_mon + jda(3) = cycle_day + endif + + jda(5) = cycle_hour + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jda,jdow,jdoy,jday) + rjday = float(jdoy) + float(jda(5)) / 24. + if(rjday < dayhf(1)) rjday = rjday + 365. + + do mm=1,12 + mmm = mm + mmp = mm + 1 + if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then + mon1 = mmm + mon2 = mmp + exit + endif + enddo + + wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) + wei2m = 1.0 - wei1m + + if (mon2==13) mon2=1 + + print*,"- BOUNDING MONTHS AND INTERPOLATION WEIGHTS: ", mon1, wei1m, mon2, wei2m + +!----------------------------------------------------------------------------------- +! Read tracers and 3-d pressure for each bounding month. Then linearly +! interpolate in time. +!----------------------------------------------------------------------------------- + + if (localpet == 0) then + allocate(dummy3d(i_thomp_mp_climo, j_thomp_mp_climo, lev_thomp_mp_climo)) + dummy3d = 0.0 + allocate(dummy3d_mon1(i_thomp_mp_climo, j_thomp_mp_climo, lev_thomp_mp_climo)) + dummy3d_mon1 = 0.0 + allocate(dummy3d_mon2(i_thomp_mp_climo, j_thomp_mp_climo, lev_thomp_mp_climo)) + dummy3d_mon2 = 0.0 + else + allocate(dummy3d(0,0,0)) + allocate(dummy3d_mon1(0,0,0)) + allocate(dummy3d_mon2(0,0,0)) + endif + + if (localpet == 0) then + print*,"- READ QNIFA FOR BOUNDING MONTH 1" + error=nf90_inq_varid(ncid, 'nifa', id_var) + call netcdf_err(error, 'reading nifa field id' ) + error=nf90_get_var(ncid, id_var, dummy3d_mon1, start=(/1,1,1,mon1/), & + count=(/i_thomp_mp_climo,j_thomp_mp_climo,lev_thomp_mp_climo,1/) ) + call netcdf_err(error, 'reading nifa month1 field' ) + print*,"- READ QNIFA FOR BOUNDING MONTH 2" + error=nf90_get_var(ncid, id_var, dummy3d_mon2, start=(/1,1,1,mon2/), & + count=(/i_thomp_mp_climo,j_thomp_mp_climo,lev_thomp_mp_climo,1/) ) + call netcdf_err(error, 'reading nifa month2 field' ) + dummy3d(:,:,:) = wei1m * dummy3d_mon1 + wei2m * dummy3d_mon2 + endif + + print*,"- CALL FieldScatter FOR qnifa input climo." + call ESMF_FieldScatter(qnifa_climo_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ QNWFA FOR BOUNDING MONTH 1" + error=nf90_inq_varid(ncid, 'nwfa', id_var) + call netcdf_err(error, 'reading nwfa field id' ) + error=nf90_get_var(ncid, id_var, dummy3d_mon1, start=(/1,1,1,mon1/), & + count=(/i_thomp_mp_climo,j_thomp_mp_climo,lev_thomp_mp_climo,1/) ) + call netcdf_err(error, 'reading nwfa month1 field' ) + print*,"- READ QNWFA FOR BOUNDING MONTH 2" + error=nf90_get_var(ncid, id_var, dummy3d_mon2, start=(/1,1,1,mon2/), & + count=(/i_thomp_mp_climo,j_thomp_mp_climo,lev_thomp_mp_climo,1/) ) + call netcdf_err(error, 'reading nwfa month2 field' ) + dummy3d(:,:,:) = wei1m * dummy3d_mon1 + wei2m * dummy3d_mon2 + endif + + print*,"- CALL FieldScatter FOR qnwfa input climo." + call ESMF_FieldScatter(qnwfa_climo_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ PRESSURE FOR BOUNDING MONTH 1" + error=nf90_inq_varid(ncid, 'prs', id_var) + call netcdf_err(error, 'reading prs field id' ) + error=nf90_get_var(ncid, id_var, dummy3d_mon1, start=(/1,1,1,mon1/), & + count=(/i_thomp_mp_climo,j_thomp_mp_climo,lev_thomp_mp_climo,1/) ) + call netcdf_err(error, 'reading prs month1 field' ) + print*,"- READ PRESSURE FOR BOUNDING MONTH 2" + error=nf90_get_var(ncid, id_var, dummy3d_mon2, start=(/1,1,1,mon2/), & + count=(/i_thomp_mp_climo,j_thomp_mp_climo,lev_thomp_mp_climo,1/) ) + call netcdf_err(error, 'reading prs month2 field' ) + dummy3d(:,:,:) = wei1m * dummy3d_mon1 + wei2m * dummy3d_mon2 + endif + + print*,"- CALL FieldScatter FOR thomp press." + call ESMF_FieldScatter(thomp_pres_climo_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldScatter", rc) + + error=nf90_close(ncid) + + deallocate(lons, lats, dummy3d, dummy3d_mon1, dummy3d_mon2) + + end subroutine read_thomp_mp_climo_data + +!----------------------------------------------------------------------------------- +! Cleanup routine +!----------------------------------------------------------------------------------- + + subroutine cleanup_thomp_mp_climo_input_data + + implicit none + + integer :: rc + + call ESMF_GridDestroy(thomp_mp_climo_grid, rc=rc) + call ESMF_FieldDestroy(thomp_pres_climo_input_grid, rc=rc) + call ESMF_FieldDestroy(qnifa_climo_input_grid, rc=rc) + call ESMF_FieldDestroy(qnwfa_climo_input_grid, rc=rc) + + end subroutine cleanup_thomp_mp_climo_input_data + + end module thompson_mp_climo_data diff --git a/sorc/coldstart.fd/utils.f90 b/sorc/coldstart.fd/utils.f90 new file mode 100644 index 000000000..337083fd3 --- /dev/null +++ b/sorc/coldstart.fd/utils.f90 @@ -0,0 +1,80 @@ + subroutine error_handler(string, rc) + + use mpi + + implicit none + + character(len=*), intent(in) :: string + + integer, intent(in) :: rc + + integer :: ierr + + print*,"- FATAL ERROR: ", string + print*,"- IOSTAT IS: ", rc + call mpi_abort(mpi_comm_world, 999, ierr) + + end subroutine error_handler + + subroutine netcdf_err( err, string ) + + use mpi + use netcdf + + implicit none + integer, intent(in) :: err + character(len=*), intent(in) :: string + character(len=256) :: errmsg + integer :: iret + + if( err.EQ.NF90_NOERR )return + errmsg = NF90_STRERROR(err) + print*,'' + print*,'FATAL ERROR: ', trim(string), ': ', trim(errmsg) + print*,'STOP.' + call mpi_abort(mpi_comm_world, 999, iret) + + return + end subroutine netcdf_err + + subroutine to_upper(strIn) +! Adapted from http://www.star.le.ac.uk/~cgp/fortran.html (25 May 2012) +! Original author: Clive Page + + implicit none + + character(len=*), intent(inout) :: strIn + character(len=len(strIn)) :: strOut + integer :: i,j + + do i = 1, len(strIn) + j = iachar(strIn(i:i)) + if (j>= iachar("a") .and. j<=iachar("z") ) then + strOut(i:i) = achar(iachar(strIn(i:i))-32) + else + strOut(i:i) = strIn(i:i) + end if + end do + strIn(:) = strOut(:) +end subroutine to_upper + +subroutine to_lower(strIn) +! Adapted from http://www.star.le.ac.uk/~cgp/fortran.html (25 May 2012) +! Original author: Clive Page + + implicit none + + character(len=*), intent(inout) :: strIn + character(len=len(strIn)) :: strOut + integer :: i,j + + do i = 1, len(strIn) + j = iachar(strIn(i:i)) + if (j>= iachar("A") .and. j<=iachar("Z") ) then + strOut(i:i) = achar(iachar(strIn(i:i))+32) + else + strOut(i:i) = strIn(i:i) + end if + end do + strIn(:) = strOut(:) +end subroutine to_lower diff --git a/sorc/coldstart.fd/write_data.F90 b/sorc/coldstart.fd/write_data.F90 new file mode 100644 index 000000000..0e04e7330 --- /dev/null +++ b/sorc/coldstart.fd/write_data.F90 @@ -0,0 +1,3116 @@ +!-------------------------------------------------------------------------- +! Module: write_data +! +! Abstract: Write out target grid data into appropriate files for +! the forecast model. +! +! Main Subroutines: +! ------------------- +! write_fv3_atm_header_netcdf Writes atmospheric header file, +! netcdf format. +! write_fv3_atm_bndy_data_netcdf Writes atmospheric fields along the +! lateral boundary. For regional grids. +! netcdf format. +! write_fv3_atm_data_netcdf Writes atmospheric data into a +! 'coldstart' file (netcdf) +! write_fv3_sfc_data_netcdf Writes surface and nst data into a +! 'coldstart' file (netcdf) +!-------------------------------------------------------------------------- + + subroutine write_fv3_atm_header_netcdf(localpet) + + use esmf + + use netcdf + + use atmosphere, only : nvcoord_target, & + vcoord_target, & + levp1_target + + use program_setup, only : num_tracers, use_thomp_mp_climo + + implicit none + + integer, intent(in) :: localpet + + character(len=13) :: outfile + + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: error, ncid, dim_nvcoord + integer :: dim_levp1, id_ntrac, id_vcoord + integer :: num_tracers_output + + real(kind=esmf_kind_r8), allocatable :: tmp(:,:) + + if (localpet /= 0) return + + outfile="./gfs_ctrl.nc" + + print*,"- WRITE ATMOSPHERIC HEADER FILE: ", trim(outfile) + + error = nf90_create(outfile, IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING FILE='//trim(outfile) ) + + error = nf90_def_dim(ncid, 'nvcoord', nvcoord_target, dim_nvcoord) + call netcdf_err(error, 'define dimension nvcoord for file='//trim(outfile) ) + + error = nf90_def_dim(ncid, 'levsp', levp1_target, dim_levp1) + call netcdf_err(error, 'define dimension levsp for file='//trim(outfile) ) + + error = nf90_def_var(ncid, 'ntrac', nf90_int, id_ntrac) + call netcdf_err(error, 'define var ntrac for file='//trim(outfile) ) + + error = nf90_def_var(ncid, 'vcoord', nf90_double, (/dim_levp1, dim_nvcoord/), id_vcoord) + call netcdf_err(error, 'define var vcoord for file='//trim(outfile) ) + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'end meta define for file='//trim(outfile) ) + + num_tracers_output = num_tracers + if (use_thomp_mp_climo) num_tracers_output = num_tracers + 2 + error = nf90_put_var( ncid, id_ntrac, num_tracers_output) + call netcdf_err(error, 'write var ntrac for file='//trim(outfile) ) + + allocate(tmp(levp1_target, nvcoord_target)) + tmp(1:levp1_target,:) = vcoord_target(levp1_target:1:-1,:) + + error = nf90_put_var( ncid, id_vcoord, tmp) + call netcdf_err(error, 'write var vcoord for file='//trim(outfile) ) + + deallocate(tmp) + + error = nf90_close(ncid) + + end subroutine write_fv3_atm_header_netcdf + + subroutine write_fv3_atm_bndy_data_netcdf(localpet) + +!--------------------------------------------------------------------------- +! +! Output data along the four halo boundaries. The naming convention +! assumes point (1,1) is the lower left corner of the grid: +! +! --------------- TOP --------------- +! | | +! | | +! LEFT | | RIGHT +! | | +! |PT(1,1) | +! ------------- BOTTOM -------------- +! +!--------------------------------------------------------------------------- + + use esmf + use netcdf + + use atmosphere, only : lev_target, levp1_target, & + dzdt_target_grid, & + ps_target_grid, & + tracers_target_grid, & + u_s_target_grid, & + v_s_target_grid, & + u_w_target_grid, & + v_w_target_grid, & + temp_target_grid, & + zh_target_grid, & + qnifa_climo_target_grid, & + qnwfa_climo_target_grid + + use model_grid, only : i_target, ip1_target, j_target, jp1_target + + use program_setup, only : halo_bndy, halo_blend, & + input_type, tracers, num_tracers, & + use_thomp_mp_climo + + implicit none + + integer, intent(in) :: localpet + + character(len=50) :: name + + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: ncid, error, tile, i, n + integer :: dim_lon, dim_lat + integer :: dim_lonp, dim_halo + integer :: dim_halop, dim_latm + integer :: dim_lev, dim_levp1 + integer :: j_target2, halo, halo_p1 + integer :: id_i_bottom, id_j_bottom + integer :: id_i_top, id_j_top + integer :: id_i_right, id_j_right + integer :: id_i_left, id_j_left + integer :: id_qnifa_bottom, id_qnifa_top + integer :: id_qnifa_right, id_qnifa_left + integer :: id_qnwfa_bottom, id_qnwfa_top + integer :: id_qnwfa_right, id_qnwfa_left + integer :: id_ps_bottom, id_ps_top + integer :: id_ps_right, id_ps_left + integer :: id_t_bottom, id_t_top + integer :: id_t_right, id_t_left + integer :: id_w_bottom, id_w_top + integer :: id_w_right, id_w_left + integer :: id_zh_bottom, id_zh_top + integer :: id_zh_right, id_zh_left + integer, allocatable :: id_tracer_bottom(:), id_tracer_top(:) + integer, allocatable :: id_tracer_right(:), id_tracer_left(:) + integer :: id_i_w_bottom, id_j_w_bottom + integer :: id_i_w_top, id_j_w_top + integer :: id_j_w_right, id_i_w_left + integer :: id_j_w_left, id_i_w_right + integer :: id_u_w_bottom, id_u_w_top + integer :: id_u_w_right, id_u_w_left + integer :: id_v_w_bottom, id_v_w_top + integer :: id_v_w_right, id_v_w_left + integer :: id_i_s_bottom, id_j_s_bottom + integer :: id_i_s_top, id_j_s_top + integer :: id_i_s_right, id_j_s_right + integer :: id_i_s_left, id_j_s_left + integer :: id_u_s_bottom, id_u_s_top + integer :: id_u_s_right, id_u_s_left + integer :: id_v_s_bottom, id_v_s_top + integer :: id_v_s_right, id_v_s_left + integer :: i_start_top, i_end_top + integer :: j_start_top, j_end_top + integer :: i_start_bottom, i_end_bottom + integer :: j_start_bottom, j_end_bottom + integer :: i_start_left, i_end_left + integer :: j_start_left, j_end_left + integer :: i_start_right, i_end_right + integer :: j_start_right, j_end_right + integer(kind=4), allocatable :: idum(:) + + real(kind=4), allocatable :: dum2d_top(:,:), dum2d_bottom(:,:) + real(kind=4), allocatable :: dum2d_left(:,:), dum2d_right(:,:) + real(kind=4), allocatable :: dum3d_top(:,:,:), dum3d_bottom(:,:,:) + real(kind=4), allocatable :: dum3d_left(:,:,:), dum3d_right(:,:,:) + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + + print*,"- OUTPUT LATERAL BOUNDARY DATA." + + halo = halo_bndy + halo_blend + halo_p1 = halo + 1 + + allocate(id_tracer_bottom(num_tracers)) + allocate(id_tracer_top(num_tracers)) + allocate(id_tracer_left(num_tracers)) + allocate(id_tracer_right(num_tracers)) + + if (localpet == 0) then + +!--- open the file + error = nf90_create("./gfs.bndy.nc", IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING BNDY FILE' ) + + error = nf90_def_dim(ncid, 'lon', i_target, dim_lon) + call netcdf_err(error, 'defining lon dimension') + + j_target2 = j_target - (2*halo_bndy) + error = nf90_def_dim(ncid, 'lat', j_target2, dim_lat) + call netcdf_err(error, 'DEFINING LAT DIMENSION') + + error = nf90_def_dim(ncid, 'lonp', ip1_target, dim_lonp) + call netcdf_err(error, 'DEFINING LONP DIMENSION') + + j_target2 = j_target - (2*halo_bndy) - 1 + error = nf90_def_dim(ncid, 'latm', j_target2, dim_latm) + call netcdf_err(error, 'DEFINING LATM DIMENSION') + + error = nf90_def_dim(ncid, 'halo', halo, dim_halo) + call netcdf_err(error, 'DEFINING HALO DIMENSION') + + error = nf90_def_dim(ncid, 'halop', halo_p1, dim_halop) + call netcdf_err(error, 'DEFINING HALOP DIMENSION') + + error = nf90_def_dim(ncid, 'lev', lev_target, dim_lev) + call netcdf_err(error, 'DEFINING LEV DIMENSION') + + error = nf90_def_dim(ncid, 'levp', levp1_target, dim_levp1) + call netcdf_err(error, 'DEFINING LEVP DIMENSION') + + error = nf90_def_var(ncid, 'i_bottom', NF90_INT, & + (/dim_lon/), id_i_bottom) + call netcdf_err(error, 'DEFINING I_BOTTOM') + + error = nf90_def_var(ncid, 'j_bottom', NF90_INT, & + (/dim_halo/), id_j_bottom) + call netcdf_err(error, 'DEFINING J_BOTTOM') + + error = nf90_def_var(ncid, 'i_top', NF90_INT, & + (/dim_lon/), id_i_top) + call netcdf_err(error, 'DEFINING I_TOP') + + error = nf90_def_var(ncid, 'j_top', NF90_INT, & + (/dim_halo/), id_j_top) + call netcdf_err(error, 'DEFINING J_TOP') + + error = nf90_def_var(ncid, 'i_right', NF90_INT, & + (/dim_halo/), id_i_right) + call netcdf_err(error, 'DEFINING I_RIGHT') + + error = nf90_def_var(ncid, 'j_right', NF90_INT, & + (/dim_lat/), id_j_right) + call netcdf_err(error, 'DEFINING J_RIGHT') + + error = nf90_def_var(ncid, 'i_left', NF90_INT, & + (/dim_halo/), id_i_left) + call netcdf_err(error, 'DEFINING I_LEFT') + + error = nf90_def_var(ncid, 'j_left', NF90_INT, & + (/dim_lat/), id_j_left) + call netcdf_err(error, 'DEFINING J_LEFT') + + error = nf90_def_var(ncid, 'ps_bottom', NF90_FLOAT, & + (/dim_lon, dim_halo/), id_ps_bottom) + call netcdf_err(error, 'DEFINING PS_BOTTOM') + + error = nf90_def_var(ncid, 'ps_top', NF90_FLOAT, & + (/dim_lon, dim_halo/), id_ps_top) + call netcdf_err(error, 'DEFINING PS_TOP') + + error = nf90_def_var(ncid, 'ps_right', NF90_FLOAT, & + (/dim_halo, dim_lat/), id_ps_right) + call netcdf_err(error, 'DEFINING PS_RIGHT') + + error = nf90_def_var(ncid, 'ps_left', NF90_FLOAT, & + (/dim_halo, dim_lat/), id_ps_left) + call netcdf_err(error, 'DEFINING PS_LEFT') + + error = nf90_def_var(ncid, 't_bottom', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_t_bottom) + call netcdf_err(error, 'DEFINING T_BOTTOM') + + error = nf90_def_var(ncid, 't_top', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_t_top) + call netcdf_err(error, 'DEFINING T_TOP') + + error = nf90_def_var(ncid, 't_right', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_t_right) + call netcdf_err(error, 'DEFINING T_RIGHT') + + error = nf90_def_var(ncid, 't_left', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_t_left) + call netcdf_err(error, 'DEFINING T_LEFT') + + error = nf90_def_var(ncid, 'w_bottom', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_w_bottom) + call netcdf_err(error, 'DEFINING W_BOTTOM') + + error = nf90_def_var(ncid, 'w_top', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_w_top) + call netcdf_err(error, 'DEFINING W_TOP') + + error = nf90_def_var(ncid, 'w_right', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_w_right) + call netcdf_err(error, 'DEFINING W_RIGHT') + + error = nf90_def_var(ncid, 'w_left', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_w_left) + call netcdf_err(error, 'DEFINING W_LEFT') + + error = nf90_def_var(ncid, 'zh_bottom', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_levp1/), id_zh_bottom) + call netcdf_err(error, 'DEFINING ZH_BOTTOM') + + error = nf90_def_var(ncid, 'zh_top', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_levp1/), id_zh_top) + call netcdf_err(error, 'DEFINING ZH_TOP') + + error = nf90_def_var(ncid, 'zh_right', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_levp1/), id_zh_right) + call netcdf_err(error, 'DEFINING ZH_RIGHT') + + error = nf90_def_var(ncid, 'zh_left', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_levp1/), id_zh_left) + call netcdf_err(error, 'DEFINING ZH_LEFT') + + do n = 1, num_tracers + + name = trim(tracers(n)) // "_bottom" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_tracer_bottom(n)) + call netcdf_err(error, 'DEFINING TRACER_BOTTOM') + + name = trim(tracers(n)) // "_top" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_tracer_top(n)) + call netcdf_err(error, 'DEFINING TRACER_TOP') + + name = trim(tracers(n)) // "_right" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_tracer_right(n)) + call netcdf_err(error, 'DEFINING TRACER_RIGHT') + + name = trim(tracers(n)) // "_left" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_tracer_left(n)) + call netcdf_err(error, 'DEFINING TRACER_LEFT') + + enddo + + if (use_thomp_mp_climo) then + + name = "ice_aero_bottom" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_qnifa_bottom) + call netcdf_err(error, 'DEFINING QNIFA_BOTTOM') + + name = "ice_aero_top" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_qnifa_top) + call netcdf_err(error, 'DEFINING QNIFA_TOP') + + name = "ice_aero_right" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_qnifa_right) + call netcdf_err(error, 'DEFINING QNIFA_RIGHT') + + name = "ice_aero_left" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_qnifa_left) + call netcdf_err(error, 'DEFINING QNIFA_LEFT') + + name = "liq_aero_bottom" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_qnwfa_bottom) + call netcdf_err(error, 'DEFINING QNWFA_BOTTOM') + + name = "liq_aero_top" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_qnwfa_top) + call netcdf_err(error, 'DEFINING QNWFA_TOP') + + name = "liq_aero_right" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_qnwfa_right) + call netcdf_err(error, 'DEFINING QNWFA_RIGHT') + + name = "liq_aero_left" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_qnwfa_left) + call netcdf_err(error, 'DEFINING QNWFA_LEFT') + + endif + + error = nf90_def_var(ncid, 'i_w_bottom', NF90_INT, & + (/dim_lonp/), id_i_w_bottom) + call netcdf_err(error, 'DEFINING I_W_BOTTOM') + + error = nf90_def_var(ncid, 'j_w_bottom', NF90_INT, & + (/dim_halo/), id_j_w_bottom) + call netcdf_err(error, 'DEFINING J_W_BOTTOM') + + error = nf90_def_var(ncid, 'i_w_top', NF90_INT, & + (/dim_lonp/), id_i_w_top) + call netcdf_err(error, 'DEFINING I_W_TOP') + + error = nf90_def_var(ncid, 'j_w_top', NF90_INT, & + (/dim_halo/), id_j_w_top) + call netcdf_err(error, 'DEFINING J_W_TOP') + + error = nf90_def_var(ncid, 'i_w_right', NF90_INT, & + (/dim_halop/), id_i_w_right) + call netcdf_err(error, 'DEFINING I_W_RIGHT') + + error = nf90_def_var(ncid, 'j_w_right', NF90_INT, & + (/dim_lat/), id_j_w_right) + call netcdf_err(error, 'DEFINING J_W_RIGHT') + + error = nf90_def_var(ncid, 'i_w_left', NF90_INT, & + (/dim_halop/), id_i_w_left) + call netcdf_err(error, 'DEFINING I_W_LEFT') + + error = nf90_def_var(ncid, 'j_w_left', NF90_INT, & + (/dim_lat/), id_j_w_left) + call netcdf_err(error, 'DEFINING J_W_LEFT') + + error = nf90_def_var(ncid, 'u_w_bottom', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_u_w_bottom) + call netcdf_err(error, 'DEFINING U_W_BOTTOM') + + error = nf90_def_var(ncid, 'u_w_top', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_u_w_top) + call netcdf_err(error, 'DEFINING U_W_TOP') + + error = nf90_def_var(ncid, 'u_w_right', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_u_w_right) + call netcdf_err(error, 'DEFINING U_W_RIGHT') + + error = nf90_def_var(ncid, 'u_w_left', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_u_w_left) + call netcdf_err(error, 'DEFINING U_W_LEFT') + + error = nf90_def_var(ncid, 'v_w_bottom', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_v_w_bottom) + call netcdf_err(error, 'DEFINING V_W_BOTTOM') + + error = nf90_def_var(ncid, 'v_w_top', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_v_w_top) + call netcdf_err(error, 'DEFINING V_W_TOP') + + error = nf90_def_var(ncid, 'v_w_right', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_v_w_right) + call netcdf_err(error, 'DEFINING V_W_RIGHT') + + error = nf90_def_var(ncid, 'v_w_left', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_v_w_left) + call netcdf_err(error, 'DEFINING V_W_LEFT') + + error = nf90_def_var(ncid, 'i_s_bottom', NF90_INT, & + (/dim_lon/), id_i_s_bottom) + call netcdf_err(error, 'DEFINING I_S_BOTTOM') + + error = nf90_def_var(ncid, 'j_s_bottom', NF90_INT, & + (/dim_halop/), id_j_s_bottom) + call netcdf_err(error, 'DEFINING J_S_BOTTOM') + + error = nf90_def_var(ncid, 'i_s_top', NF90_INT, & + (/dim_lon/), id_i_s_top) + call netcdf_err(error, 'DEFINING I_S_TOP') + + error = nf90_def_var(ncid, 'j_s_top', NF90_INT, & + (/dim_halop/), id_j_s_top) + call netcdf_err(error, 'DEFINING J_S_TOP') + + error = nf90_def_var(ncid, 'i_s_right', NF90_INT, & + (/dim_halo/), id_i_s_right) + call netcdf_err(error, 'DEFINING I_S_RIGHT') + + error = nf90_def_var(ncid, 'j_s_right', NF90_INT, & + (/dim_latm/), id_j_s_right) + call netcdf_err(error, 'DEFINING J_S_RIGHT') + + error = nf90_def_var(ncid, 'i_s_left', NF90_INT, & + (/dim_halo/), id_i_s_left) + call netcdf_err(error, 'DEFINING I_S_LEFT') + + error = nf90_def_var(ncid, 'j_s_left', NF90_INT, & + (/dim_latm/), id_j_s_left) + call netcdf_err(error, 'DEFINING J_S_LEFT') + + error = nf90_def_var(ncid, 'u_s_bottom', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_u_s_bottom) + call netcdf_err(error, 'DEFINING U_S_BOTTOM') + + error = nf90_def_var(ncid, 'u_s_top', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_u_s_top) + call netcdf_err(error, 'DEFINING U_S_TOP') + + error = nf90_def_var(ncid, 'u_s_right', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_u_s_right) + call netcdf_err(error, 'DEFINING U_S_RIGHT') + + error = nf90_def_var(ncid, 'u_s_left', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_u_s_left) + call netcdf_err(error, 'DEFINING U_S_LEFT') + + error = nf90_def_var(ncid, 'v_s_bottom', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_v_s_bottom) + call netcdf_err(error, 'DEFINING V_S_BOTTOM') + + error = nf90_def_var(ncid, 'v_s_top', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_v_s_top) + call netcdf_err(error, 'DEFINING V_S_TOP') + + error = nf90_def_var(ncid, 'v_s_right', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_v_s_right) + call netcdf_err(error, 'DEFINING V_S_RIGHT') + + error = nf90_def_var(ncid, 'v_s_left', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_v_s_left) + call netcdf_err(error, 'DEFINING V_S_LEFT') + +!--- define global attributes + if (trim(input_type) == "gaussian_nemsio") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gfs_gaussian_nemsio") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gfs_sigio") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS SIGIO FILE') + elseif (trim(input_type) == "history") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED HISTORY FILE') + elseif (trim(input_type) == "restart") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED RESTART FILE') + elseif (trim(input_type) == "gaussian_netcdf") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GAUSSIAN NETCDF FILE') + elseif (trim(input_type) == "grib2") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GRIB2 FILE') + endif + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'DEFINING END OF HEADER') + + endif + +!--------------------------------------------------------------------------- +! Set up bounds for mass points. Indices are with respect to the whole +! grid - including total halo (boundary plus blending halo). +!--------------------------------------------------------------------------- + + i_start_top = 1 + i_end_top = i_target + j_start_top = j_target - halo + 1 + j_end_top = j_target + + i_start_bottom = 1 + i_end_bottom = i_target + j_start_bottom = 1 + j_end_bottom = halo + + i_start_left = 1 + i_end_left = halo + j_start_left = halo_bndy + 1 + j_end_left = j_target - halo_bndy + + i_start_right = i_target - halo + 1 + i_end_right = i_target + j_start_right = halo_bndy + 1 + j_end_right = j_target - halo_bndy + + if (localpet == 0) then + +! Indices here are with respect to the computational grid - +! without lateral boundary halo but including blending halo. + + allocate(idum(i_start_top:i_end_top)) + do i = i_start_top, i_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_top, idum) + call netcdf_err(error, "WRITING I_TOP") + deallocate(idum) + allocate(idum(i_start_bottom:i_end_bottom)) + do i = i_start_bottom, i_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_bottom, idum) + call netcdf_err(error, "WRITING I_BOTTOM") + deallocate(idum) + allocate(idum(i_start_left:i_end_left)) + do i = i_start_left, i_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_left, idum) + call netcdf_err(error, "WRITING I_LEFT") + deallocate(idum) + allocate(idum(i_start_right:i_end_right)) + do i = i_start_right, i_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_right, idum) + call netcdf_err(error, "WRITING I_RIGHT") + deallocate(idum) + allocate(idum(j_start_top:j_end_top)) + do i = j_start_top, j_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_top, idum) + call netcdf_err(error, "WRITING J_TOP") + deallocate(idum) + allocate(idum(j_start_bottom:j_end_bottom)) + do i = j_start_bottom, j_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_bottom, idum) + call netcdf_err(error, "WRITING J_BOTTOM") + deallocate(idum) + allocate(idum(j_start_left:j_end_left)) + do i = j_start_left, j_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_left, idum) + call netcdf_err(error, "WRITING J_LEFT") + deallocate(idum) + allocate(idum(j_start_right:j_end_right)) + do i = j_start_right, j_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_right, idum) + call netcdf_err(error, "WRITING J_RIGHT") + deallocate(idum) + endif + +! surface pressure + + if (localpet == 0) then + allocate(data_one_tile(i_target,j_target)) + allocate(dum2d_top(i_start_top:i_end_top, j_start_top:j_end_top)) + allocate(dum2d_bottom(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom)) + allocate(dum2d_left(i_start_left:i_end_left, j_start_left:j_end_left)) + allocate(dum2d_right(i_start_right:i_end_right, j_start_right:j_end_right)) + else + allocate(data_one_tile(0,0)) + allocate(dum2d_top(0,0)) + allocate(dum2d_bottom(0,0)) + allocate(dum2d_left(0,0)) + allocate(dum2d_right(0,0)) + endif + + tile = 1 + + print*,"- CALL FieldGather FOR TARGET GRID SURFACE PRESSURE" + call ESMF_FieldGather(ps_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d_top(:,:) = data_one_tile(i_start_top:i_end_top, j_start_top:j_end_top) + error = nf90_put_var( ncid, id_ps_top, dum2d_top) + call netcdf_err(error, 'WRITING PS TOP' ) + dum2d_bottom(:,:) = data_one_tile(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom) + error = nf90_put_var( ncid, id_ps_bottom, dum2d_bottom) + call netcdf_err(error, 'WRITING PS BOTTOM' ) + dum2d_left(:,:) = data_one_tile(i_start_left:i_end_left, j_start_left:j_end_left) + error = nf90_put_var( ncid, id_ps_left, dum2d_left) + call netcdf_err(error, 'WRITING PS LEFT' ) + dum2d_right(:,:) = data_one_tile(i_start_right:i_end_right, j_start_right:j_end_right) + error = nf90_put_var( ncid, id_ps_right, dum2d_right) + call netcdf_err(error, 'WRITING PS RIGHT' ) + endif + + deallocate(dum2d_top, dum2d_bottom, dum2d_left, dum2d_right, data_one_tile) + +! height + + if (localpet == 0) then + allocate(data_one_tile_3d(i_target,j_target,levp1_target)) + allocate(dum3d_top(i_start_top:i_end_top, j_start_top:j_end_top, levp1_target)) + allocate(dum3d_bottom(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom, levp1_target)) + allocate(dum3d_left(i_start_left:i_end_left, j_start_left:j_end_left, levp1_target)) + allocate(dum3d_right(i_start_right:i_end_right, j_start_right:j_end_right, levp1_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + print*,"- CALL FieldGather FOR TARGET GRID HEIGHT FOR TILE: ", tile + call ESMF_FieldGather(zh_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:levp1_target) = dum3d_top(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_top, dum3d_top) + call netcdf_err(error, 'WRITING ZH TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:levp1_target) = dum3d_bottom(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING ZH BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:levp1_target) = dum3d_left(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_left, dum3d_left) + call netcdf_err(error, 'WRITING ZH LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:levp1_target) = dum3d_right(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_right, dum3d_right) + call netcdf_err(error, 'WRITING ZH RIGHT' ) + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + +! Tracers + + if (localpet == 0) then + allocate(data_one_tile_3d(i_target,j_target,lev_target)) + allocate(dum3d_top(i_start_top:i_end_top, j_start_top:j_end_top, lev_target)) + allocate(dum3d_bottom(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom, lev_target)) + allocate(dum3d_left(i_start_left:i_end_left, j_start_left:j_end_left, lev_target)) + allocate(dum3d_right(i_start_right:i_end_right, j_start_right:j_end_right, lev_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + do n = 1, num_tracers + + print*,"- CALL FieldGather FOR TARGET GRID TRACER FOR TILE: ", trim(tracers(n)), tile + call ESMF_FieldGather(tracers_target_grid(n), data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_top(n), dum3d_top) + call netcdf_err(error, 'WRITING TRACER TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_bottom(n), dum3d_bottom) + call netcdf_err(error, 'WRITING TRACER BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_left(n), dum3d_left) + call netcdf_err(error, 'WRITING TRACER LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_right(n), dum3d_right) + call netcdf_err(error, 'WRITING TRACER RIGHT' ) + endif + + enddo + +! Vertical velocity + + print*,"- CALL FieldGather FOR TARGET GRID W FOR TILE: ", tile + call ESMF_FieldGather(dzdt_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_top, dum3d_top) + call netcdf_err(error, 'WRITING W TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING W BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_left, dum3d_left) + call netcdf_err(error, 'WRITING W LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_right, dum3d_right) + call netcdf_err(error, 'WRITING W RIGHT' ) + endif + +! Temperature + + print*,"- CALL FieldGather FOR TARGET GRID TEMPERATURE FOR TILE: ", tile + call ESMF_FieldGather(temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_t_top, dum3d_top) + call netcdf_err(error, 'WRITING T TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_t_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING T BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_t_left, dum3d_left) + call netcdf_err(error, 'WRITING T LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_t_right, dum3d_right) + call netcdf_err(error, 'WRITING T RIGHT' ) + endif + + if (use_thomp_mp_climo) then + + print*,"- CALL FieldGather FOR TARGET GRID CLIMO QNIFA FOR TILE: ", tile + call ESMF_FieldGather(qnifa_climo_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnifa_top, dum3d_top) + call netcdf_err(error, 'WRITING QNIFA CLIMO TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnifa_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING QNIFA CLIMO BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnifa_left, dum3d_left) + call netcdf_err(error, 'WRITING QNIFA CLIMO LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnifa_right, dum3d_right) + call netcdf_err(error, 'WRITING QNIFA CLIMO RIGHT' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID CLIMO QNWFA FOR TILE: ", tile + call ESMF_FieldGather(qnwfa_climo_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnwfa_top, dum3d_top) + call netcdf_err(error, 'WRITING QNWFA CLIMO TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnwfa_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING QNWFA CLIMO BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnwfa_left, dum3d_left) + call netcdf_err(error, 'WRITING QNWFA CLIMO LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnwfa_right, dum3d_right) + call netcdf_err(error, 'WRITING QNWFA CLIMO RIGHT' ) + endif + + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + +!--------------------------------------------------------------------------- +! Set up bounds for 's' winds. Indices are with respect to the whole +! grid - including total halo (boundary plus blending halo). +!--------------------------------------------------------------------------- + + i_start_top = 1 + i_end_top = i_target + j_start_top = jp1_target - halo_p1 + 1 + j_end_top = jp1_target + + i_start_bottom = 1 + i_end_bottom = i_target + j_start_bottom = 1 + j_end_bottom = halo_p1 + + i_start_left = 1 + i_end_left = halo + j_start_left = halo_bndy + 2 + j_end_left = j_target - halo_bndy + + i_start_right = i_target - halo + 1 + i_end_right = i_target + j_start_right = halo_bndy + 2 + j_end_right = j_target - halo_bndy + + if (localpet == 0) then + +! Indices here are with respect to the computational grid - +! without lateral boundary halo but including blending halo. + + allocate(idum(i_start_top:i_end_top)) + do i = i_start_top, i_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_top, idum) + call netcdf_err(error, "WRITING I_S_TOP") + deallocate(idum) + allocate(idum(i_start_bottom:i_end_bottom)) + do i = i_start_bottom, i_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_bottom, idum) + call netcdf_err(error, "WRITING I_S_BOTTOM") + deallocate(idum) + allocate(idum(i_start_left:i_end_left)) + do i = i_start_left, i_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_left, idum) + call netcdf_err(error, "WRITING I_S_LEFT") + deallocate(idum) + allocate(idum(i_start_right:i_end_right)) + do i = i_start_right, i_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_right, idum) + call netcdf_err(error, "WRITING I_S_RIGHT") + deallocate(idum) + allocate(idum(j_start_top:j_end_top)) + do i = j_start_top, j_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_top, idum) + call netcdf_err(error, "WRITING J_S_TOP") + deallocate(idum) + allocate(idum(j_start_bottom:j_end_bottom)) + do i = j_start_bottom, j_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_bottom, idum) + call netcdf_err(error, "WRITING J_S_BOTTOM") + deallocate(idum) + allocate(idum(j_start_left:j_end_left)) + do i = j_start_left, j_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_left, idum) + call netcdf_err(error, "WRITING J_S_LEFT") + deallocate(idum) + allocate(idum(j_start_right:j_end_right)) + do i = j_start_right, j_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_right, idum) + call netcdf_err(error, "WRITING J_S_RIGHT") + deallocate(idum) + endif + +! U-WINDS 'S' + + if (localpet == 0) then + allocate(data_one_tile_3d(i_target,jp1_target,lev_target)) + allocate(dum3d_top(i_start_top:i_end_top, j_start_top:j_end_top, lev_target)) + allocate(dum3d_bottom(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom, lev_target)) + allocate(dum3d_left(i_start_left:i_end_left, j_start_left:j_end_left, lev_target)) + allocate(dum3d_right(i_start_right:i_end_right, j_start_right:j_end_right, lev_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + print*,"- CALL FieldGather FOR TARGET GRID U_S FOR TILE: ", tile + call ESMF_FieldGather(u_s_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_top, dum3d_top) + call netcdf_err(error, 'WRITING U_S TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING U_S BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_left, dum3d_left) + call netcdf_err(error, 'WRITING U_S LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_right, dum3d_right) + call netcdf_err(error, 'WRITING U_S RIGHT' ) + endif + +! V-WINDS 'S' + + print*,"- CALL FieldGather FOR TARGET GRID V_S FOR TILE: ", tile + call ESMF_FieldGather(v_s_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_top, dum3d_top) + call netcdf_err(error, 'WRITING V_S TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING V_S BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_left, dum3d_left) + call netcdf_err(error, 'WRITING V_S LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_right, dum3d_right) + call netcdf_err(error, 'WRITING V_S RIGHT' ) + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + +!--------------------------------------------------------------------------- +! Set up bounds for 'w' winds. Indices are with respect to the whole +! grid - including total halo (boundary plus blending halo). +!--------------------------------------------------------------------------- + + i_start_top = 1 + i_end_top = ip1_target + j_start_top = j_target - halo + 1 + j_end_top = j_target + + i_start_bottom = 1 + i_end_bottom = ip1_target + j_start_bottom = 1 + j_end_bottom = halo + + i_start_left = 1 + i_end_left = halo_p1 + j_start_left = halo_bndy + 1 + j_end_left = j_target - halo_bndy + + i_start_right = ip1_target - halo_p1 + 1 + i_end_right = ip1_target + j_start_right = halo_bndy + 1 + j_end_right = j_target - halo_bndy + + if (localpet == 0) then + +! Indices here are with respect to the computational grid - +! without lateral boundary halo but including blending halo. + + allocate(idum(i_start_top:i_end_top)) + do i = i_start_top, i_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_top, idum) + call netcdf_err(error, "WRITING I_W_TOP") + deallocate(idum) + allocate(idum(i_start_bottom:i_end_bottom)) + do i = i_start_bottom, i_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_bottom, idum) + call netcdf_err(error, "WRITING I_W_BOTTOM") + deallocate(idum) + allocate(idum(i_start_left:i_end_left)) + do i = i_start_left, i_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_left, idum) + call netcdf_err(error, "WRITING I_W_LEFT") + deallocate(idum) + allocate(idum(i_start_right:i_end_right)) + do i = i_start_right, i_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_right, idum) + call netcdf_err(error, "WRITING I_W_RIGHT") + deallocate(idum) + allocate(idum(j_start_top:j_end_top)) + do i = j_start_top, j_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_top, idum) + call netcdf_err(error, "WRITING J_W_TOP") + deallocate(idum) + allocate(idum(j_start_bottom:j_end_bottom)) + do i = j_start_bottom, j_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_bottom, idum) + call netcdf_err(error, "WRITING J_W_BOTTOM") + deallocate(idum) + allocate(idum(j_start_left:j_end_left)) + do i = j_start_left, j_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_left, idum) + call netcdf_err(error, "WRITING J_W_LEFT") + deallocate(idum) + allocate(idum(j_start_right:j_end_right)) + do i = j_start_right, j_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_right, idum) + call netcdf_err(error, "WRITING J_W_RIGHT") + deallocate(idum) + endif + +! U-WINDS 'W' + + if (localpet == 0) then + allocate(data_one_tile_3d(ip1_target,j_target,lev_target)) + allocate(dum3d_top(i_start_top:i_end_top, j_start_top:j_end_top, lev_target)) + allocate(dum3d_bottom(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom, lev_target)) + allocate(dum3d_left(i_start_left:i_end_left, j_start_left:j_end_left, lev_target)) + allocate(dum3d_right(i_start_right:i_end_right, j_start_right:j_end_right, lev_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + print*,"- CALL FieldGather FOR TARGET GRID U_W FOR TILE: ", tile + call ESMF_FieldGather(u_w_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_top, dum3d_top) + call netcdf_err(error, 'WRITING U_W TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING U_W BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_left, dum3d_left) + call netcdf_err(error, 'WRITING U_W LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_right, dum3d_right) + call netcdf_err(error, 'WRITING U_W RIGHT' ) + endif + +! V-WINDS 'W' + + print*,"- CALL FieldGather FOR TARGET GRID V_W FOR TILE: ", tile + call ESMF_FieldGather(v_w_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_top, dum3d_top) + call netcdf_err(error, 'WRITING V_W TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING V_W BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_left, dum3d_left) + call netcdf_err(error, 'WRITING V_W LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_right, dum3d_right) + call netcdf_err(error, 'WRITING V_W RIGHT' ) + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + deallocate(id_tracer_bottom, id_tracer_top, id_tracer_left, id_tracer_right) + + if (localpet == 0) error = nf90_close(ncid) + + end subroutine write_fv3_atm_bndy_data_netcdf + +!--------------------------------------------------------------------------- +! Write atmospheric coldstart files. +! +! Routine write tiled files in parallel. Tile 1 is written by +! localpet 0; tile 2 by localpet 1, etc. The number of pets +! must be equal to or greater than the number of tiled files. +!--------------------------------------------------------------------------- + + subroutine write_fv3_atm_data_netcdf(localpet) + + use esmf + use netcdf + + use program_setup, only : halo=>halo_bndy, & + input_type, tracers, num_tracers, & + use_thomp_mp_climo + + use atmosphere, only : lev_target, & + levp1_target, & + ps_target_grid, & + zh_target_grid, & + dzdt_target_grid, & + qnifa_climo_target_grid, & + qnwfa_climo_target_grid, & + tracers_target_grid, & + temp_target_grid, & + delp_target_grid, & + u_s_target_grid, & + v_s_target_grid, & + u_w_target_grid, & + v_w_target_grid + + use model_grid, only : num_tiles_target_grid, & + i_target, j_target, & + ip1_target, jp1_target, & + longitude_target_grid, & + latitude_target_grid, & + longitude_s_target_grid, & + latitude_s_target_grid, & + longitude_w_target_grid, & + latitude_w_target_grid + + implicit none + + integer, intent(in) :: localpet + + character(len=128) :: outfile + + integer :: error, ncid, tile, n + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: dim_lon, dim_lat + integer :: dim_lonp, dim_latp + integer :: dim_lev, dim_levp1, dim_ntracer + integer, allocatable :: id_tracers(:) + integer :: id_lon, id_lat, id_ps + integer :: id_lat_s, id_lon_s + integer :: id_lat_w, id_lon_w + integer :: id_w, id_zh, id_u_w + integer :: id_v_w, id_u_s, id_v_s + integer :: id_t, id_delp, id_qnifa, id_qnwfa + integer :: i_start, i_end, j_start, j_end + integer :: i_target_out, j_target_out + integer :: ip1_target_out, jp1_target_out + integer :: ip1_end, jp1_end, num_tracers_output + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(kind=4), allocatable :: dum2d(:,:) + real(kind=4), allocatable :: dum3d(:,:,:) + +! Remove any halo region. + + i_target_out = i_target-(2*halo) + j_target_out = j_target-(2*halo) + + i_start = halo + 1 + j_start = halo + 1 + i_end = i_target - halo + j_end = j_target - halo + + ip1_target_out = i_target_out + 1 + jp1_target_out = j_target_out + 1 + + ip1_end = i_end + 1 + jp1_end = j_end + 1 + + if (localpet < num_tiles_target_grid) then + allocate(data_one_tile(i_target,j_target)) + allocate(dum2d(i_target_out,j_target_out)) + else + allocate(data_one_tile(0,0)) + allocate(dum2d(0,0)) + endif + + allocate(id_tracers(num_tracers)) + + HEADER : if (localpet < num_tiles_target_grid) then + + tile = localpet + 1 + WRITE(OUTFILE, '(A, I1, A)') 'out.atm.tile', tile, '.nc' + +!--- open the file + error = nf90_create(outfile, IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING FILE='//trim(outfile) ) + +!--- define dimension + error = nf90_def_dim(ncid, 'lon', i_target_out, dim_lon) + call netcdf_err(error, 'DEFINING LON DIMENSION' ) + error = nf90_def_dim(ncid, 'lat', j_target_out, dim_lat) + call netcdf_err(error, 'DEFINING LAT DIMENSION' ) + error = nf90_def_dim(ncid, 'lonp', ip1_target_out, dim_lonp) + call netcdf_err(error, 'DEFINING LONP DIMENSION' ) + error = nf90_def_dim(ncid, 'latp', jp1_target_out, dim_latp) + call netcdf_err(error, 'DEFINING LATP DIMENSION' ) + error = nf90_def_dim(ncid, 'lev', lev_target, dim_lev) + call netcdf_err(error, 'DEFINING LEV DIMENSION' ) + error = nf90_def_dim(ncid, 'levp', levp1_target, dim_levp1) + call netcdf_err(error, 'DEFINING LEVP DIMENSION' ) + num_tracers_output = num_tracers + if (use_thomp_mp_climo) num_tracers_output = num_tracers + 2 + error = nf90_def_dim(ncid, 'ntracer', num_tracers_output, dim_ntracer) + call netcdf_err(error, 'DEFINING NTRACER DIMENSION' ) + +!--- define global attributes + if (trim(input_type) == "gaussian_nemsio") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gaussian_netcdf") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GAUSSIAN NETCDF FILE') + elseif (trim(input_type) == "gfs_gaussian_nemsio") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gfs_sigio") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS SIGIO FILE') + elseif (trim(input_type) == "history") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED HISTORY FILE') + elseif (trim(input_type) == "restart") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED RESTART FILE') + elseif (trim(input_type) == "grib2") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GRIB2 FILE') + endif + +!--- define field + error = nf90_def_var(ncid, 'geolon', NF90_FLOAT, (/dim_lon,dim_lat/), id_lon) + call netcdf_err(error, 'DEFINING GEOLON FIELD' ) + error = nf90_put_att(ncid, id_lon, "long_name", "Longitude") + call netcdf_err(error, 'DEFINING GEOLON NAME' ) + error = nf90_put_att(ncid, id_lon, "units", "degrees_east") + call netcdf_err(error, 'DEFINING GEOLON UNITS' ) + + error = nf90_def_var(ncid, 'geolat', NF90_FLOAT, (/dim_lon,dim_lat/), id_lat) + call netcdf_err(error, 'DEFINING GEOLAT FIELD' ) + error = nf90_put_att(ncid, id_lat, "long_name", "Latitude") + call netcdf_err(error, 'DEFINING GEOLAT NAME' ) + error = nf90_put_att(ncid, id_lat, "units", "degrees_north") + call netcdf_err(error, 'DEFINING GEOLAT UNITS' ) + + error = nf90_def_var(ncid, 'geolon_s', NF90_FLOAT, (/dim_lon,dim_latp/), id_lon_s) + call netcdf_err(error, 'DEFINING GEOLON_S FIELD' ) + error = nf90_put_att(ncid, id_lon_s, "long_name", "Longitude_s") + call netcdf_err(error, 'DEFINING GEOLON_S NAME' ) + error = nf90_put_att(ncid, id_lon_s, "units", "degrees_east") + call netcdf_err(error, 'DEFINING GEOLON_S UNITS' ) + + error = nf90_def_var(ncid, 'geolat_s', NF90_FLOAT, (/dim_lon,dim_latp/), id_lat_s) + call netcdf_err(error, 'DEFINING GEOLAT_S FIELD' ) + error = nf90_put_att(ncid, id_lat_s, "long_name", "Latitude_s") + call netcdf_err(error, 'DEFINING GEOLAT_S NAME' ) + error = nf90_put_att(ncid, id_lat_s, "units", "degrees_north") + call netcdf_err(error, 'DEFINING GEOLAT_S UNITS' ) + + error = nf90_def_var(ncid, 'geolon_w', NF90_FLOAT, (/dim_lonp,dim_lat/), id_lon_w) + call netcdf_err(error, 'DEFINING GEOLON_W FIELD' ) + error = nf90_put_att(ncid, id_lon_w, "long_name", "Longitude_w") + call netcdf_err(error, 'DEFINING GEOLON_W NAME' ) + error = nf90_put_att(ncid, id_lon_w, "units", "degrees_east") + call netcdf_err(error, 'DEFINING GEOLON_W UNITS' ) + + error = nf90_def_var(ncid, 'geolat_w', NF90_FLOAT, (/dim_lonp,dim_lat/), id_lat_w) + call netcdf_err(error, 'DEFINING GEOLAT_W FIELD' ) + error = nf90_put_att(ncid, id_lat_w, "long_name", "Latitude_w") + call netcdf_err(error, 'DEFINING GEOLAT_W NAME' ) + error = nf90_put_att(ncid, id_lat_w, "units", "degrees_north") + call netcdf_err(error, 'DEFINING GEOLAT_W UNITS' ) + + error = nf90_def_var(ncid, 'ps', NF90_FLOAT, (/dim_lon,dim_lat/), id_ps) + call netcdf_err(error, 'DEFINING PS' ) + error = nf90_put_att(ncid, id_ps, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING PS COORD' ) + + error = nf90_def_var(ncid, 'w', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_w) + call netcdf_err(error, 'DEFINING W' ) + error = nf90_put_att(ncid, id_w, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING W COORD' ) + + error = nf90_def_var(ncid, 'zh', NF90_FLOAT, (/dim_lon,dim_lat,dim_levp1/), id_zh) + call netcdf_err(error, 'DEFINING ZH' ) + error = nf90_put_att(ncid, id_zh, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING ZH COORD' ) + + error = nf90_def_var(ncid, 't', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_t) + call netcdf_err(error, 'DEFINING T' ) + error = nf90_put_att(ncid, id_t, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING T COORD' ) + + error = nf90_def_var(ncid, 'delp', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_delp) + call netcdf_err(error, 'DEFINING DELP' ) + error = nf90_put_att(ncid, id_delp, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING DELP COORD' ) + + do n = 1, num_tracers + error = nf90_def_var(ncid, tracers(n), NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_tracers(n)) + call netcdf_err(error, 'DEFINING TRACERS' ) + error = nf90_put_att(ncid, id_tracers(n), "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING TRACERS COORD' ) + enddo + + if (use_thomp_mp_climo) then + error = nf90_def_var(ncid, 'ice_aero', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_qnifa) + call netcdf_err(error, 'DEFINING QNIFA' ) + error = nf90_put_att(ncid, id_qnifa, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING QNIFA COORD' ) + + error = nf90_def_var(ncid, 'liq_aero', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_qnwfa) + call netcdf_err(error, 'DEFINING QNWFA' ) + error = nf90_put_att(ncid, id_qnwfa, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING QNWFA COORD' ) + endif + + error = nf90_def_var(ncid, 'u_w', NF90_FLOAT, (/dim_lonp,dim_lat,dim_lev/), id_u_w) + call netcdf_err(error, 'DEFINING U_W' ) + error = nf90_put_att(ncid, id_u_w, "coordinates", "geolon_w geolat_w") + call netcdf_err(error, 'DEFINING U_W COORD' ) + + error = nf90_def_var(ncid, 'v_w', NF90_FLOAT, (/dim_lonp,dim_lat,dim_lev/), id_v_w) + call netcdf_err(error, 'DEFINING V_W' ) + error = nf90_put_att(ncid, id_v_w, "coordinates", "geolon_w geolat_w") + call netcdf_err(error, 'DEFINING V_W COORD' ) + + error = nf90_def_var(ncid, 'u_s', NF90_FLOAT, (/dim_lon,dim_latp,dim_lev/), id_u_s) + call netcdf_err(error, 'DEFINING U_S' ) + error = nf90_put_att(ncid, id_u_s, "coordinates", "geolon_s geolat_s") + call netcdf_err(error, 'DEFINING U_S COORD' ) + + error = nf90_def_var(ncid, 'v_s', NF90_FLOAT, (/dim_lon,dim_latp,dim_lev/), id_v_s) + call netcdf_err(error, 'DEFINING V_S' ) + error = nf90_put_att(ncid, id_v_s, "coordinates", "geolon_s geolat_s") + call netcdf_err(error, 'DEFINING V_S COORD' ) + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'DEFINING HEADER' ) + + endif HEADER + +! longitude + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LONGITUDE FOR TILE: ", tile + call ESMF_FieldGather(longitude_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + error = nf90_put_var( ncid, id_lon, dum2d) + call netcdf_err(error, 'WRITING LONGITUDE RECORD' ) + endif + +! latitude + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LATITUDE FOR TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + error = nf90_put_var( ncid, id_lat, dum2d) + call netcdf_err(error, 'WRITING LATITUDE RECORD' ) + endif + +! surface pressure + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID SURFACE PRESSURE FOR TILE: ", tile + call ESMF_FieldGather(ps_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + error = nf90_put_var( ncid, id_ps, dum2d) + call netcdf_err(error, 'WRITING SURFACE PRESSURE RECORD' ) + endif + + deallocate(dum2d, data_one_tile) + +! height + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(i_target_out,j_target_out,levp1_target)) + allocate(data_one_tile_3d(i_target,j_target,levp1_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID HEIGHT FOR TILE: ", tile + call ESMF_FieldGather(zh_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:levp1_target) = dum3d(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh, dum3d) + call netcdf_err(error, 'WRITING HEIGHT RECORD' ) + endif + + deallocate(dum3d, data_one_tile_3d) + +! vertical velocity + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(i_target_out,j_target_out,lev_target)) + allocate(data_one_tile_3d(i_target,j_target,lev_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID VERTICAL VELOCITY FOR TILE: ", tile + call ESMF_FieldGather(dzdt_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w, dum3d) + call netcdf_err(error, 'WRITING VERTICAL VELOCITY RECORD' ) + endif + +! delp + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID DELP FOR TILE: ", tile + call ESMF_FieldGather(delp_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_delp, dum3d) + call netcdf_err(error, 'WRITING DELP RECORD' ) + endif + +! temperature + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID TEMPERATURE FOR TILE: ", tile + call ESMF_FieldGather(temp_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_t, dum3d) + call netcdf_err(error, 'WRITING TEMPERTAURE RECORD' ) + endif + +! tracers + + do n = 1, num_tracers + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID TRACER ", trim(tracers(n)), " TILE: ", tile + call ESMF_FieldGather(tracers_target_grid(n), data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracers(n), dum3d) + call netcdf_err(error, 'WRITING TRACER RECORD' ) + endif + + enddo + +! qnifa + + if (use_thomp_mp_climo) then + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID QNIFA FOR TILE: ", tile + call ESMF_FieldGather(qnifa_climo_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnifa, dum3d) + call netcdf_err(error, 'WRITING QNIFA RECORD' ) + endif + +! qnwfa + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID QNWFA FOR TILE: ", tile + call ESMF_FieldGather(qnwfa_climo_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_qnwfa, dum3d) + call netcdf_err(error, 'WRITING QNWFA RECORD' ) + endif + endif + + deallocate(dum3d, data_one_tile_3d) + +! lat/lon_s + + if (localpet < num_tiles_target_grid) then + allocate(dum2d(i_target_out,jp1_target_out)) + allocate(data_one_tile(i_target,jp1_target)) + else + allocate(dum2d(0,0)) + allocate(data_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LON_S FOR TILE: ", tile + call ESMF_FieldGather(longitude_s_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end,j_start:jp1_end) + error = nf90_put_var( ncid, id_lon_s, dum2d) + call netcdf_err(error, 'WRITING LON_S RECORD' ) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LAT_S FOR TILE: ", tile + call ESMF_FieldGather(latitude_s_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end,j_start:jp1_end) + error = nf90_put_var( ncid, id_lat_s, dum2d) + call netcdf_err(error, 'WRITING LAT_S RECORD' ) + endif + + deallocate(dum2d, data_one_tile) + +! uwinds s + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(i_target_out,jp1_target_out,lev_target)) + allocate(data_one_tile_3d(i_target,jp1_target,lev_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID U_S FOR TILE: ", tile + call ESMF_FieldGather(u_s_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:jp1_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s, dum3d) + call netcdf_err(error, 'WRITING U_S RECORD' ) + endif + +! vwinds s + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID V_S FOR TILE: ", tile + call ESMF_FieldGather(v_s_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:jp1_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s, dum3d) + call netcdf_err(error, 'WRITING V_S RECORD' ) + endif + + deallocate(dum3d, data_one_tile_3d) + +! lat/lon_w + + if (localpet < num_tiles_target_grid) then + allocate(dum2d(ip1_target_out,j_target_out)) + allocate(data_one_tile(ip1_target,j_target)) + else + allocate(dum2d(0,0)) + allocate(data_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LON_W FOR TILE: ", tile + call ESMF_FieldGather(longitude_w_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:ip1_end,j_start:j_end) + error = nf90_put_var( ncid, id_lon_w, dum2d) + call netcdf_err(error, 'WRITING LON_W RECORD' ) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LAT_W FOR TILE: ", tile + call ESMF_FieldGather(latitude_w_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:ip1_end,j_start:j_end) + error = nf90_put_var( ncid, id_lat_w, dum2d) + call netcdf_err(error, 'WRITING LAT_W RECORD' ) + endif + + deallocate(dum2d, data_one_tile) + +! uwinds w + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(ip1_target_out,j_target_out,lev_target)) + allocate(data_one_tile_3d(ip1_target,j_target,lev_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID U_W FOR TILE: ", tile + call ESMF_FieldGather(u_w_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:ip1_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w, dum3d) + call netcdf_err(error, 'WRITING U_W RECORD' ) + endif + +! vwinds w + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID V_W FOR TILE: ", tile + call ESMF_FieldGather(v_w_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:ip1_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w, dum3d) + call netcdf_err(error, 'WRITING V_W RECORD' ) + endif + + deallocate(dum3d, data_one_tile_3d, id_tracers) + +!------------------------------------------------------------------------------- +! close file +!------------------------------------------------------------------------------- + + if (localpet < num_tiles_target_grid) error = nf90_close(ncid) + + end subroutine write_fv3_atm_data_netcdf + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + + subroutine write_fv3_sfc_data_netcdf(localpet) + + use esmf + use netcdf + + use model_grid, only : num_tiles_target_grid, & + landmask_target_grid, & + latitude_target_grid, & + longitude_target_grid, & + i_target, j_target, lsoil_target + + use program_setup, only : convert_nst, halo=>halo_bndy + + use surface, only : canopy_mc_target_grid, & + f10m_target_grid, & + ffmm_target_grid, & + q2m_target_grid, & + seaice_depth_target_grid, & + seaice_fract_target_grid, & + seaice_skin_temp_target_grid, & + skin_temp_target_grid, & + soil_temp_target_grid, & + soilm_liq_target_grid, & + soilm_tot_target_grid, & + srflag_target_grid, & + snow_liq_equiv_target_grid, & + snow_depth_target_grid, & + t2m_target_grid, & + tprcp_target_grid, & + ustar_target_grid, & + z0_target_grid, & + c_d_target_grid, & + c_0_target_grid, & + d_conv_target_grid, & + dt_cool_target_grid, & + ifd_target_grid, & + qrain_target_grid, & + tref_target_grid, & + w_d_target_grid, & + w_0_target_grid, & + xs_target_grid, & + xt_target_grid, & + xu_target_grid, & + xv_target_grid, & + xz_target_grid, & + xtts_target_grid, & + xzts_target_grid, & + z_c_target_grid, & + zm_target_grid + + use static_data, only : alvsf_target_grid, & + alnsf_target_grid, & + alvwf_target_grid, & + alnwf_target_grid, & + facsf_target_grid, & + facwf_target_grid, & + max_veg_greenness_target_grid, & + min_veg_greenness_target_grid, & + mxsno_albedo_target_grid, & + slope_type_target_grid, & + soil_type_target_grid, & + substrate_temp_target_grid, & + veg_greenness_target_grid, & + veg_type_target_grid + + implicit none + + integer, intent(in) :: localpet + character(len=128) :: outfile + + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: dim_x, dim_y, dim_lsoil, dim_time + integer :: error, i, ncid, tile + integer :: id_x, id_y, id_lsoil + integer :: id_slmsk, id_time + integer :: id_lat, id_lon + integer :: id_tsea, id_sheleg, id_tg3 + integer :: id_zorl, id_alvsf, id_alvwf + integer :: id_alnsf, id_alnwf, id_vfrac + integer :: id_canopy, id_f10m, id_t2m + integer :: id_q2m, id_vtype, id_stype + integer :: id_facsf, id_facwf, id_uustar + integer :: id_ffmm, id_ffhh, id_hice + integer :: id_fice, id_tisfc, id_tprcp + integer :: id_srflag, id_snwdph, id_shdmin + integer :: id_shdmax, id_slope, id_snoalb + integer :: id_stc, id_smc, id_slc + integer :: id_tref, id_z_c, id_c_0 + integer :: id_c_d, id_w_0, id_w_d + integer :: id_xt, id_xs, id_xu, id_xv + integer :: id_xz, id_zm, id_xtts, id_xzts + integer :: id_d_conv, id_ifd, id_dt_cool + integer :: id_qrain + integer :: i_target_out, j_target_out + integer :: istart, iend, jstart, jend + + integer(esmf_kind_i8), allocatable :: idata_one_tile(:,:) + + real(kind=4), allocatable :: lsoil_data(:), x_data(:), y_data(:) + real(kind=8), allocatable :: dum2d(:,:), dum3d(:,:,:) + real(kind=4) :: times + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + +! Remove any halo region. + + i_target_out = i_target-(2*halo) + j_target_out = j_target-(2*halo) + + istart = halo + 1 + jstart = halo + 1 + iend = i_target - halo + jend = j_target - halo + + allocate(lsoil_data(lsoil_target)) + do i = 1, lsoil_target + lsoil_data(i) = float(i) + enddo + + allocate(x_data(i_target_out)) + do i = 1, i_target_out + x_data(i) = float(i) + enddo + + allocate(y_data(j_target_out)) + do i = 1, j_target_out + y_data(i) = float(i) + enddo + + if (convert_nst) then + print*,'- WRITE FV3 SURFACE AND NST DATA TO NETCDF FILE' + else + print*,'- WRITE FV3 SURFACE DATA TO NETCDF FILE' + endif + + if (localpet == 0) then + allocate(data_one_tile(i_target,j_target)) + allocate(data_one_tile_3d(i_target,j_target,lsoil_target)) + allocate(idata_one_tile(i_target,j_target)) + allocate(dum2d(i_target_out,j_target_out)) + allocate(dum3d(i_target_out,j_target_out,lsoil_target)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + allocate(idata_one_tile(0,0)) + allocate(dum2d(0,0)) + allocate(dum3d(0,0,0)) + endif + + TILE_LOOP : do tile = 1, num_tiles_target_grid + + LOCAL_PET : if (localpet == 0) then + + WRITE(OUTFILE, '(A, I1, A)') 'out.sfc.tile', tile, '.nc' + +!--- open the file + error = nf90_create(outfile, IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING FILE='//trim(outfile) ) + +!--- define dimensions + error = nf90_def_dim(ncid, 'xaxis_1', i_target_out, dim_x) + call netcdf_err(error, 'DEFINING XAXIS DIMENSION' ) + error = nf90_def_dim(ncid, 'yaxis_1', j_target_out, dim_y) + call netcdf_err(error, 'DEFINING YAXIS DIMENSION' ) + error = nf90_def_dim(ncid, 'zaxis_1', lsoil_target, dim_lsoil) + call netcdf_err(error, 'DEFINING ZAXIS DIMENSION' ) + error = nf90_def_dim(ncid, 'Time', 1, dim_time) + call netcdf_err(error, 'DEFINING TIME DIMENSION' ) + + !--- define fields + error = nf90_def_var(ncid, 'xaxis_1', NF90_FLOAT, (/dim_x/), id_x) + call netcdf_err(error, 'DEFINING XAXIS_1 FIELD' ) + error = nf90_put_att(ncid, id_x, "long_name", "xaxis_1") + call netcdf_err(error, 'DEFINING XAXIS_1 LONG NAME' ) + error = nf90_put_att(ncid, id_x, "units", "none") + call netcdf_err(error, 'DEFINING XAXIS_1 UNITS' ) + error = nf90_put_att(ncid, id_x, "cartesian_axis", "X") + call netcdf_err(error, 'WRITING XAXIS_1 FIELD' ) + + error = nf90_def_var(ncid, 'yaxis_1', NF90_FLOAT, (/dim_y/), id_y) + call netcdf_err(error, 'DEFINING YAXIS_1 FIELD' ) + error = nf90_put_att(ncid, id_y, "long_name", "yaxis_1") + call netcdf_err(error, 'DEFINING YAXIS_1 LONG NAME' ) + error = nf90_put_att(ncid, id_y, "units", "none") + call netcdf_err(error, 'DEFINING YAXIS_1 UNITS' ) + error = nf90_put_att(ncid, id_y, "cartesian_axis", "Y") + call netcdf_err(error, 'WRITING YAXIS_1 FIELD' ) + + error = nf90_def_var(ncid, 'zaxis_1', NF90_FLOAT, (/dim_lsoil/), id_lsoil) + call netcdf_err(error, 'DEFINING ZAXIS_1 FIELD' ) + error = nf90_put_att(ncid, id_lsoil, "long_name", "zaxis_1") + call netcdf_err(error, 'DEFINING ZAXIS_1 LONG NAME' ) + error = nf90_put_att(ncid, id_lsoil, "units", "none") + call netcdf_err(error, 'DEFINING ZAXIS_1 UNITS' ) + error = nf90_put_att(ncid, id_lsoil, "cartesian_axis", "Z") + call netcdf_err(error, 'WRITING ZAXIS_1 FIELD' ) + + error = nf90_def_var(ncid, 'Time', NF90_FLOAT, dim_time, id_time) + call netcdf_err(error, 'DEFINING TIME FIELD' ) + error = nf90_put_att(ncid, id_time, "long_name", "Time") + call netcdf_err(error, 'DEFINING TIME LONG NAME' ) + error = nf90_put_att(ncid, id_time, "units", "time level") + call netcdf_err(error, 'DEFINING TIME UNITS' ) + error = nf90_put_att(ncid, id_time, "cartesian_axis", "T") + call netcdf_err(error, 'WRITING TIME FIELD' ) + + error = nf90_def_var(ncid, 'geolon', NF90_DOUBLE, (/dim_x,dim_y/), id_lon) + call netcdf_err(error, 'DEFINING GEOLON' ) + error = nf90_put_att(ncid, id_lon, "long_name", "Longitude") + call netcdf_err(error, 'DEFINING GEOLON LONG NAME' ) + error = nf90_put_att(ncid, id_lon, "units", "degrees_east") + call netcdf_err(error, 'DEFINING GEOLON UNITS' ) + + error = nf90_def_var(ncid, 'geolat', NF90_DOUBLE, (/dim_x,dim_y/), id_lat) + call netcdf_err(error, 'DEFINING GEOLAT' ) + error = nf90_put_att(ncid, id_lat, "long_name", "Latitude") + call netcdf_err(error, 'DEFINING GEOLAT LONG NAME' ) + error = nf90_put_att(ncid, id_lat, "units", "degrees_north") + call netcdf_err(error, 'DEFINING GEOLAT UNITS' ) + + error = nf90_def_var(ncid, 'slmsk', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_slmsk) + call netcdf_err(error, 'DEFINING SLMSK' ) + error = nf90_put_att(ncid, id_slmsk, "long_name", "slmsk") + call netcdf_err(error, 'DEFINING SLMSK LONG NAME' ) + error = nf90_put_att(ncid, id_slmsk, "units", "none") + call netcdf_err(error, 'DEFINING SLMSK UNITS' ) + error = nf90_put_att(ncid, id_slmsk, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SLMSK COORD' ) + + error = nf90_def_var(ncid, 'tsea', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tsea) + call netcdf_err(error, 'DEFINING TSEA' ) + error = nf90_put_att(ncid, id_tsea, "long_name", "tsea") + call netcdf_err(error, 'DEFINING TSEA LONG NAME' ) + error = nf90_put_att(ncid, id_tsea, "units", "none") + call netcdf_err(error, 'DEFINING TSEA UNITS' ) + error = nf90_put_att(ncid, id_tsea, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING TSEA COORD' ) + + error = nf90_def_var(ncid, 'sheleg', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_sheleg) + call netcdf_err(error, 'DEFINING SHELEG' ) + error = nf90_put_att(ncid, id_sheleg, "long_name", "sheleg") + call netcdf_err(error, 'DEFINING SHELEG LONG NAME' ) + error = nf90_put_att(ncid, id_sheleg, "units", "none") + call netcdf_err(error, 'DEFINING SHELEG UNITS' ) + error = nf90_put_att(ncid, id_sheleg, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SHELEG COORD' ) + + error = nf90_def_var(ncid, 'tg3', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tg3) + call netcdf_err(error, 'DEFINING TG3' ) + error = nf90_put_att(ncid, id_tg3, "long_name", "tg3") + call netcdf_err(error, 'DEFINING TG3 LONG NAME' ) + error = nf90_put_att(ncid, id_tg3, "units", "none") + call netcdf_err(error, 'DEFINING TG3 UNITS' ) + error = nf90_put_att(ncid, id_tg3, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING TG3 COORD' ) + + error = nf90_def_var(ncid, 'zorl', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_zorl) + call netcdf_err(error, 'DEFINING ZORL' ) + error = nf90_put_att(ncid, id_zorl, "long_name", "zorl") + call netcdf_err(error, 'DEFINING ZORL LONG NAME' ) + error = nf90_put_att(ncid, id_zorl, "units", "none") + call netcdf_err(error, 'DEFINING ZORL UNITS' ) + error = nf90_put_att(ncid, id_zorl, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING ZORL COORD' ) + + error = nf90_def_var(ncid, 'alvsf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alvsf) + call netcdf_err(error, 'DEFINING ALVSF' ) + error = nf90_put_att(ncid, id_alvsf, "long_name", "alvsf") + call netcdf_err(error, 'DEFINING ALVSF LONG NAME' ) + error = nf90_put_att(ncid, id_alvsf, "units", "none") + call netcdf_err(error, 'DEFINING ALVSF UNITS' ) + error = nf90_put_att(ncid, id_alvsf, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING ALVSF COORD' ) + + error = nf90_def_var(ncid, 'alvwf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alvwf) + call netcdf_err(error, 'DEFINING ALVWF' ) + error = nf90_put_att(ncid, id_alvwf, "long_name", "alvwf") + call netcdf_err(error, 'DEFINING ALVWF LONG NAME' ) + error = nf90_put_att(ncid, id_alvwf, "units", "none") + call netcdf_err(error, 'DEFINING ALVWF UNITS' ) + error = nf90_put_att(ncid, id_alvwf, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING ALVWF COORD' ) + + error = nf90_def_var(ncid, 'alnsf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alnsf) + call netcdf_err(error, 'DEFINING ALNSF' ) + error = nf90_put_att(ncid, id_alnsf, "long_name", "alnsf") + call netcdf_err(error, 'DEFINING ALNSF LONG NAME' ) + error = nf90_put_att(ncid, id_alnsf, "units", "none") + call netcdf_err(error, 'DEFINING ALNSF UNITS' ) + error = nf90_put_att(ncid, id_alnsf, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING ALNSF COORD' ) + + error = nf90_def_var(ncid, 'alnwf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alnwf) + call netcdf_err(error, 'DEFINING ALNWF' ) + error = nf90_put_att(ncid, id_alnwf, "long_name", "alnwf") + call netcdf_err(error, 'DEFINING ALNWF LONG NAME' ) + error = nf90_put_att(ncid, id_alnwf, "units", "none") + call netcdf_err(error, 'DEFINING ALNWF UNITS' ) + error = nf90_put_att(ncid, id_alnwf, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING ALNWF COORD' ) + + error = nf90_def_var(ncid, 'facsf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_facsf) + call netcdf_err(error, 'DEFINING FACSF' ) + error = nf90_put_att(ncid, id_facsf, "long_name", "facsf") + call netcdf_err(error, 'DEFINING FACSF LONG NAME' ) + error = nf90_put_att(ncid, id_facsf, "units", "none") + call netcdf_err(error, 'DEFINING FACSF UNITS' ) + error = nf90_put_att(ncid, id_facsf, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING FACSF COORD' ) + + error = nf90_def_var(ncid, 'facwf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_facwf) + call netcdf_err(error, 'DEFINING FACWF' ) + error = nf90_put_att(ncid, id_facwf, "long_name", "facwf") + call netcdf_err(error, 'DEFINING FACWF LONG NAME' ) + error = nf90_put_att(ncid, id_facwf, "units", "none") + call netcdf_err(error, 'DEFINING FACWF UNITS' ) + error = nf90_put_att(ncid, id_facwf, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING FACWF COORD' ) + + error = nf90_def_var(ncid, 'vfrac', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_vfrac) + call netcdf_err(error, 'DEFINING VFRAC' ) + error = nf90_put_att(ncid, id_vfrac, "long_name", "vfrac") + call netcdf_err(error, 'DEFINING VFRAC LONG NAME' ) + error = nf90_put_att(ncid, id_vfrac, "units", "none") + call netcdf_err(error, 'DEFINING VFRAC UNITS' ) + error = nf90_put_att(ncid, id_vfrac, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING VFRAC COORD' ) + + error = nf90_def_var(ncid, 'canopy', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_canopy) + call netcdf_err(error, 'DEFINING CANOPY' ) + error = nf90_put_att(ncid, id_canopy, "long_name", "canopy") + call netcdf_err(error, 'DEFINING CANOPY LONG NAME' ) + error = nf90_put_att(ncid, id_canopy, "units", "none") + call netcdf_err(error, 'DEFINING CANOPY UNITS' ) + error = nf90_put_att(ncid, id_canopy, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING CANOPY COORD' ) + + error = nf90_def_var(ncid, 'f10m', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_f10m) + call netcdf_err(error, 'DEFINING F10M' ) + error = nf90_put_att(ncid, id_f10m, "long_name", "f10m") + call netcdf_err(error, 'DEFINING F10M LONG NAME' ) + error = nf90_put_att(ncid, id_f10m, "units", "none") + call netcdf_err(error, 'DEFINING F10M UNITS' ) + error = nf90_put_att(ncid, id_f10m, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING F10M COORD' ) + + error = nf90_def_var(ncid, 't2m', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_t2m) + call netcdf_err(error, 'DEFINING T2M' ) + error = nf90_put_att(ncid, id_t2m, "long_name", "t2m") + call netcdf_err(error, 'DEFINING T2M LONG NAME' ) + error = nf90_put_att(ncid, id_t2m, "units", "none") + call netcdf_err(error, 'DEFINING T2M UNITS' ) + error = nf90_put_att(ncid, id_t2m, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING T2M COORD' ) + + error = nf90_def_var(ncid, 'q2m', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_q2m) + call netcdf_err(error, 'DEFINING Q2M' ) + error = nf90_put_att(ncid, id_q2m, "long_name", "q2m") + call netcdf_err(error, 'DEFINING Q2M LONG NAME' ) + error = nf90_put_att(ncid, id_q2m, "units", "none") + call netcdf_err(error, 'DEFINING Q2M UNITS' ) + error = nf90_put_att(ncid, id_q2m, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING Q2M COORD' ) + + error = nf90_def_var(ncid, 'vtype', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_vtype) + call netcdf_err(error, 'DEFINING VTYPE' ) + error = nf90_put_att(ncid, id_vtype, "long_name", "vtype") + call netcdf_err(error, 'DEFINING VTYPE LONG NAME' ) + error = nf90_put_att(ncid, id_vtype, "units", "none") + call netcdf_err(error, 'DEFINING VTYPE UNITS' ) + error = nf90_put_att(ncid, id_vtype, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING VTYPE COORD' ) + + error = nf90_def_var(ncid, 'stype', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_stype) + call netcdf_err(error, 'DEFINING STYPE' ) + error = nf90_put_att(ncid, id_stype, "long_name", "stype") + call netcdf_err(error, 'DEFINING STYPE LONG NAME' ) + error = nf90_put_att(ncid, id_stype, "units", "none") + call netcdf_err(error, 'DEFINING STYPE UNITS' ) + error = nf90_put_att(ncid, id_stype, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING STYPE COORD' ) + + error = nf90_def_var(ncid, 'uustar', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_uustar) + call netcdf_err(error, 'DEFINING UUSTAR' ) + error = nf90_put_att(ncid, id_uustar, "long_name", "uustar") + call netcdf_err(error, 'DEFINING UUSTAR LONG NAME' ) + error = nf90_put_att(ncid, id_uustar, "units", "none") + call netcdf_err(error, 'DEFINING UUSTAR UNITS' ) + error = nf90_put_att(ncid, id_uustar, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING UUSTAR COORD' ) + + error = nf90_def_var(ncid, 'ffmm', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_ffmm) + call netcdf_err(error, 'DEFINING FFMM' ) + error = nf90_put_att(ncid, id_ffmm, "long_name", "ffmm") + call netcdf_err(error, 'DEFINING FFMM LONG NAME' ) + error = nf90_put_att(ncid, id_ffmm, "units", "none") + call netcdf_err(error, 'DEFINING FFMM UNITS' ) + error = nf90_put_att(ncid, id_ffmm, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING FFMM COORD' ) + + error = nf90_def_var(ncid, 'ffhh', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_ffhh) + call netcdf_err(error, 'DEFINING FFHH' ) + error = nf90_put_att(ncid, id_ffhh, "long_name", "ffhh") + call netcdf_err(error, 'DEFINING FFHH LONG NAME' ) + error = nf90_put_att(ncid, id_ffhh, "units", "none") + call netcdf_err(error, 'DEFINING FFHH UNITS' ) + error = nf90_put_att(ncid, id_ffhh, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING FFHH COORD' ) + + error = nf90_def_var(ncid, 'hice', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_hice) + call netcdf_err(error, 'DEFINING HICE' ) + error = nf90_put_att(ncid, id_hice, "long_name", "hice") + call netcdf_err(error, 'DEFINING HICE LONG NAME' ) + error = nf90_put_att(ncid, id_hice, "units", "none") + call netcdf_err(error, 'DEFINING HICE UNITS' ) + error = nf90_put_att(ncid, id_hice, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING HICE COORD' ) + + error = nf90_def_var(ncid, 'fice', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_fice) + call netcdf_err(error, 'DEFINING FICE' ) + error = nf90_put_att(ncid, id_fice, "long_name", "fice") + call netcdf_err(error, 'DEFINING FICE LONG NAME' ) + error = nf90_put_att(ncid, id_fice, "units", "none") + call netcdf_err(error, 'DEFINING FICE UNITS' ) + error = nf90_put_att(ncid, id_fice, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING FICE COORD' ) + + error = nf90_def_var(ncid, 'tisfc', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tisfc) + call netcdf_err(error, 'DEFINING TISFC' ) + error = nf90_put_att(ncid, id_tisfc, "long_name", "tisfc") + call netcdf_err(error, 'DEFINING TISFC LONG NAME' ) + error = nf90_put_att(ncid, id_tisfc, "units", "none") + call netcdf_err(error, 'DEFINING TISFC UNITS' ) + error = nf90_put_att(ncid, id_tisfc, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING TISFC COORD' ) + + error = nf90_def_var(ncid, 'tprcp', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tprcp) + call netcdf_err(error, 'DEFINING TPRCP' ) + error = nf90_put_att(ncid, id_tprcp, "long_name", "tprcp") + call netcdf_err(error, 'DEFINING TPRCP LONG NAME' ) + error = nf90_put_att(ncid, id_tprcp, "units", "none") + call netcdf_err(error, 'DEFINING TPRCP UNITS' ) + error = nf90_put_att(ncid, id_tprcp, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING TPRCP COORD' ) + + error = nf90_def_var(ncid, 'srflag', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_srflag) + call netcdf_err(error, 'DEFINING SRFLAG' ) + error = nf90_put_att(ncid, id_srflag, "long_name", "srflag") + call netcdf_err(error, 'DEFINING SRFLAG LONG NAME' ) + error = nf90_put_att(ncid, id_srflag, "units", "none") + call netcdf_err(error, 'DEFINING SRFLAG UNITS' ) + error = nf90_put_att(ncid, id_srflag, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SRFLAG COORD' ) + + error = nf90_def_var(ncid, 'snwdph', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_snwdph) + call netcdf_err(error, 'DEFINING SNWDPH' ) + error = nf90_put_att(ncid, id_snwdph, "long_name", "snwdph") + call netcdf_err(error, 'DEFINING SNWDPH LONG NAME' ) + error = nf90_put_att(ncid, id_snwdph, "units", "none") + call netcdf_err(error, 'DEFINING SNWDPH UNITS' ) + error = nf90_put_att(ncid, id_snwdph, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SNWDPH COORD' ) + + error = nf90_def_var(ncid, 'shdmin', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_shdmin) + call netcdf_err(error, 'DEFINING SHDMIN' ) + error = nf90_put_att(ncid, id_shdmin, "long_name", "shdmin") + call netcdf_err(error, 'DEFINING SHDMIN LONG NAME' ) + error = nf90_put_att(ncid, id_shdmin, "units", "none") + call netcdf_err(error, 'DEFINING SHDMIN UNITS' ) + error = nf90_put_att(ncid, id_shdmin, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SHDMIN COORD' ) + + error = nf90_def_var(ncid, 'shdmax', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_shdmax) + call netcdf_err(error, 'DEFINING SHDMAX' ) + error = nf90_put_att(ncid, id_shdmax, "long_name", "shdmax") + call netcdf_err(error, 'DEFINING SHDMAX LONG NAME' ) + error = nf90_put_att(ncid, id_shdmax, "units", "none") + call netcdf_err(error, 'DEFINING SHDMAX UNITS' ) + error = nf90_put_att(ncid, id_shdmax, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SHDMAX COORD' ) + + error = nf90_def_var(ncid, 'slope', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_slope) + call netcdf_err(error, 'DEFINING SLOPE' ) + error = nf90_put_att(ncid, id_slope, "long_name", "slope") + call netcdf_err(error, 'DEFINING SLOPE LONG NAME' ) + error = nf90_put_att(ncid, id_slope, "units", "none") + call netcdf_err(error, 'DEFINING SLOPE UNITS' ) + error = nf90_put_att(ncid, id_slope, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SLOPE COORD' ) + + error = nf90_def_var(ncid, 'snoalb', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_snoalb) + call netcdf_err(error, 'DEFINING SNOALB' ) + error = nf90_put_att(ncid, id_snoalb, "long_name", "snoalb") + call netcdf_err(error, 'DEFINING SNOALB LONG NAME' ) + error = nf90_put_att(ncid, id_snoalb, "units", "none") + call netcdf_err(error, 'DEFINING SNOALB UNITS' ) + error = nf90_put_att(ncid, id_snoalb, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SNOALB COORD' ) + + error = nf90_def_var(ncid, 'stc', NF90_DOUBLE, (/dim_x,dim_y,dim_lsoil,dim_time/), id_stc) + call netcdf_err(error, 'DEFINING STC' ) + error = nf90_put_att(ncid, id_stc, "long_name", "stc") + call netcdf_err(error, 'DEFINING STC LONG NAME' ) + error = nf90_put_att(ncid, id_stc, "units", "none") + call netcdf_err(error, 'DEFINING STC UNITS' ) + error = nf90_put_att(ncid, id_stc, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING STC COORD' ) + + error = nf90_def_var(ncid, 'smc', NF90_DOUBLE, (/dim_x,dim_y,dim_lsoil,dim_time/), id_smc) + call netcdf_err(error, 'DEFINING SMC' ) + error = nf90_put_att(ncid, id_smc, "long_name", "smc") + call netcdf_err(error, 'DEFINING SMC LONG NAME' ) + error = nf90_put_att(ncid, id_smc, "units", "none") + call netcdf_err(error, 'DEFINING SMC UNITS' ) + error = nf90_put_att(ncid, id_smc, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SMC COORD' ) + + error = nf90_def_var(ncid, 'slc', NF90_DOUBLE, (/dim_x,dim_y,dim_lsoil,dim_time/), id_slc) + call netcdf_err(error, 'DEFINING SLC' ) + error = nf90_put_att(ncid, id_slc, "long_name", "slc") + call netcdf_err(error, 'DEFINING SLC LONG NAME' ) + error = nf90_put_att(ncid, id_slc, "units", "none") + call netcdf_err(error, 'DEFINING SLC UNITS' ) + error = nf90_put_att(ncid, id_slc, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING SLC COORD' ) + + if (convert_nst) then + + error = nf90_def_var(ncid, 'tref', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tref) + call netcdf_err(error, 'DEFINING TREF' ) + error = nf90_put_att(ncid, id_tref, "long_name", "tref") + call netcdf_err(error, 'DEFINING TREF LONG NAME' ) + error = nf90_put_att(ncid, id_tref, "units", "none") + call netcdf_err(error, 'DEFINING TREF UNITS' ) + error = nf90_put_att(ncid, id_tref, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING TREF COORD' ) + + error = nf90_def_var(ncid, 'z_c', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_z_c) + call netcdf_err(error, 'DEFINING Z_C' ) + error = nf90_put_att(ncid, id_z_c, "long_name", "z_c") + call netcdf_err(error, 'DEFINING Z_C LONG NAME' ) + error = nf90_put_att(ncid, id_z_c, "units", "none") + call netcdf_err(error, 'DEFINING Z_C UNITS' ) + error = nf90_put_att(ncid, id_z_c, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING Z_C COORD' ) + + error = nf90_def_var(ncid, 'c_0', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_c_0) + call netcdf_err(error, 'DEFINING C_0' ) + error = nf90_put_att(ncid, id_c_0, "long_name", "c_0") + call netcdf_err(error, 'DEFINING C_0 LONG NAME' ) + error = nf90_put_att(ncid, id_c_0, "units", "none") + call netcdf_err(error, 'DEFINING C_0 UNITS' ) + error = nf90_put_att(ncid, id_c_0, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING C_0 COORD' ) + + error = nf90_def_var(ncid, 'c_d', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_c_d) + call netcdf_err(error, 'DEFINING C_D' ) + error = nf90_put_att(ncid, id_c_d, "long_name", "c_d") + call netcdf_err(error, 'DEFINING C_D LONG NAME' ) + error = nf90_put_att(ncid, id_c_d, "units", "none") + call netcdf_err(error, 'DEFINING C_D UNITS' ) + error = nf90_put_att(ncid, id_c_d, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING C_D COORD' ) + + error = nf90_def_var(ncid, 'w_0', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_w_0) + call netcdf_err(error, 'DEFINING W_0' ) + error = nf90_put_att(ncid, id_w_0, "long_name", "w_0") + call netcdf_err(error, 'DEFINING W_0 LONG NAME' ) + error = nf90_put_att(ncid, id_w_0, "units", "none") + call netcdf_err(error, 'DEFINING W_0 UNITS' ) + error = nf90_put_att(ncid, id_w_0, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING W_0 COORD' ) + + error = nf90_def_var(ncid, 'w_d', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_w_d) + call netcdf_err(error, 'DEFINING W_D' ) + error = nf90_put_att(ncid, id_w_d, "long_name", "w_d") + call netcdf_err(error, 'DEFINING W_D LONG NAME' ) + error = nf90_put_att(ncid, id_w_d, "units", "none") + call netcdf_err(error, 'DEFINING W_D UNITS' ) + error = nf90_put_att(ncid, id_w_d, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING W_D COORD' ) + + error = nf90_def_var(ncid, 'xt', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xt) + call netcdf_err(error, 'DEFINING XT' ) + error = nf90_put_att(ncid, id_xt, "long_name", "xt") + call netcdf_err(error, 'DEFINING XT LONG NAME' ) + error = nf90_put_att(ncid, id_xt, "units", "none") + call netcdf_err(error, 'DEFINING XT UNITS' ) + error = nf90_put_att(ncid, id_xt, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING XT COORD' ) + + error = nf90_def_var(ncid, 'xs', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xs) + call netcdf_err(error, 'DEFINING XS' ) + error = nf90_put_att(ncid, id_xs, "long_name", "xs") + call netcdf_err(error, 'DEFINING XS LONG NAME' ) + error = nf90_put_att(ncid, id_xs, "units", "none") + call netcdf_err(error, 'DEFINING XS UNITS' ) + error = nf90_put_att(ncid, id_xs, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING XS COORD' ) + + error = nf90_def_var(ncid, 'xu', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xu) + call netcdf_err(error, 'DEFINING XU' ) + error = nf90_put_att(ncid, id_xu, "long_name", "xu") + call netcdf_err(error, 'DEFINING XU LONG NAME' ) + error = nf90_put_att(ncid, id_xu, "units", "none") + call netcdf_err(error, 'DEFINING XU UNITS' ) + error = nf90_put_att(ncid, id_xu, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING XU COORD' ) + + error = nf90_def_var(ncid, 'xv', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xv) + call netcdf_err(error, 'DEFINING XV' ) + error = nf90_put_att(ncid, id_xv, "long_name", "xv") + call netcdf_err(error, 'DEFINING XV LONG NAME' ) + error = nf90_put_att(ncid, id_xv, "units", "none") + call netcdf_err(error, 'DEFINING XV UNITS' ) + error = nf90_put_att(ncid, id_xv, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING XV COORD' ) + + error = nf90_def_var(ncid, 'xz', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xz) + call netcdf_err(error, 'DEFINING XZ' ) + error = nf90_put_att(ncid, id_xz, "long_name", "xz") + call netcdf_err(error, 'DEFINING XZ LONG NAME' ) + error = nf90_put_att(ncid, id_xz, "units", "none") + call netcdf_err(error, 'DEFINING XZ UNITS' ) + error = nf90_put_att(ncid, id_xz, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING XZ COORD' ) + + error = nf90_def_var(ncid, 'zm', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_zm) + call netcdf_err(error, 'DEFINING ZM' ) + error = nf90_put_att(ncid, id_zm, "long_name", "zm") + call netcdf_err(error, 'DEFINING ZM LONG NAME' ) + error = nf90_put_att(ncid, id_zm, "units", "none") + call netcdf_err(error, 'DEFINING ZM UNITS' ) + error = nf90_put_att(ncid, id_zm, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING ZM COORD' ) + + error = nf90_def_var(ncid, 'xtts', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xtts) + call netcdf_err(error, 'DEFINING XTTS' ) + error = nf90_put_att(ncid, id_xtts, "long_name", "xtts") + call netcdf_err(error, 'DEFINING XTTS LONG NAME' ) + error = nf90_put_att(ncid, id_xtts, "units", "none") + call netcdf_err(error, 'DEFINING XTTS UNITS' ) + error = nf90_put_att(ncid, id_xtts, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING XTTS COORD' ) + + error = nf90_def_var(ncid, 'xzts', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xzts) + call netcdf_err(error, 'DEFINING XZTS' ) + error = nf90_put_att(ncid, id_xzts, "long_name", "xzts") + call netcdf_err(error, 'DEFINING XZTS LONG NAME' ) + error = nf90_put_att(ncid, id_xzts, "units", "none") + call netcdf_err(error, 'DEFINING XZTS UNITS' ) + error = nf90_put_att(ncid, id_xzts, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING XZTS COORD' ) + + error = nf90_def_var(ncid, 'd_conv', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_d_conv) + call netcdf_err(error, 'DEFINING D_CONV' ) + error = nf90_put_att(ncid, id_d_conv, "long_name", "d_conv") + call netcdf_err(error, 'DEFINING D_CONV LONG NAME' ) + error = nf90_put_att(ncid, id_d_conv, "units", "none") + call netcdf_err(error, 'DEFINING D_CONV UNITS' ) + error = nf90_put_att(ncid, id_d_conv, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING D_CONV COORD' ) + + error = nf90_def_var(ncid, 'ifd', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_ifd) + call netcdf_err(error, 'DEFINING IFD' ) + error = nf90_put_att(ncid, id_ifd, "long_name", "ifd") + call netcdf_err(error, 'DEFINING IFD LONG NAME' ) + error = nf90_put_att(ncid, id_ifd, "units", "none") + call netcdf_err(error, 'DEFINING IFD UNITS' ) + error = nf90_put_att(ncid, id_ifd, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING IFD COORD' ) + + error = nf90_def_var(ncid, 'dt_cool', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_dt_cool) + call netcdf_err(error, 'DEFINING DT_COOL' ) + error = nf90_put_att(ncid, id_dt_cool, "long_name", "dt_cool") + call netcdf_err(error, 'DEFINING DT_COOL LONG NAME' ) + error = nf90_put_att(ncid, id_dt_cool, "units", "none") + call netcdf_err(error, 'DEFINING DT_COOL UNITS' ) + error = nf90_put_att(ncid, id_dt_cool, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING DT_COOL COORD' ) + + error = nf90_def_var(ncid, 'qrain', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_qrain) + call netcdf_err(error, 'DEFINING QRAIN' ) + error = nf90_put_att(ncid, id_qrain, "long_name", "qrain") + call netcdf_err(error, 'DEFINING QRAIN LONG NAME' ) + error = nf90_put_att(ncid, id_qrain, "units", "none") + call netcdf_err(error, 'DEFINING QRAIN UNITS' ) + error = nf90_put_att(ncid, id_qrain, "coordinates", "geolon geolat") + call netcdf_err(error, 'DEFINING QRAIN COORD' ) + + endif ! nsst records + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'DEFINING HEADER' ) + + endif LOCAL_PET ! is localpet 0? + + if (localpet == 0) then + error = nf90_put_var( ncid, id_lsoil, lsoil_data) + call netcdf_err(error, 'WRITING ZAXIS RECORD' ) + error = nf90_put_var( ncid, id_x, x_data) + call netcdf_err(error, 'WRITING XAXIS RECORD' ) + error = nf90_put_var( ncid, id_y, y_data) + call netcdf_err(error, 'WRITING YAXIS RECORD' ) + times = 1.0 + error = nf90_put_var( ncid, id_time, times) + call netcdf_err(error, 'WRITING TIME RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID LATITUDE FOR TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_lat, dum2d) + call netcdf_err(error, 'WRITING LATITUDE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID LONGITUDE FOR TILE: ", tile + call ESMF_FieldGather(longitude_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_lon, dum2d) + call netcdf_err(error, 'WRITING LONGITUDE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV FOR TILE: ", tile + call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_sheleg, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SNOW LIQ EQUIV RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH FOR TILE: ", tile + call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_snwdph, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SNWDPH RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SLOPE TYPE FOR TILE: ", tile + call ESMF_FieldGather(slope_type_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_slope, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SLOPE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID Z0 FOR TILE: ", tile + call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_zorl, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING Z0 RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID MAX SNOW ALBEDO FOR TILE: ", tile + call ESMF_FieldGather(mxsno_albedo_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_snoalb, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING MAX SNOW ALBEDO RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SOIL TYPE FOR TILE: ", tile + call ESMF_FieldGather(soil_type_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_stype, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SOIL TYPE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID VEGETATION TYPE FOR TILE: ", tile + call ESMF_FieldGather(veg_type_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_vtype, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING VEGETATION TYPE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID VEGETATION GREENNESS FOR TILE: ", tile + call ESMF_FieldGather(veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_vfrac, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING VEGETATION GREENNESS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SUBSTRATE TEMPERATURE FOR TILE: ", tile + call ESMF_FieldGather(substrate_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tg3, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SUBSTRATE TEMPERATURE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID FACSF FOR TILE: ", tile + call ESMF_FieldGather(facsf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_facsf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FACSF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID FACWF FOR TILE: ", tile + call ESMF_FieldGather(facwf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_facwf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FACWF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALNSF FOR TILE: ", tile + call ESMF_FieldGather(alnsf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alnsf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALNSF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALNWF FOR TILE: ", tile + call ESMF_FieldGather(alnwf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alnwf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALNWF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALVSF FOR TILE: ", tile + call ESMF_FieldGather(alvsf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alvsf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALVSF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALVWF FOR TILE: ", tile + call ESMF_FieldGather(alvwf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alvwf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALVWF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID MAX VEGETATION GREENNESS FOR TILE: ", tile + call ESMF_FieldGather(max_veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_shdmax, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING MAX VEGETATION GREENNESS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID MIN VEGETATION GREENNESS FOR TILE: ", tile + call ESMF_FieldGather(min_veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_shdmin, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING MIN VEGETATION GREENNESS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID T2M FOR TILE: ", tile + call ESMF_FieldGather(t2m_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_t2m, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING T2M RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID Q2M FOR TILE: ", tile + call ESMF_FieldGather(q2m_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_q2m, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING Q2M RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID TPRCP FOR TILE: ", tile + call ESMF_FieldGather(tprcp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tprcp, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TPRCP RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID F10M FOR TILE: ", tile + call ESMF_FieldGather(f10m_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_f10m, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING F10M RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID FFMM FOR TILE: ", tile + call ESMF_FieldGather(ffmm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_ffmm, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FFMM RECORD' ) + dum2d = 0.0 + error = nf90_put_var( ncid, id_ffhh, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FFHH RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID USTAR FOR TILE: ", tile + call ESMF_FieldGather(ustar_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_uustar, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING USTAR RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SRFLAG FOR TILE: ", tile + call ESMF_FieldGather(srflag_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_srflag, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SRFLAG RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SEA ICE FRACTION FOR TILE: ", tile + call ESMF_FieldGather(seaice_fract_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_fice, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FICE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SEA ICE DEPTH FOR TILE: ", tile + call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_hice, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING HICE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SEA ICE SKIN TEMP FOR TILE: ", tile + call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tisfc, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TISFC RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMP FOR TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tsea, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TSEA RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID LANDMASK FOR TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, idata_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = float(idata_one_tile(istart:iend, jstart:jend)) + error = nf90_put_var( ncid, id_slmsk, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING LANDMASK RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID CANOPY MOISTURE CONTENT FOR TILE: ", tile + call ESMF_FieldGather(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_canopy, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING CANOPY MC RECORD' ) + endif + +! soil temperature + + print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE FOR TILE: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d(:,:,:) = data_one_tile_3d(istart:iend, jstart:jend,:) + error = nf90_put_var( ncid, id_stc, dum3d, start=(/1,1,1,1/), count=(/i_target_out,j_target_out,lsoil_target,1/)) + call netcdf_err(error, 'WRITING SOIL TEMP RECORD' ) + endif + +! soil moisture (total) + + print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE FOR TILE: ", tile + call ESMF_FieldGather(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d(:,:,:) = data_one_tile_3d(istart:iend, jstart:jend,:) + error = nf90_put_var( ncid, id_smc, dum3d, start=(/1,1,1,1/), count=(/i_target_out,j_target_out,lsoil_target,1/)) + call netcdf_err(error, 'WRITING TOTAL SOIL MOISTURE RECORD' ) + endif + +! soil moisture (liquid) + + print*,"- CALL FieldGather FOR TARGET GRID LIQUID SOIL MOISTURE FOR TILE: ", tile + call ESMF_FieldGather(soilm_liq_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d(:,:,:) = data_one_tile_3d(istart:iend, jstart:jend,:) + error = nf90_put_var( ncid, id_slc, dum3d, start=(/1,1,1,1/), count=(/i_target_out,j_target_out,lsoil_target,1/)) + call netcdf_err(error, 'WRITING LIQUID SOIL MOISTURE RECORD' ) + endif + + if (convert_nst) then + + print*,"- CALL FieldGather FOR TARGET C_D FOR TILE: ", tile + call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_c_d, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING C_D RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET C_0 FOR TILE: ", tile + call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_c_0, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING C_0 RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET D_CONV FOR TILE: ", tile + call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_d_conv, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING D_CONV RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET DT_COOL FOR TILE: ", tile + call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_dt_cool, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING DT_COOL RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET IFD FOR TILE: ", tile + call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_ifd, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING IFD RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET QRAIN FOR TILE: ", tile + call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_qrain, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING QRAIN RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET TREF FOR TILE: ", tile + call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tref, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TREF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET W_D FOR TILE: ", tile + call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_w_d, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING W_D RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET W_0 FOR TILE: ", tile + call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_w_0, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING W_0 RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XS FOR TILE: ", tile + call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xs, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XT FOR TILE: ", tile + call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xt, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XT RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XU FOR TILE: ", tile + call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xu, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XU RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XV FOR TILE: ", tile + call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xv, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XV RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XZ FOR TILE: ", tile + call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xz, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XZ RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XTTS FOR TILE: ", tile + call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xtts, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XTTS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XZTS FOR TILE: ", tile + call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xzts, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XZTS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET Z_C FOR TILE: ", tile + call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_z_c, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING Z_C RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET ZM FOR TILE: ", tile + call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_zm, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ZM RECORD' ) + endif + + endif ! convert nst + +!------------------------------------------------------------------------------- +! close file +!------------------------------------------------------------------------------- + + error = nf90_close(ncid) + + enddo TILE_LOOP + + deallocate(lsoil_data, x_data, y_data) + deallocate(data_one_tile, data_one_tile_3d, idata_one_tile, dum2d, dum3d) + + return + + end subroutine write_fv3_sfc_data_netcdf