diff --git a/.gitignore b/.gitignore index ac5fcf245..aafab21cb 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,10 @@ -*.o +*.[aox] *.mod -*.a *.pyc + +*.sw[a-p] +~ + +build/ +install/ + diff --git a/.gitmodules b/.gitmodules index a2bdbebdf..0c3b341f7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,12 +1,14 @@ [submodule "atmos_cubed_sphere"] - path = atmos_cubed_sphere - url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere - branch = dev/emc + path = atmos_cubed_sphere + url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere + branch = dev/emc [submodule "ccpp/framework"] - path = ccpp/framework - url = https://github.com/NCAR/ccpp-framework - branch = main + path = ccpp/framework + url = https://github.com/NCAR/ccpp-framework + branch = main [submodule "ccpp/physics"] - path = ccpp/physics - url = https://github.com/AnningCheng-NOAA/ccpp-physics - branch = merra2_thompson + path = ccpp/physics + #url = https://github.com/NCAR/ccpp-physics + #branch = main + url = https://github.com/AnningCheng-NOAA/ccpp-physics + branch = merra2_thompson diff --git a/CMakeLists.txt b/CMakeLists.txt index ea4109cd5..986b5fd2f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -6,101 +6,15 @@ add_subdirectory(ccpp) ############################################################################### -### fv3dycore +### fv3 dynamical core ############################################################################### -list(APPEND _fv3dycore_srcs - atmos_cubed_sphere/model/a2b_edge.F90 - atmos_cubed_sphere/model/multi_gases.F90 - atmos_cubed_sphere/model/boundary.F90 - atmos_cubed_sphere/model/dyn_core.F90 - atmos_cubed_sphere/model/fv_arrays.F90 - atmos_cubed_sphere/model/fv_control.F90 - atmos_cubed_sphere/model/fv_dynamics.F90 - atmos_cubed_sphere/model/fv_fill.F90 - atmos_cubed_sphere/model/fv_grid_utils.F90 - atmos_cubed_sphere/model/fv_mapz.F90 - atmos_cubed_sphere/model/fv_nesting.F90 - atmos_cubed_sphere/model/fv_regional_bc.F90 - atmos_cubed_sphere/model/fv_sg.F90 - atmos_cubed_sphere/model/fv_tracer2d.F90 - atmos_cubed_sphere/model/fv_update_phys.F90 - atmos_cubed_sphere/model/sw_core.F90 - atmos_cubed_sphere/model/tp_core.F90 - atmos_cubed_sphere/model/nh_core.F90 - atmos_cubed_sphere/model/nh_utils.F90 - atmos_cubed_sphere/tools/coarse_grained_diagnostics.F90 - atmos_cubed_sphere/tools/coarse_grained_restart_files.F90 - atmos_cubed_sphere/tools/coarse_graining.F90 - atmos_cubed_sphere/tools/external_ic.F90 - atmos_cubed_sphere/tools/external_sst.F90 - atmos_cubed_sphere/tools/fv_diag_column.F90 - atmos_cubed_sphere/tools/fv_diagnostics.F90 - atmos_cubed_sphere/tools/fv_eta.F90 - atmos_cubed_sphere/tools/fv_grid_tools.F90 - atmos_cubed_sphere/tools/fv_io.F90 - atmos_cubed_sphere/tools/fv_mp_mod.F90 - atmos_cubed_sphere/tools/fv_nudge.F90 - atmos_cubed_sphere/tools/fv_treat_da_inc.F90 - atmos_cubed_sphere/tools/fv_iau_mod.F90 - atmos_cubed_sphere/tools/fv_restart.F90 - atmos_cubed_sphere/tools/fv_surf_map.F90 - atmos_cubed_sphere/tools/fv_timing.F90 - atmos_cubed_sphere//tools/init_hydro.F90 - atmos_cubed_sphere/tools/sim_nc_mod.F90 - atmos_cubed_sphere/tools/sorted_index.F90 - atmos_cubed_sphere/tools/test_cases.F90 - atmos_cubed_sphere/driver/fvGFS/DYCORE_typedefs.F90 - atmos_cubed_sphere/driver/fvGFS/fv_nggps_diag.F90 - atmos_cubed_sphere/driver/fvGFS/atmosphere.F90) - -add_library(fv3dycore ${_fv3dycore_srcs}) - -list(APPEND _fv3dycore_defs_private SPMD - use_WRTCOMP - GFS_PHYS - GFS_TYPES - USE_GFSL63 - MOIST_CAPPA - USE_COND) - -if(MULTI_GASES) - list(APPEND _fv3dycore_defs_private MULTI_GASES) -endif() - -if(32BIT) - list(APPEND _fv3dycore_defs_private OVERLOAD_R4 - OVERLOAD_R8) -endif() - -if(OPENMP) - list(APPEND _fv3dycore_defs_private OPENMP) -endif() - -set_property(SOURCE atmos_cubed_sphere/model/nh_utils.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "${FAST}") -set_property(SOURCE atmos_cubed_sphere/model/fv_mapz.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "${FAST}") - -set_target_properties(fv3dycore PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) -target_include_directories(fv3dycore INTERFACE $ - $) -target_compile_definitions(fv3dycore PRIVATE "${_fv3dycore_defs_private}") - -# So much for being consistent: -# atmos_cubed_sphere/tools/fv_diagnostics.F90: #include -# atmos_cubed_sphere/tools/fv_eta.F90: #include -target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/atmos_cubed_sphere - ${CMAKE_CURRENT_SOURCE_DIR}/atmos_cubed_sphere/tools) - -target_link_libraries(fv3dycore PUBLIC fms - fv3ccpp - esmf) -if(OPENMP) - target_link_libraries(fv3dycore PUBLIC OpenMP::OpenMP_Fortran) -endif() - -# This should not be necessary once framework and physics targets define BUILD_INTERFACE -target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/framework/src - ${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics) +# These ifdefs need to be turned ON in the dycore. +set(use_WRTCOMP ON) +set(GFS_PHYS ON) +set(GFS_TYPES ON) +set(USE_GFSL63 ON) +add_subdirectory(atmos_cubed_sphere) ############################################################################### ### fv3atm @@ -134,6 +48,8 @@ add_library(fv3atm ${POST_SRC} ) +add_dependencies(fv3atm fv3 fv3ccpp stochastic_physics) + list(APPEND _fv3atm_defs_private GFS_PHYS INTERNAL_FILE_NML use_WRTCOMP) @@ -144,10 +60,7 @@ set_target_properties(fv3atm PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT target_include_directories(fv3atm INTERFACE $ $) -# This should not be necessary once framework and physics targets define BUILD_INTERFACE -target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics) - -target_link_libraries(fv3atm PUBLIC fv3dycore +target_link_libraries(fv3atm PUBLIC fv3 fv3ccpp stochastic_physics fms) @@ -169,7 +82,7 @@ endif() ### Install ############################################################################### install( - TARGETS fv3atm fv3dycore fv3ccpp + TARGETS fv3atm EXPORT fv3atm-config LIBRARY DESTINATION lib ARCHIVE DESTINATION lib) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index bdb078ade..ab026b794 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit bdb078ade1e9f81755513d6dbb51b3f40fccaa41 +Subproject commit ab026b79497ee00530ff3eb6b59dd9b9346e8e7d diff --git a/atmos_model.F90 b/atmos_model.F90 index 0730a886a..f092da8c5 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -47,12 +47,8 @@ module atmos_model_mod use mpp_mod, only: FATAL, mpp_min, mpp_max, mpp_error, mpp_chksum use mpp_domains_mod, only: domain2d use mpp_mod, only: mpp_get_current_pelist_name -#ifdef INTERNAL_FILE_NML use mpp_mod, only: input_nml_file -#else -use fms_mod, only: open_namelist_file -#endif -use fms_mod, only: file_exist, error_mesg +use fms2_io_mod, only: file_exists use fms_mod, only: close_file, write_version_number, stdlog, stdout use fms_mod, only: clock_flag_default use fms_mod, only: check_nml_error @@ -551,19 +547,9 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !---------------------------------------------------------------------------------------------- ! initialize atmospheric model - must happen AFTER atmosphere_init so that nests work correctly - IF ( file_exist('input.nml')) THEN -#ifdef INTERNAL_FILE_NML + IF ( file_exists('input.nml')) THEN read(input_nml_file, nml=atmos_model_nml, iostat=io) ierr = check_nml_error(io, 'atmos_model_nml') -#else - unit = open_namelist_file ( ) - ierr=1 - do while (ierr /= 0) - read (unit, nml=atmos_model_nml, iostat=io, end=10) - ierr = check_nml_error(io,'atmos_model_nml') - enddo - 10 call close_file (unit) -#endif endif !----------------------------------------------------------------------- @@ -650,6 +636,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic #ifdef INTERNAL_FILE_NML + ! allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 + allocate(Init_parm%input_nml_file, mold=input_nml_file) Init_parm%input_nml_file => input_nml_file Init_parm%fn_nml='using internal file' #else @@ -697,8 +685,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & GFS_data%IntDiag, Init_parm, GFS_Diag) call FV3GFS_restart_read (GFS_data, GFS_restart_var, Atm_block, GFS_control, Atmos%domain, Atm(mygrid)%flagstruct%warm_start) - if(GFS_control%ca_sgs)then - call read_ca_restart (Atmos%domain,GFS_control%scells) + if(GFS_control%do_ca .and. Atm(mygrid)%flagstruct%warm_start)then + call read_ca_restart (Atmos%domain,GFS_control%scells,GFS_control%nca,GFS_control%ncells_g,GFS_control%nca_g) endif ! Populate the GFS_data%Statein container with the prognostic state ! in Atm_block, which contains the initial conditions/restart data. @@ -925,13 +913,14 @@ subroutine update_atmos_model_state (Atmos, rc) call FV3GFS_diag_output(Atmos%Time, GFS_Diag, Atm_block, GFS_control%nx, GFS_control%ny, & GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, & GFS_control%fhswr, GFS_control%fhlwr) - if (nint(GFS_control%fhzero) > 0) then - if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time - else - if (mod(isec,nint(3600*GFS_control%fhzero)) == 0) diag_time = Atmos%Time - endif - call diag_send_complete_instant (Atmos%Time) endif + if (nint(GFS_control%fhzero) > 0) then + if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time + else + if (mod(isec,nint(3600*GFS_control%fhzero)) == 0) diag_time = Atmos%Time + endif + call diag_send_complete_instant (Atmos%Time) + !--- this may not be necessary once write_component is fully implemented !!!call diag_send_complete_extra (Atmos%Time) @@ -991,8 +980,8 @@ subroutine atmos_model_end (Atmos) GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then if(restart_endfcst) then call write_stoch_restart_atm('RESTART/atm_stoch.res.nc') - if (GFS_control%ca_sgs)then - call write_ca_restart(Atmos%domain,GFS_control%scells) + if (GFS_control%do_ca)then + call write_ca_restart() endif endif call stochastic_physics_wrapper_end(GFS_control) @@ -1020,8 +1009,8 @@ subroutine atmos_model_restart(Atmos, timestamp) call atmosphere_restart(timestamp) call FV3GFS_restart_write (GFS_data, GFS_restart_var, Atm_block, & GFS_control, Atmos%domain, timestamp) - if(GFS_control%ca_sgs)then - call write_ca_restart(Atmos%domain,GFS_control%scells,timestamp) + if(GFS_control%do_ca)then + call write_ca_restart(timestamp) endif end subroutine atmos_model_restart ! @@ -1785,7 +1774,7 @@ subroutine assign_importdata(jdat, rc) fldname = 'sea_surface_temperature' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) - if (importFieldsValid(findex)) then + if (importFieldsValid(findex) .and. GFS_control%cplocn2atm) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec @@ -2337,7 +2326,7 @@ subroutine assign_importdata(jdat, rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - GFS_data(nb)%Sfcprop%vtype(ix) = datar82d(i-isc+1,j-jsc+1) + GFS_data(nb)%Sfcprop%vtype(ix) = int(datar82d(i-isc+1,j-jsc+1)) enddo enddo endif @@ -2352,7 +2341,7 @@ subroutine assign_importdata(jdat, rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - GFS_data(nb)%Sfcprop%stype(ix) = datar82d(i-isc+1,j-jsc+1) + GFS_data(nb)%Sfcprop%stype(ix) = int(datar82d(i-isc+1,j-jsc+1)) enddo enddo endif diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index b41298b45..b614e099f 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -4,10 +4,6 @@ project(CCPP-FV3 LANGUAGES C CXX Fortran) set(PROJECT "CCPP-FV3") -# Attempt to add link library "NetCDF::NetCDF_Fortran" to target "ccppphys" -# which is not built in this directory. -cmake_policy(SET CMP0079 NEW) - #------------------------------------------------------------------------------ # Set a default build type if none was specified if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) @@ -94,12 +90,7 @@ endif() # Build CCPP framework and physics add_subdirectory(framework) - add_subdirectory(physics) -add_dependencies(ccppphys ccpp) -target_link_libraries(ccppphys PUBLIC w3nco::w3nco_d NetCDF::NetCDF_Fortran) -# This should not be necessary once framework and physics targets define BUILD_INTERFACE -target_include_directories(ccppphys PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/framework/src) #------------------------------------------------------------------------------ # Build fv3ccpp @@ -124,16 +115,26 @@ add_library( set_property(SOURCE driver/GFS_diagnostics.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "-O0") -target_link_libraries(fv3ccpp PUBLIC ccpp) -target_link_libraries(fv3ccpp PUBLIC ccppphys) +target_link_libraries(fv3ccpp PUBLIC ccpp_framework) +target_link_libraries(fv3ccpp PUBLIC ccpp_physics) if(OPENMP) target_link_libraries(fv3ccpp PUBLIC OpenMP::OpenMP_Fortran) endif() -# This should not be necessary once framework and physics targets define BUILD_INTERFACE -target_include_directories(fv3ccpp PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/framework/src - ${CMAKE_CURRENT_BINARY_DIR}/physics) - set_target_properties(fv3ccpp PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) target_include_directories(fv3ccpp PUBLIC $) + +############################################################################### +### Install +############################################################################### +install( + TARGETS fv3ccpp ccpp_framework ccpp_physics + EXPORT fv3ccpp-config + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib) + +install(DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod DESTINATION ${CMAKE_INSTALL_PREFIX}) + +install(EXPORT fv3ccpp-config + DESTINATION lib/cmake) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 5fb194c9c..4218035a8 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2,7 +2,7 @@ module GFS_typedefs - use machine, only: kind_phys + use machine, only: kind_phys,kind_dbl_prec use physcons, only: con_cp, con_fvirt, con_g, & con_hvap, con_hfus, con_pi, con_rd, con_rv, & con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & @@ -148,9 +148,9 @@ module GFS_typedefs character(len=32), pointer :: tracer_names(:) !< tracers names to dereference tracer id integer, pointer :: tracer_types(:) !< tracers types: 0=generic, 1=chem,prog, 2=chem,diag character(len=64) :: fn_nml !< namelist filename - character(len=256), pointer :: input_nml_file(:) !< character string containing full namelist - !< for use with internal file reads - end type GFS_init_type + character(len=:), pointer, dimension(:) :: input_nml_file => null() !< character string containing full namelist + !< for use with internal file reads + end type GFS_init_type !---------------------------------------------------------------- @@ -263,13 +263,16 @@ module GFS_typedefs real (kind=kind_phys), pointer :: facwf (:) => null() !< fractional coverage with weak cosz dependency !--- In (physics only) - real (kind=kind_phys), pointer :: slope (:) => null() !< sfc slope type for lsm + integer, pointer :: slope (:) => null() !< sfc slope type for lsm + integer, pointer :: slope_save (:) => null()!< sfc slope type save real (kind=kind_phys), pointer :: shdmin (:) => null() !< min fractional coverage of green veg real (kind=kind_phys), pointer :: shdmax (:) => null() !< max fractnl cover of green veg (not used) real (kind=kind_phys), pointer :: tg3 (:) => null() !< deep soil temperature real (kind=kind_phys), pointer :: vfrac (:) => null() !< vegetation fraction - real (kind=kind_phys), pointer :: vtype (:) => null() !< vegetation type - real (kind=kind_phys), pointer :: stype (:) => null() !< soil type + integer, pointer :: vtype (:) => null() !< vegetation type + integer, pointer :: stype (:) => null() !< soil type + integer, pointer :: vtype_save (:) => null()!< vegetation type save + integer, pointer :: stype_save (:) => null()!< soil type save real (kind=kind_phys), pointer :: uustar (:) => null() !< boundary layer parameter real (kind=kind_phys), pointer :: oro (:) => null() !< orography real (kind=kind_phys), pointer :: oro_uf (:) => null() !< unfiltered orography @@ -526,7 +529,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ca_rad (:) => null() ! real (kind=kind_phys), pointer :: ca_micro (:) => null() ! real (kind=kind_phys), pointer :: condition(:) => null() ! - real (kind=kind_phys), pointer :: vfact_ca(:) => null() ! !--- stochastic physics real (kind=kind_phys), pointer :: shum_wts (:,:) => null() ! real (kind=kind_phys), pointer :: sppt_wts (:,:) => null() ! @@ -586,8 +588,8 @@ module GFS_typedefs integer :: nthreads !< OpenMP threads available for physics integer :: nlunit !< unit for namelist character(len=64) :: fn_nml !< namelist filename for surface data cycling - character(len=256), pointer :: input_nml_file(:) !< character string containing full namelist - !< for use with internal file reads + character(len=:), pointer, dimension(:) :: input_nml_file => null() !< character string containing full namelist + !< for use with internal file reads integer :: input_nml_file_length !< length (number of lines) in namelist for internal reads integer :: logunit real(kind=kind_phys) :: fhzero !< hours between clearing of diagnostic buckets @@ -631,6 +633,7 @@ module GFS_typedefs !--- coupling parameters logical :: cplflx !< default no cplflx collection logical :: cplice !< default yes cplice collection (used together with cplflx) + logical :: cplocn2atm !< default yes ocn->atm coupling logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling logical :: cplchm !< default no cplchm collection @@ -1122,7 +1125,7 @@ module GFS_typedefs logical :: ca_sgs !< switch for sgs ca logical :: ca_global !< switch for global ca logical :: ca_smooth !< switch for gaussian spatial filter - integer :: iseed_ca !< seed for random number generation in ca scheme + integer(kind=kind_dbl_prec) :: iseed_ca !< seed for random number generation in ca scheme integer :: nspinup !< number of iterations to spin up the ca real(kind=kind_phys) :: rcell !< threshold used for CA scheme real(kind=kind_phys) :: nthresh !< threshold used for convection coupling @@ -1131,6 +1134,7 @@ module GFS_typedefs logical :: ca_closure !< logical switch for ca on closure logical :: ca_entr !< logical switch for ca on entrainment logical :: ca_trigger !< logical switch for ca on trigger + real (kind=kind_phys), allocatable :: vfact_ca(:) !< vertical tapering for ca_global !--- stochastic physics control parameters logical :: do_sppt @@ -1633,20 +1637,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: tdomip (:) => null() !< dominant accumulated sleet type real (kind=kind_phys), pointer :: tdoms (:) => null() !< dominant accumulated snow type - real (kind=kind_phys), pointer :: ca1 (:) => null() ! - real (kind=kind_phys), pointer :: ca2 (:) => null() ! - real (kind=kind_phys), pointer :: ca3 (:) => null() ! - real (kind=kind_phys), pointer :: ca_deep (:) => null() !< cellular automata fraction - real (kind=kind_phys), pointer :: ca_turb (:) => null() !< cellular automata fraction - real (kind=kind_phys), pointer :: ca_shal (:) => null() !< cellular automata fraction - real (kind=kind_phys), pointer :: ca_rad (:) => null() !< cellular automata fraction - real (kind=kind_phys), pointer :: ca_micro (:) => null() !< cellular automata fraction - - real (kind=kind_phys), pointer :: skebu_wts(:,:) => null() !< 10 meter u wind speed - real (kind=kind_phys), pointer :: skebv_wts(:,:) => null() !< 10 meter v wind speed - real (kind=kind_phys), pointer :: sppt_wts(:,:) => null() !< - real (kind=kind_phys), pointer :: shum_wts(:,:) => null() !< - real (kind=kind_phys), pointer :: sfc_wts(:,:) => null() !< real (kind=kind_phys), pointer :: zmtnblck(:) => null() ! null() !< logical :: skip_macro !< real (kind=kind_phys), pointer :: slc_save(:,:) => null() !< - integer, pointer :: slopetype(:) => null() !< real (kind=kind_phys), pointer :: smcmax(:) => null() !< real (kind=kind_phys), pointer :: smc_save(:,:) => null() !< real (kind=kind_phys), pointer :: snowc(:) => null() !< @@ -2057,7 +2046,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: snowmp(:) => null() !< real (kind=kind_phys), pointer :: snowmt(:) => null() !< real (kind=kind_phys), pointer :: soilm_in_m(:) => null() !< - integer, pointer :: soiltype(:) => null() !< real (kind=kind_phys), pointer :: stc_save(:,:) => null() !< real (kind=kind_phys), pointer :: stress(:) => null() !< real (kind=kind_phys), pointer :: stress_ice(:) => null() !< @@ -2094,7 +2082,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: vegf1d(:) => null() !< real (kind=kind_phys) :: lndp_vgf !< - integer, pointer :: vegtype(:) => null() !< real (kind=kind_phys), pointer :: w_upi(:,:) => null() !< real (kind=kind_phys), pointer :: wcbmax(:) => null() !< ! real (kind=kind_phys), pointer :: weasd_water(:) => null() !< @@ -2225,7 +2212,6 @@ module GFS_typedefs procedure :: create => interstitial_create !< allocate array data procedure :: rad_reset => interstitial_rad_reset !< reset array data for radiation procedure :: phys_reset => interstitial_phys_reset !< reset array data for physics - procedure :: mprint => interstitial_print !< print array data end type GFS_interstitial_type @@ -2433,35 +2419,41 @@ subroutine sfcprop_create (Sfcprop, IM, Model) !--- physics surface props !--- In - allocate (Sfcprop%slope (IM)) - allocate (Sfcprop%shdmin (IM)) - allocate (Sfcprop%shdmax (IM)) - allocate (Sfcprop%snoalb (IM)) - allocate (Sfcprop%tg3 (IM)) - allocate (Sfcprop%vfrac (IM)) - allocate (Sfcprop%vtype (IM)) - allocate (Sfcprop%stype (IM)) - allocate (Sfcprop%uustar (IM)) - allocate (Sfcprop%oro (IM)) - allocate (Sfcprop%oro_uf (IM)) - allocate (Sfcprop%evap (IM)) - allocate (Sfcprop%hflx (IM)) - allocate (Sfcprop%qss (IM)) - - Sfcprop%slope = clear_val - Sfcprop%shdmin = clear_val - Sfcprop%shdmax = clear_val - Sfcprop%snoalb = clear_val - Sfcprop%tg3 = clear_val - Sfcprop%vfrac = clear_val - Sfcprop%vtype = clear_val - Sfcprop%stype = clear_val - Sfcprop%uustar = clear_val - Sfcprop%oro = clear_val - Sfcprop%oro_uf = clear_val - Sfcprop%evap = clear_val - Sfcprop%hflx = clear_val - Sfcprop%qss = clear_val + allocate (Sfcprop%slope (IM)) + allocate (Sfcprop%slope_save (IM)) + allocate (Sfcprop%shdmin (IM)) + allocate (Sfcprop%shdmax (IM)) + allocate (Sfcprop%snoalb (IM)) + allocate (Sfcprop%tg3 (IM)) + allocate (Sfcprop%vfrac (IM)) + allocate (Sfcprop%vtype (IM)) + allocate (Sfcprop%vtype_save (IM)) + allocate (Sfcprop%stype (IM)) + allocate (Sfcprop%stype_save (IM)) + allocate (Sfcprop%uustar (IM)) + allocate (Sfcprop%oro (IM)) + allocate (Sfcprop%oro_uf (IM)) + allocate (Sfcprop%evap (IM)) + allocate (Sfcprop%hflx (IM)) + allocate (Sfcprop%qss (IM)) + + Sfcprop%slope = zero + Sfcprop%slope_save = zero + Sfcprop%shdmin = clear_val + Sfcprop%shdmax = clear_val + Sfcprop%snoalb = clear_val + Sfcprop%tg3 = clear_val + Sfcprop%vfrac = clear_val + Sfcprop%vtype = zero + Sfcprop%vtype_save = zero + Sfcprop%stype = zero + Sfcprop%stype_save = zero + Sfcprop%uustar = clear_val + Sfcprop%oro = clear_val + Sfcprop%oro_uf = clear_val + Sfcprop%evap = clear_val + Sfcprop%hflx = clear_val + Sfcprop%qss = clear_val !--- In/Out allocate (Sfcprop%hice (IM)) @@ -2963,7 +2955,6 @@ subroutine coupling_create (Coupling, IM, Model) !-- cellular automata allocate (Coupling%condition(IM)) - allocate (Coupling%vfact_ca(Model%levs)) if (Model%do_ca) then allocate (Coupling%ca1 (IM)) allocate (Coupling%ca2 (IM)) @@ -2973,7 +2964,6 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%ca_shal (IM)) allocate (Coupling%ca_rad (IM)) allocate (Coupling%ca_micro (IM)) - Coupling%vfact_ca = clear_val Coupling%ca1 = clear_val Coupling%ca2 = clear_val Coupling%ca3 = clear_val @@ -3087,7 +3077,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer, intent(in) :: nwat character(len=32), intent(in) :: tracer_names(:) integer, intent(in) :: tracer_types(:) - character(len=256), intent(in), pointer :: input_nml_file(:) + character(len=:), intent(in), dimension(:), pointer :: input_nml_file integer, intent(in) :: blksz(:) real(kind=kind_phys), dimension(:), intent(in) :: ak real(kind=kind_phys), dimension(:), intent(in) :: bk @@ -3126,6 +3116,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters logical :: cplflx = .false. !< default no cplflx collection logical :: cplice = .true. !< default yes cplice collection (used together with cplflx) + logical :: cplocn2atm = .true. !< default yes cplocn2atm coupling (turn on the feedback from ocn to atm) logical :: cplwav = .false. !< default no cplwav collection logical :: cplwav2atm = .false. !< default no cplwav2atm coupling logical :: cplchm = .false. !< default no cplchm collection @@ -3595,7 +3586,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & naux3d, aux2d_time_avg, aux3d_time_avg, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplice, cplwav, cplwav2atm, cplchm, & + cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplchm, & cpl_imp_mrg, cpl_imp_dbg, & use_cice_alb, lsidea, & !--- radiation parameters @@ -3725,6 +3716,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- read in the namelist #ifdef INTERNAL_FILE_NML + ! allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 + allocate(Model%input_nml_file, mold=input_nml_file) Model%input_nml_file => input_nml_file read(Model%input_nml_file, nml=gfs_physics_nml) ! Set length (number of lines) in namelist for internal reads @@ -3873,6 +3866,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters Model%cplflx = cplflx Model%cplice = cplice + Model%cplocn2atm = cplocn2atm Model%cplwav = cplwav Model%cplwav2atm = cplwav2atm Model%cplchm = cplchm @@ -4063,6 +4057,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- Thompson MP parameters Model%ltaerosol = ltaerosol Model%mraerosol = mraerosol + if (Model%ltaerosol .and. Model%mraerosol) then + write(0,*) 'Logic error: Only one Thompson aerosol option can be true, either ltaerosol or mraerosol)' + stop + end if Model%lradar = lradar Model%nsradar_reset = nsradar_reset Model%ttendlim = ttendlim @@ -4421,6 +4419,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lndp_each_step = lndp_each_step !--- cellular automata options + ! force namelist constsitency + allocate(Model%vfact_ca(levs)) + if ( .not. ca_global ) nca_g=0 + if ( .not. ca_sgs ) nca=0 + Model%nca = nca Model%scells = scells Model%tlives = tlives @@ -5467,6 +5470,7 @@ subroutine control_print(Model) print *, 'coupling parameters' print *, ' cplflx : ', Model%cplflx print *, ' cplice : ', Model%cplice + print *, ' cplocn2atm : ', Model%cplocn2atm print *, ' cplwav : ', Model%cplwav print *, ' cplwav2atm : ', Model%cplwav2atm print *, ' cplchm : ', Model%cplchm @@ -6518,15 +6522,7 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%tdomzr (IM)) allocate (Diag%tdomip (IM)) allocate (Diag%tdoms (IM)) - allocate (Diag%skebu_wts(IM,Model%levs)) - allocate (Diag%skebv_wts(IM,Model%levs)) - allocate (Diag%sppt_wts (IM,Model%levs)) - allocate (Diag%shum_wts (IM,Model%levs)) - allocate (Diag%sfc_wts (IM,Model%n_var_lndp)) allocate (Diag%zmtnblck (IM)) - allocate (Diag%ca1 (IM)) - allocate (Diag%ca2 (IM)) - allocate (Diag%ca3 (IM)) ! F-A MP scheme if (Model%imp_physics == Model%imp_physics_fer_hires) then @@ -6534,12 +6530,6 @@ subroutine diag_create (Diag, IM, Model) end if allocate (Diag%cldfra (IM,Model%levs)) - allocate (Diag%ca_deep (IM)) - allocate (Diag%ca_turb (IM)) - allocate (Diag%ca_shal (IM)) - allocate (Diag%ca_rad (IM)) - allocate (Diag%ca_micro (IM)) - !--- 3D diagnostics if (Model%ldiag3d) then allocate(Diag%dtend(IM,Model%levs,Model%ndtend)) @@ -6790,12 +6780,6 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%tdomzr = zero Diag%tdomip = zero Diag%tdoms = zero - Diag%skebu_wts = zero - Diag%skebv_wts = zero - Diag%sppt_wts = zero - Diag%shum_wts = zero - Diag%sfc_wts = zero - Diag%zmtnblck = zero if (Model%imp_physics == Model%imp_physics_fer_hires) then Diag%train = zero @@ -6829,16 +6813,6 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%exch_m = clear_val endif - if (Model%do_ca) then - Diag%ca1 = zero - Diag%ca2 = zero - Diag%ca3 = zero - Diag%ca_deep = zero - Diag%ca_turb = zero - Diag%ca_shal = zero - Diag%ca_rad = zero - Diag%ca_micro = zero - endif ! if(Model%me == Model%master) print *,'in diag_phys_zero, totprcpb set to 0,kdt=',Model%kdt if (Model%ldiag3d) then @@ -7133,14 +7107,12 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%sigmaf (IM)) allocate (Interstitial%sigmafrac (IM,Model%levs)) allocate (Interstitial%sigmatot (IM,Model%levs)) - allocate (Interstitial%slopetype (IM)) allocate (Interstitial%snowc (IM)) allocate (Interstitial%snowd_ice (IM)) ! allocate (Interstitial%snowd_land (IM)) ! allocate (Interstitial%snowd_water (IM)) allocate (Interstitial%snohf (IM)) allocate (Interstitial%snowmt (IM)) - allocate (Interstitial%soiltype (IM)) allocate (Interstitial%stress (IM)) allocate (Interstitial%stress_ice (IM)) allocate (Interstitial%stress_land (IM)) @@ -7166,7 +7138,6 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%uustar_water (IM)) allocate (Interstitial%vdftra (IM,Model%levs,Interstitial%nvdiff)) !GJF first dimension was set as 'IX' in GFS_physics_driver allocate (Interstitial%vegf1d (IM)) - allocate (Interstitial%vegtype (IM)) allocate (Interstitial%wcbmax (IM)) allocate (Interstitial%weasd_ice (IM)) ! allocate (Interstitial%weasd_land (IM)) @@ -7873,14 +7844,12 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%sigmaf = clear_val Interstitial%sigmafrac = clear_val Interstitial%sigmatot = clear_val - Interstitial%slopetype = 0 Interstitial%snowc = clear_val Interstitial%snowd_ice = huge ! Interstitial%snowd_land = huge ! Interstitial%snowd_water = huge Interstitial%snohf = clear_val Interstitial%snowmt = clear_val - Interstitial%soiltype = 0 Interstitial%stress = clear_val Interstitial%stress_ice = huge Interstitial%stress_land = huge @@ -7903,7 +7872,6 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%vdftra = clear_val Interstitial%vegf1d = clear_val Interstitial%lndp_vgf = clear_val - Interstitial%vegtype = 0 Interstitial%wcbmax = clear_val Interstitial%weasd_ice = huge ! Interstitial%weasd_land = huge @@ -8036,412 +8004,4 @@ subroutine interstitial_phys_reset (Interstitial, Model) ! end subroutine interstitial_phys_reset - ! DH* 20200901: this routine is no longer used by CCPP's GFS_debug.F90. When new variables are - ! added to the GFS_interstitial_type, it is best to add the variable to both interstitial_print - ! below and to GFS_interstitialtoscreen in ccpp/physics/physics/GFS_debug.F90 - subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) - ! - implicit none - ! - class(GFS_interstitial_type) :: Interstitial - type(GFS_control_type), intent(in) :: Model - integer, intent(in) :: mpirank, omprank, blkno - ! - ! Print static variables - write (0,'(a,3i6)') 'Interstitial_print for mpirank, omprank, blkno: ', mpirank, omprank, blkno - write (0,*) 'Interstitial_print: values that do not change' - write (0,*) 'Interstitial%ipr = ', Interstitial%ipr - write (0,*) 'Interstitial%itc = ', Interstitial%itc - write (0,*) 'Interstitial%latidxprnt = ', Interstitial%latidxprnt - write (0,*) 'Interstitial%levi = ', Interstitial%levi - write (0,*) 'Interstitial%lmk = ', Interstitial%lmk - write (0,*) 'Interstitial%lmp = ', Interstitial%lmp - write (0,*) 'Interstitial%nbdlw = ', Interstitial%nbdlw - write (0,*) 'Interstitial%nbdsw = ', Interstitial%nbdsw - write (0,*) 'Interstitial%nf_aelw = ', Interstitial%nf_aelw - write (0,*) 'Interstitial%nf_aesw = ', Interstitial%nf_aesw - write (0,*) 'Interstitial%nsamftrac = ', Interstitial%nsamftrac - write (0,*) 'Interstitial%nscav = ', Interstitial%nscav - write (0,*) 'Interstitial%nspc1 = ', Interstitial%nspc1 - write (0,*) 'Interstitial%ntcwx = ', Interstitial%ntcwx - write (0,*) 'Interstitial%ntiwx = ', Interstitial%ntiwx - write (0,*) 'Interstitial%nvdiff = ', Interstitial%nvdiff - write (0,*) 'Interstitial%phys_hydrostatic = ', Interstitial%phys_hydrostatic - write (0,*) 'Interstitial%skip_macro = ', Interstitial%skip_macro - write (0,*) 'Interstitial%trans_aero = ', Interstitial%trans_aero - ! Print all other variables - write (0,*) 'Interstitial_print: values that change' - write (0,*) 'sum(Interstitial%adjsfculw_land ) = ', sum(Interstitial%adjsfculw_land ) - write (0,*) 'sum(Interstitial%adjsfculw_ice ) = ', sum(Interstitial%adjsfculw_ice ) - write (0,*) 'sum(Interstitial%adjsfculw_water ) = ', sum(Interstitial%adjsfculw_water ) - write (0,*) 'sum(Interstitial%adjnirbmd ) = ', sum(Interstitial%adjnirbmd ) - write (0,*) 'sum(Interstitial%adjnirbmu ) = ', sum(Interstitial%adjnirbmu ) - write (0,*) 'sum(Interstitial%adjnirdfd ) = ', sum(Interstitial%adjnirdfd ) - write (0,*) 'sum(Interstitial%adjnirdfu ) = ', sum(Interstitial%adjnirdfu ) - write (0,*) 'sum(Interstitial%adjvisbmd ) = ', sum(Interstitial%adjvisbmd ) - write (0,*) 'sum(Interstitial%adjvisbmu ) = ', sum(Interstitial%adjvisbmu ) - write (0,*) 'sum(Interstitial%adjvisdfu ) = ', sum(Interstitial%adjvisdfu ) - write (0,*) 'sum(Interstitial%adjvisdfd ) = ', sum(Interstitial%adjvisdfd ) - write (0,*) 'sum(Interstitial%aerodp ) = ', sum(Interstitial%aerodp ) - write (0,*) 'sum(Interstitial%alb1d ) = ', sum(Interstitial%alb1d ) - if (.not. Model%do_RRTMGP) then - write (0,*) 'sum(Interstitial%alpha ) = ', sum(Interstitial%alpha ) - end if - write (0,*) 'sum(Interstitial%bexp1d ) = ', sum(Interstitial%bexp1d ) - write (0,*) 'sum(Interstitial%cd ) = ', sum(Interstitial%cd ) - write (0,*) 'sum(Interstitial%cd_ice ) = ', sum(Interstitial%cd_ice ) - write (0,*) 'sum(Interstitial%cd_land ) = ', sum(Interstitial%cd_land ) - write (0,*) 'sum(Interstitial%cd_water ) = ', sum(Interstitial%cd_water ) - write (0,*) 'sum(Interstitial%cdq ) = ', sum(Interstitial%cdq ) - write (0,*) 'sum(Interstitial%cdq_ice ) = ', sum(Interstitial%cdq_ice ) - write (0,*) 'sum(Interstitial%cdq_land ) = ', sum(Interstitial%cdq_land ) - write (0,*) 'sum(Interstitial%cdq_water ) = ', sum(Interstitial%cdq_water ) - write (0,*) 'sum(Interstitial%chh_ice ) = ', sum(Interstitial%chh_ice ) - write (0,*) 'sum(Interstitial%chh_land ) = ', sum(Interstitial%chh_land ) - write (0,*) 'sum(Interstitial%chh_water ) = ', sum(Interstitial%chh_water ) - write (0,*) 'sum(Interstitial%cldf ) = ', sum(Interstitial%cldf ) - write (0,*) 'sum(Interstitial%cldsa ) = ', sum(Interstitial%cldsa ) - write (0,*) 'sum(Interstitial%cldtaulw ) = ', sum(Interstitial%cldtaulw ) - write (0,*) 'sum(Interstitial%cldtausw ) = ', sum(Interstitial%cldtausw ) - write (0,*) 'sum(Interstitial%cld1d ) = ', sum(Interstitial%cld1d ) - write (0,*) 'sum(Interstitial%clw ) = ', sum(Interstitial%clw ) - write (0,*) 'sum(Interstitial%clx ) = ', sum(Interstitial%clx ) - write (0,*) 'sum(Interstitial%clouds ) = ', sum(Interstitial%clouds ) - write (0,*) 'sum(Interstitial%cmm_ice ) = ', sum(Interstitial%cmm_ice ) - write (0,*) 'sum(Interstitial%cmm_land ) = ', sum(Interstitial%cmm_land ) - write (0,*) 'sum(Interstitial%cmm_water ) = ', sum(Interstitial%cmm_water ) - write (0,*) 'sum(Interstitial%cnvc ) = ', sum(Interstitial%cnvc ) - write (0,*) 'sum(Interstitial%cnvw ) = ', sum(Interstitial%cnvw ) - write (0,*) 'sum(Interstitial%ctei_r ) = ', sum(Interstitial%ctei_r ) - write (0,*) 'sum(Interstitial%ctei_rml ) = ', sum(Interstitial%ctei_rml ) - write (0,*) 'sum(Interstitial%cumabs ) = ', sum(Interstitial%cumabs ) - write (0,*) 'sum(Interstitial%dd_mf ) = ', sum(Interstitial%dd_mf ) - write (0,*) 'sum(Interstitial%de_lgth ) = ', sum(Interstitial%de_lgth ) - write (0,*) 'sum(Interstitial%del ) = ', sum(Interstitial%del ) - write (0,*) 'sum(Interstitial%del_gz ) = ', sum(Interstitial%del_gz ) - write (0,*) 'sum(Interstitial%delr ) = ', sum(Interstitial%delr ) - write (0,*) 'sum(Interstitial%dlength ) = ', sum(Interstitial%dlength ) - write (0,*) 'sum(Interstitial%dqdt ) = ', sum(Interstitial%dqdt ) - write (0,*) 'sum(Interstitial%dqsfc1 ) = ', sum(Interstitial%dqsfc1 ) - write (0,*) 'sum(Interstitial%drain ) = ', sum(Interstitial%drain ) - write (0,*) 'sum(Interstitial%dtdt ) = ', sum(Interstitial%dtdt ) - write (0,*) 'sum(Interstitial%dtsfc1 ) = ', sum(Interstitial%dtsfc1 ) - write (0,*) 'sum(Interstitial%dtzm ) = ', sum(Interstitial%dtzm ) - write (0,*) 'sum(Interstitial%dt_mf ) = ', sum(Interstitial%dt_mf ) - write (0,*) 'sum(Interstitial%dudt ) = ', sum(Interstitial%dudt ) - write (0,*) 'sum(Interstitial%dusfcg ) = ', sum(Interstitial%dusfcg ) - write (0,*) 'sum(Interstitial%dusfc1 ) = ', sum(Interstitial%dusfc1 ) - write (0,*) 'sum(Interstitial%dvdftra ) = ', sum(Interstitial%dvdftra ) - write (0,*) 'sum(Interstitial%dvdt ) = ', sum(Interstitial%dvdt ) - write (0,*) 'sum(Interstitial%dvsfcg ) = ', sum(Interstitial%dvsfcg ) - write (0,*) 'sum(Interstitial%dvsfc1 ) = ', sum(Interstitial%dvsfc1 ) - write (0,*) 'sum(Interstitial%dzlyr ) = ', sum(Interstitial%dzlyr ) - write (0,*) 'sum(Interstitial%elvmax ) = ', sum(Interstitial%elvmax ) - write (0,*) 'sum(Interstitial%ep1d ) = ', sum(Interstitial%ep1d ) - write (0,*) 'sum(Interstitial%ep1d_ice ) = ', sum(Interstitial%ep1d_ice ) - write (0,*) 'sum(Interstitial%ep1d_land ) = ', sum(Interstitial%ep1d_land ) - write (0,*) 'sum(Interstitial%ep1d_water ) = ', sum(Interstitial%ep1d_water ) - write (0,*) 'sum(Interstitial%evap_ice ) = ', sum(Interstitial%evap_ice ) - write (0,*) 'sum(Interstitial%evap_land ) = ', sum(Interstitial%evap_land ) - write (0,*) 'sum(Interstitial%evap_water ) = ', sum(Interstitial%evap_water ) - write (0,*) 'sum(Interstitial%evbs ) = ', sum(Interstitial%evbs ) - write (0,*) 'sum(Interstitial%evcw ) = ', sum(Interstitial%evcw ) - write (0,*) 'sum(Interstitial%faerlw ) = ', sum(Interstitial%faerlw ) - write (0,*) 'sum(Interstitial%faersw ) = ', sum(Interstitial%faersw ) - write (0,*) 'sum(Interstitial%ffhh_ice ) = ', sum(Interstitial%ffhh_ice ) - write (0,*) 'sum(Interstitial%ffhh_land ) = ', sum(Interstitial%ffhh_land ) - write (0,*) 'sum(Interstitial%ffhh_water ) = ', sum(Interstitial%ffhh_water ) - write (0,*) 'sum(Interstitial%fh2 ) = ', sum(Interstitial%fh2 ) - write (0,*) 'sum(Interstitial%fh2_ice ) = ', sum(Interstitial%fh2_ice ) - write (0,*) 'sum(Interstitial%fh2_land ) = ', sum(Interstitial%fh2_land ) - write (0,*) 'sum(Interstitial%fh2_water ) = ', sum(Interstitial%fh2_water ) - write (0,*) 'Interstitial%flag_cice(1) = ', Interstitial%flag_cice(1) - write (0,*) 'Interstitial%flag_guess(1) = ', Interstitial%flag_guess(1) - write (0,*) 'Interstitial%flag_iter(1) = ', Interstitial%flag_iter(1) - write (0,*) 'sum(Interstitial%ffmm_ice ) = ', sum(Interstitial%ffmm_ice ) - write (0,*) 'sum(Interstitial%ffmm_land ) = ', sum(Interstitial%ffmm_land ) - write (0,*) 'sum(Interstitial%ffmm_water ) = ', sum(Interstitial%ffmm_water ) - write (0,*) 'sum(Interstitial%fm10 ) = ', sum(Interstitial%fm10 ) - write (0,*) 'sum(Interstitial%fm10_ice ) = ', sum(Interstitial%fm10_ice ) - write (0,*) 'sum(Interstitial%fm10_land ) = ', sum(Interstitial%fm10_land ) - write (0,*) 'sum(Interstitial%fm10_water ) = ', sum(Interstitial%fm10_water ) - write (0,*) 'Interstitial%frain = ', Interstitial%frain - write (0,*) 'sum(Interstitial%frland ) = ', sum(Interstitial%frland ) - write (0,*) 'sum(Interstitial%fscav ) = ', sum(Interstitial%fscav ) - write (0,*) 'sum(Interstitial%fswtr ) = ', sum(Interstitial%fswtr ) - write (0,*) 'sum(Interstitial%gabsbdlw ) = ', sum(Interstitial%gabsbdlw ) - write (0,*) 'sum(Interstitial%gabsbdlw_ice ) = ', sum(Interstitial%gabsbdlw_ice ) - write (0,*) 'sum(Interstitial%gabsbdlw_land ) = ', sum(Interstitial%gabsbdlw_land ) - write (0,*) 'sum(Interstitial%gabsbdlw_water ) = ', sum(Interstitial%gabsbdlw_water ) - write (0,*) 'sum(Interstitial%gamma ) = ', sum(Interstitial%gamma ) - write (0,*) 'sum(Interstitial%gamq ) = ', sum(Interstitial%gamq ) - write (0,*) 'sum(Interstitial%gamt ) = ', sum(Interstitial%gamt ) - write (0,*) 'sum(Interstitial%gasvmr ) = ', sum(Interstitial%gasvmr ) - write (0,*) 'sum(Interstitial%gflx ) = ', sum(Interstitial%gflx ) - write (0,*) 'sum(Interstitial%gflx_ice ) = ', sum(Interstitial%gflx_ice ) - write (0,*) 'sum(Interstitial%gflx_land ) = ', sum(Interstitial%gflx_land ) - write (0,*) 'sum(Interstitial%gflx_water ) = ', sum(Interstitial%gflx_water ) - write (0,*) 'sum(Interstitial%gwdcu ) = ', sum(Interstitial%gwdcu ) - write (0,*) 'sum(Interstitial%gwdcv ) = ', sum(Interstitial%gwdcv ) - write (0,*) 'sum(Interstitial%zvfun ) = ', sum(Interstitial%zvfun ) - write (0,*) 'sum(Interstitial%hffac ) = ', sum(Interstitial%hffac ) - write (0,*) 'sum(Interstitial%hflxq ) = ', sum(Interstitial%hflxq ) - write (0,*) 'sum(Interstitial%hflx_ice ) = ', sum(Interstitial%hflx_ice ) - write (0,*) 'sum(Interstitial%hflx_land ) = ', sum(Interstitial%hflx_land ) - write (0,*) 'sum(Interstitial%hflx_water ) = ', sum(Interstitial%hflx_water ) - write (0,*) 'sum(Interstitial%htlwc ) = ', sum(Interstitial%htlwc ) - write (0,*) 'sum(Interstitial%htlw0 ) = ', sum(Interstitial%htlw0 ) - write (0,*) 'sum(Interstitial%htswc ) = ', sum(Interstitial%htswc ) - write (0,*) 'sum(Interstitial%htsw0 ) = ', sum(Interstitial%htsw0 ) - write (0,*) 'Interstitial%dry(:)==.true. = ', count(Interstitial%dry(:) ) - write (0,*) 'sum(Interstitial%idxday ) = ', sum(Interstitial%idxday ) - write (0,*) 'Interstitial%icy(:)==.true. = ', count(Interstitial%icy(:) ) - write (0,*) 'Interstitial%lake(:)==.true. = ', count(Interstitial%lake(:) ) - write (0,*) 'Interstitial%use_flake(:)==.true. = ', count(Interstitial%use_flake(:) ) - write (0,*) 'Interstitial%ocean(:)==.true. = ', count(Interstitial%ocean(:) ) - write (0,*) 'sum(Interstitial%islmsk ) = ', sum(Interstitial%islmsk ) - write (0,*) 'sum(Interstitial%islmsk_cice ) = ', sum(Interstitial%islmsk_cice ) - write (0,*) 'Interstitial%wet(:)==.true. = ', count(Interstitial%wet(:) ) - write (0,*) 'Interstitial%kb = ', Interstitial%kb - write (0,*) 'sum(Interstitial%kbot ) = ', sum(Interstitial%kbot ) - write (0,*) 'sum(Interstitial%kcnv ) = ', sum(Interstitial%kcnv ) - write (0,*) 'Interstitial%kd = ', Interstitial%kd - write (0,*) 'sum(Interstitial%kinver ) = ', sum(Interstitial%kinver ) - write (0,*) 'sum(Interstitial%kpbl ) = ', sum(Interstitial%kpbl ) - write (0,*) 'Interstitial%kt = ', Interstitial%kt - write (0,*) 'sum(Interstitial%ktop ) = ', sum(Interstitial%ktop ) - write (0,*) 'sum(Interstitial%mbota ) = ', sum(Interstitial%mbota ) - write (0,*) 'sum(Interstitial%mtopa ) = ', sum(Interstitial%mtopa ) - write (0,*) 'Interstitial%nday = ', Interstitial%nday - write (0,*) 'sum(Interstitial%oa4 ) = ', sum(Interstitial%oa4 ) - write (0,*) 'sum(Interstitial%oc ) = ', sum(Interstitial%oc ) - write (0,*) 'sum(Interstitial%olyr ) = ', sum(Interstitial%olyr ) - write (0,*) 'sum(Interstitial%plvl ) = ', sum(Interstitial%plvl ) - write (0,*) 'sum(Interstitial%plyr ) = ', sum(Interstitial%plyr ) - write (0,*) 'sum(Interstitial%prcpmp ) = ', sum(Interstitial%prcpmp ) - write (0,*) 'sum(Interstitial%prnum ) = ', sum(Interstitial%prnum ) - write (0,*) 'sum(Interstitial%qlyr ) = ', sum(Interstitial%qlyr ) - write (0,*) 'sum(Interstitial%qss_ice ) = ', sum(Interstitial%qss_ice ) - write (0,*) 'sum(Interstitial%qss_land ) = ', sum(Interstitial%qss_land ) - write (0,*) 'sum(Interstitial%qss_water ) = ', sum(Interstitial%qss_water ) - write (0,*) 'Interstitial%radar_reset = ', Interstitial%radar_reset - write (0,*) 'Interstitial%raddt = ', Interstitial%raddt - write (0,*) 'sum(Interstitial%raincd ) = ', sum(Interstitial%raincd ) - write (0,*) 'sum(Interstitial%raincs ) = ', sum(Interstitial%raincs ) - write (0,*) 'sum(Interstitial%rainmcadj ) = ', sum(Interstitial%rainmcadj ) - write (0,*) 'sum(Interstitial%rainp ) = ', sum(Interstitial%rainp ) - write (0,*) 'sum(Interstitial%rb ) = ', sum(Interstitial%rb ) - write (0,*) 'sum(Interstitial%rb_ice ) = ', sum(Interstitial%rb_ice ) - write (0,*) 'sum(Interstitial%rb_land ) = ', sum(Interstitial%rb_land ) - write (0,*) 'sum(Interstitial%rb_water ) = ', sum(Interstitial%rb_water ) - write (0,*) 'Interstitial%max_hourly_reset = ', Interstitial%max_hourly_reset - write (0,*) 'Interstitial%ext_diag_thompson_reset = ', Interstitial%ext_diag_thompson_reset - write (0,*) 'sum(Interstitial%rhc ) = ', sum(Interstitial%rhc ) - write (0,*) 'sum(Interstitial%runoff ) = ', sum(Interstitial%runoff ) - write (0,*) 'sum(Interstitial%save_q ) = ', sum(Interstitial%save_q ) - write (0,*) 'sum(Interstitial%save_t ) = ', sum(Interstitial%save_t ) - write (0,*) 'sum(Interstitial%save_tcp ) = ', sum(Interstitial%save_tcp ) - write (0,*) 'sum(Interstitial%save_u ) = ', sum(Interstitial%save_u ) - write (0,*) 'sum(Interstitial%save_v ) = ', sum(Interstitial%save_v ) - write (0,*) 'sum(Interstitial%sbsno ) = ', sum(Interstitial%sbsno ) - write (0,*) 'sum(Interstitial%scmpsw%uvbfc ) = ', sum(Interstitial%scmpsw%uvbfc ) - write (0,*) 'sum(Interstitial%scmpsw%uvbf0 ) = ', sum(Interstitial%scmpsw%uvbf0 ) - write (0,*) 'sum(Interstitial%scmpsw%nirbm ) = ', sum(Interstitial%scmpsw%nirbm ) - write (0,*) 'sum(Interstitial%scmpsw%nirdf ) = ', sum(Interstitial%scmpsw%nirdf ) - write (0,*) 'sum(Interstitial%scmpsw%visbm ) = ', sum(Interstitial%scmpsw%visbm ) - write (0,*) 'sum(Interstitial%scmpsw%visdf ) = ', sum(Interstitial%scmpsw%visdf ) - write (0,*) 'sum(Interstitial%semis_ice ) = ', sum(Interstitial%semis_ice ) - write (0,*) 'sum(Interstitial%semis_land ) = ', sum(Interstitial%semis_land ) - write (0,*) 'sum(Interstitial%semis_water ) = ', sum(Interstitial%semis_water ) - write (0,*) 'sum(Interstitial%sfcalb ) = ', sum(Interstitial%sfcalb ) - write (0,*) 'sum(Interstitial%sigma ) = ', sum(Interstitial%sigma ) - write (0,*) 'sum(Interstitial%sigmaf ) = ', sum(Interstitial%sigmaf ) - write (0,*) 'sum(Interstitial%sigmafrac ) = ', sum(Interstitial%sigmafrac ) - write (0,*) 'sum(Interstitial%sigmatot ) = ', sum(Interstitial%sigmatot ) - write (0,*) 'sum(Interstitial%slopetype ) = ', sum(Interstitial%slopetype ) - write (0,*) 'sum(Interstitial%snowc ) = ', sum(Interstitial%snowc ) - write (0,*) 'sum(Interstitial%snowd_ice ) = ', sum(Interstitial%snowd_ice ) -! write (0,*) 'sum(Interstitial%snowd_land ) = ', sum(Interstitial%snowd_land ) -! write (0,*) 'sum(Interstitial%snowd_water ) = ', sum(Interstitial%snowd_water ) - write (0,*) 'sum(Interstitial%snohf ) = ', sum(Interstitial%snohf ) - write (0,*) 'sum(Interstitial%snowmt ) = ', sum(Interstitial%snowmt ) - write (0,*) 'sum(Interstitial%soiltype ) = ', sum(Interstitial%soiltype ) - write (0,*) 'sum(Interstitial%stress ) = ', sum(Interstitial%stress ) - write (0,*) 'sum(Interstitial%stress_ice ) = ', sum(Interstitial%stress_ice ) - write (0,*) 'sum(Interstitial%stress_land ) = ', sum(Interstitial%stress_land ) - write (0,*) 'sum(Interstitial%stress_water ) = ', sum(Interstitial%stress_water ) - write (0,*) 'sum(Interstitial%theta ) = ', sum(Interstitial%theta ) - write (0,*) 'sum(Interstitial%tlvl ) = ', sum(Interstitial%tlvl ) - write (0,*) 'sum(Interstitial%tlyr ) = ', sum(Interstitial%tlyr ) - write (0,*) 'sum(Interstitial%tprcp_ice ) = ', sum(Interstitial%tprcp_ice ) - write (0,*) 'sum(Interstitial%tprcp_land ) = ', sum(Interstitial%tprcp_land ) - write (0,*) 'sum(Interstitial%tprcp_water ) = ', sum(Interstitial%tprcp_water ) - write (0,*) 'sum(Interstitial%trans ) = ', sum(Interstitial%trans ) - write (0,*) 'sum(Interstitial%tseal ) = ', sum(Interstitial%tseal ) - write (0,*) 'sum(Interstitial%tsfa ) = ', sum(Interstitial%tsfa ) - write (0,*) 'sum(Interstitial%tsfc_ice ) = ', sum(Interstitial%tsfc_ice ) - write (0,*) 'sum(Interstitial%tsfc_water ) = ', sum(Interstitial%tsfc_water ) - write (0,*) 'sum(Interstitial%tsfg ) = ', sum(Interstitial%tsfg ) - write (0,*) 'sum(Interstitial%tsurf_ice ) = ', sum(Interstitial%tsurf_ice ) - write (0,*) 'sum(Interstitial%tsurf_land ) = ', sum(Interstitial%tsurf_land ) - write (0,*) 'sum(Interstitial%tsurf_water ) = ', sum(Interstitial%tsurf_water ) - write (0,*) 'sum(Interstitial%ud_mf ) = ', sum(Interstitial%ud_mf ) - write (0,*) 'sum(Interstitial%uustar_ice ) = ', sum(Interstitial%uustar_ice ) - write (0,*) 'sum(Interstitial%uustar_land ) = ', sum(Interstitial%uustar_land ) - write (0,*) 'sum(Interstitial%uustar_water ) = ', sum(Interstitial%uustar_water ) - write (0,*) 'sum(Interstitial%vdftra ) = ', sum(Interstitial%vdftra ) - write (0,*) 'sum(Interstitial%vegf1d ) = ', sum(Interstitial%vegf1d ) - write (0,*) 'sum(Interstitial%vegtype ) = ', sum(Interstitial%vegtype ) - write (0,*) 'sum(Interstitial%wcbmax ) = ', sum(Interstitial%wcbmax ) - write (0,*) 'sum(Interstitial%weasd_ice ) = ', sum(Interstitial%weasd_ice ) -! write (0,*) 'sum(Interstitial%weasd_land ) = ', sum(Interstitial%weasd_land ) -! write (0,*) 'sum(Interstitial%weasd_water ) = ', sum(Interstitial%weasd_water ) - write (0,*) 'sum(Interstitial%wind ) = ', sum(Interstitial%wind ) - write (0,*) 'sum(Interstitial%work1 ) = ', sum(Interstitial%work1 ) - write (0,*) 'sum(Interstitial%work2 ) = ', sum(Interstitial%work2 ) - write (0,*) 'sum(Interstitial%work3 ) = ', sum(Interstitial%work3 ) - write (0,*) 'sum(Interstitial%xcosz ) = ', sum(Interstitial%xcosz ) - write (0,*) 'sum(Interstitial%xlai1d ) = ', sum(Interstitial%xlai1d ) - write (0,*) 'sum(Interstitial%xmu ) = ', sum(Interstitial%xmu ) - write (0,*) 'sum(Interstitial%z01d ) = ', sum(Interstitial%z01d ) - write (0,*) 'sum(Interstitial%zt1d ) = ', sum(Interstitial%zt1d ) - -! UGWP common - write (0,*) 'sum(Interstitial%tau_mtb ) = ', sum(Interstitial%tau_mtb ) - write (0,*) 'sum(Interstitial%tau_ogw ) = ', sum(Interstitial%tau_ogw ) - write (0,*) 'sum(Interstitial%tau_tofd ) = ', sum(Interstitial%tau_tofd ) - write (0,*) 'sum(Interstitial%tau_ngw ) = ', sum(Interstitial%tau_ngw ) - write (0,*) 'sum(Interstitial%tau_oss ) = ', sum(Interstitial%tau_oss ) - write (0,*) 'sum(Interstitial%dudt_mtb ) = ', sum(Interstitial%dudt_mtb ) - write (0,*) 'sum(Interstitial%dudt_tms ) = ', sum(Interstitial%dudt_tms ) - write (0,*) 'sum(Interstitial%zmtb ) = ', sum(Interstitial%zmtb ) - write (0,*) 'sum(Interstitial%zlwb ) = ', sum(Interstitial%zlwb ) - write (0,*) 'sum(Interstitial%zogw ) = ', sum(Interstitial%zogw ) - write (0,*) 'sum(Interstitial%zngw ) = ', sum(Interstitial%zngw ) - -! UGWP v1 - if (Model%do_ugwp_v1) then - write (0,*) 'sum(Interstitial%dudt_ngw ) = ', sum(Interstitial%dudt_ngw ) - write (0,*) 'sum(Interstitial%dvdt_ngw ) = ', sum(Interstitial%dvdt_ngw ) - write (0,*) 'sum(Interstitial%dtdt_ngw ) = ', sum(Interstitial%dtdt_ngw ) - write (0,*) 'sum(Interstitial%kdis_ngw ) = ', sum(Interstitial%kdis_ngw ) - end if -!-- GSL drag suite - if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & - Model%gwd_opt==2 .or. Model%gwd_opt==22) then - write (0,*) 'sum(Interstitial%varss ) = ', sum(Interstitial%varss) - write (0,*) 'sum(Interstitial%ocss ) = ', sum(Interstitial%ocss) - write (0,*) 'sum(Interstitial%oa4ss ) = ', sum(Interstitial%oa4ss) - write (0,*) 'sum(Interstitial%clxss ) = ', sum(Interstitial%clxss) - end if -! - ! Print arrays that are conditional on physics choices - if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then - write (0,*) 'Interstitial_print: values specific to GFDL/Thompson microphysics' - write (0,*) 'sum(Interstitial%graupelmp ) = ', sum(Interstitial%graupelmp ) - write (0,*) 'sum(Interstitial%icemp ) = ', sum(Interstitial%icemp ) - write (0,*) 'sum(Interstitial%rainmp ) = ', sum(Interstitial%rainmp ) - write (0,*) 'sum(Interstitial%snowmp ) = ', sum(Interstitial%snowmp ) - !F-A scheme - else if (Model%imp_physics == Model%imp_physics_fer_hires) then - write (0,*) 'Interstitial_print: values specific to F-A microphysics' - write (0,*) 'sum(Interstitial%f_ice ) = ', sum(Interstitial%f_ice ) - write (0,*) 'sum(Interstitial%f_rain ) = ', sum(Interstitial%f_rain ) - write (0,*) 'sum(Interstitial%f_rimef ) = ', sum(Interstitial%f_rimef ) - write (0,*) 'sum(Interstitial%cwm ) = ', sum(Interstitial%cwm ) - else if (Model%imp_physics == Model%imp_physics_mg) then - write (0,*) 'Interstitial_print: values specific to MG microphysics' - write (0,*) 'sum(Interstitial%ncgl ) = ', sum(Interstitial%ncgl ) - write (0,*) 'sum(Interstitial%ncpr ) = ', sum(Interstitial%ncpr ) - write (0,*) 'sum(Interstitial%ncps ) = ', sum(Interstitial%ncps ) - write (0,*) 'sum(Interstitial%qgl ) = ', sum(Interstitial%qgl ) - write (0,*) 'sum(Interstitial%qrn ) = ', sum(Interstitial%qrn ) - write (0,*) 'sum(Interstitial%qsnw ) = ', sum(Interstitial%qsnw ) - write (0,*) 'sum(Interstitial%qlcn ) = ', sum(Interstitial%qlcn ) - write (0,*) 'sum(Interstitial%qicn ) = ', sum(Interstitial%qicn ) - write (0,*) 'sum(Interstitial%w_upi ) = ', sum(Interstitial%w_upi ) - write (0,*) 'sum(Interstitial%cf_upi ) = ', sum(Interstitial%cf_upi ) - write (0,*) 'sum(Interstitial%cnv_mfd ) = ', sum(Interstitial%cnv_mfd ) - write (0,*) 'sum(Interstitial%cnv_dqldt ) = ', sum(Interstitial%cnv_dqldt ) - write (0,*) 'sum(Interstitial%clcn ) = ', sum(Interstitial%clcn ) - write (0,*) 'sum(Interstitial%cnv_fice ) = ', sum(Interstitial%cnv_fice ) - write (0,*) 'sum(Interstitial%cnv_ndrop ) = ', sum(Interstitial%cnv_ndrop ) - write (0,*) 'sum(Interstitial%cnv_nice ) = ', sum(Interstitial%cnv_nice ) - end if - if (Model%do_shoc) then - write (0,*) 'Interstitial_print: values specific to SHOC' - write (0,*) 'sum(Interstitial%ncgl ) = ', sum(Interstitial%ncgl ) - write (0,*) 'sum(Interstitial%qrn ) = ', sum(Interstitial%qrn ) - write (0,*) 'sum(Interstitial%qsnw ) = ', sum(Interstitial%qsnw ) - write (0,*) 'sum(Interstitial%qgl ) = ', sum(Interstitial%qgl ) - write (0,*) 'sum(Interstitial%ncpi ) = ', sum(Interstitial%ncpi ) - write (0,*) 'sum(Interstitial%ncpl ) = ', sum(Interstitial%ncpl ) - end if - if (Model%lsm == Model%lsm_noahmp) then - write (0,*) 'sum(Interstitial%t2mmp ) = ', sum(Interstitial%t2mmp ) - write (0,*) 'sum(Interstitial%q2mp ) = ', sum(Interstitial%q2mp ) - end if - if (Model%lsm == Model%lsm_noah_wrfv4) then - write (0,*) 'sum(Interstitial%canopy_save ) = ', sum(Interstitial%canopy_save ) - write (0,*) 'sum(Interstitial%chk_land ) = ', sum(Interstitial%chk_land ) - write (0,*) 'sum(Interstitial%cmc ) = ', sum(Interstitial%cmc ) - write (0,*) 'sum(Interstitial%dqsdt2 ) = ', sum(Interstitial%dqsdt2 ) - write (0,*) 'sum(Interstitial%drain_in_m_sm1 ) = ', sum(Interstitial%drain_in_m_sm1 ) - write (0,*) 'Interstitial%flag_lsm(1) = ', Interstitial%flag_lsm(1) - write (0,*) 'Interstitial%flag_lsm_glacier(1) = ', Interstitial%flag_lsm_glacier(1) - write (0,*) 'sum(Interstitial%qs1 ) = ', sum(Interstitial%qs1 ) - write (0,*) 'sum(Interstitial%qv1 ) = ', sum(Interstitial%qv1 ) - write (0,*) 'sum(Interstitial%rho1 ) = ', sum(Interstitial%rho1 ) - write (0,*) 'sum(Interstitial%runoff_in_m_sm1 ) = ', sum(Interstitial%runoff_in_m_sm1 ) - write (0,*) 'sum(Interstitial%smcmax ) = ', sum(Interstitial%smcmax ) - write (0,*) 'sum(Interstitial%snowd_land_save ) = ', sum(Interstitial%snowd_land_save ) - write (0,*) 'sum(Interstitial%snow_depth ) = ', sum(Interstitial%snow_depth ) - write (0,*) 'sum(Interstitial%snohf_snow ) = ', sum(Interstitial%snohf_snow ) - write (0,*) 'sum(Interstitial%snohf_frzgra ) = ', sum(Interstitial%snohf_frzgra ) - write (0,*) 'sum(Interstitial%snohf_snowmelt ) = ', sum(Interstitial%snohf_snowmelt ) - write (0,*) 'sum(Interstitial%soilm_in_m ) = ', sum(Interstitial%soilm_in_m ) - write (0,*) 'sum(Interstitial%th1 ) = ', sum(Interstitial%th1 ) - write (0,*) 'sum(Interstitial%tprcp_rate_land ) = ', sum(Interstitial%tprcp_rate_land ) - write (0,*) 'sum(Interstitial%tsfc_land_save ) = ', sum(Interstitial%tsfc_land_save ) - write (0,*) 'sum(Interstitial%weasd_land_save ) = ', sum(Interstitial%weasd_land_save ) - end if - ! RRTMGP - if (Model%do_RRTMGP) then - write (0,*) 'sum(Interstitial%aerosolslw ) = ', sum(Interstitial%aerosolslw ) - write (0,*) 'sum(Interstitial%aerosolssw ) = ', sum(Interstitial%aerosolssw ) - write (0,*) 'sum(Interstitial%cld_frac ) = ', sum(Interstitial%cld_frac ) - write (0,*) 'sum(Interstitial%cld_lwp ) = ', sum(Interstitial%cld_lwp ) - write (0,*) 'sum(Interstitial%cld_reliq ) = ', sum(Interstitial%cld_reliq ) - write (0,*) 'sum(Interstitial%cld_iwp ) = ', sum(Interstitial%cld_iwp ) - write (0,*) 'sum(Interstitial%cld_reice ) = ', sum(Interstitial%cld_reice ) - write (0,*) 'sum(Interstitial%cld_swp ) = ', sum(Interstitial%cld_swp ) - write (0,*) 'sum(Interstitial%cld_resnow ) = ', sum(Interstitial%cld_resnow ) - write (0,*) 'sum(Interstitial%cld_rwp ) = ', sum(Interstitial%cld_rwp ) - write (0,*) 'sum(Interstitial%cld_rerain ) = ', sum(Interstitial%cld_rerain ) - write (0,*) 'sum(Interstitial%precip_frac ) = ', sum(Interstitial%precip_frac ) - write (0,*) 'sum(Interstitial%icseed_lw ) = ', sum(Interstitial%icseed_lw ) - write (0,*) 'sum(Interstitial%icseed_sw ) = ', sum(Interstitial%icseed_sw ) - write (0,*) 'sum(Interstitial%fluxlwUP_clrsky ) = ', sum(Interstitial%fluxlwUP_clrsky ) - write (0,*) 'sum(Interstitial%fluxlwDOWN_clrsky ) = ', sum(Interstitial%fluxlwDOWN_clrsky) - write (0,*) 'sum(Interstitial%fluxswUP_allsky ) = ', sum(Interstitial%fluxswUP_allsky ) - write (0,*) 'sum(Interstitial%fluxswDOWN_allsky ) = ', sum(Interstitial%fluxswDOWN_allsky) - write (0,*) 'sum(Interstitial%fluxswUP_clrsky ) = ', sum(Interstitial%fluxswUP_clrsky ) - write (0,*) 'sum(Interstitial%fluxswDOWN_clrsky ) = ', sum(Interstitial%fluxswDOWN_clrsky) - write (0,*) 'sum(Interstitial%relhum ) = ', sum(Interstitial%relhum ) - write (0,*) 'sum(Interstitial%q_lay ) = ', sum(Interstitial%q_lay ) - write (0,*) 'sum(Interstitial%qs_lay ) = ', sum(Interstitial%qs_lay ) - write (0,*) 'sum(Interstitial%deltaZ ) = ', sum(Interstitial%deltaZ ) - write (0,*) 'sum(Interstitial%p_lay ) = ', sum(Interstitial%p_lay ) - write (0,*) 'sum(Interstitial%p_lev ) = ', sum(Interstitial%p_lev ) - write (0,*) 'sum(Interstitial%t_lay ) = ', sum(Interstitial%t_lay ) - write (0,*) 'sum(Interstitial%t_lev ) = ', sum(Interstitial%t_lev ) - write (0,*) 'sum(Interstitial%tv_lay ) = ', sum(Interstitial%tv_lay ) - write (0,*) 'sum(Interstitial%cloud_overlap_param ) = ', sum(Interstitial%cloud_overlap_param) - write (0,*) 'sum(Interstitial%precip_overlap_param ) = ', sum(Interstitial%precip_overlap_param) - end if - - write (0,*) 'Interstitial_print: end' - ! - end subroutine interstitial_print - end module GFS_typedefs diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index a7059730b..53ed1f585 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -631,7 +631,7 @@ standard_name = surface_snow_area_fraction_over_ice long_name = surface snow area fraction over ice units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) @@ -697,12 +697,17 @@ type = real kind = kind_phys [slope] - standard_name = surface_slope_classification_real + standard_name = surface_slope_classification long_name = sfc slope type for lsm units = index dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys + type = integer +[slope_save] + standard_name = surface_slope_classification_save + long_name = sfc slope type for lsm save + units = index + dimensions = (horizontal_loop_extent) + type = integer [shdmin] standard_name = min_vegetation_area_fraction long_name = min fractional coverage of green vegetation @@ -732,19 +737,29 @@ type = real kind = kind_phys [vtype] - standard_name = vegetation_type_classification_real + standard_name = vegetation_type_classification long_name = vegetation type for lsm units = index dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys + type = integer +[vtype_save] + standard_name = vegetation_type_classification_save + long_name = vegetation type for lsm save + units = index + dimensions = (horizontal_loop_extent) + type = integer [stype] - standard_name = soil_type_classification_real + standard_name = soil_type_classification long_name = soil type for lsm units = index dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys + type = integer +[stype_save] + standard_name = soil_type_classification_save + long_name = soil type for lsm save + units = index + dimensions = (horizontal_loop_extent) + type = integer [uustar] standard_name = surface_friction_velocity long_name = boundary layer parameter @@ -1448,7 +1463,7 @@ standard_name = temperature_in_surface_snow_at_surface_adjacent_layer_over_land long_name = snow temperature at the bottom of the first snow layer over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) @@ -2193,13 +2208,6 @@ type = real kind = kind_phys active = (flag_for_cellular_automata) -[vfact_ca] - standard_name = cellular_automata_vertical_weight - long_name = vertical weight for ca - units = frac - dimensions = (vertical_layer_dimension) - type = real - kind = kind_phys [ca1] standard_name = cellular_automata_global_pattern_from_coupled_process long_name = cellular automata global pattern @@ -2555,6 +2563,12 @@ units = flag dimensions = () type = logical +[cplocn2atm] + standard_name = flag_for_one_way_ocean_coupling_to_atmosphere + long_name = flag controlling ocean coupling to the atmosphere (default on) + units = flag + dimensions = () + type = logical [cplwav] standard_name = flag_for_ocean_wave_coupling long_name = flag controlling cplwav collection (default off) @@ -4408,6 +4422,13 @@ units = flag dimensions = () type = logical +[vfact_ca] + standard_name = cellular_automata_vertical_weight + long_name = vertical weight for ca + units = frac + dimensions = (vertical_layer_dimension) + type = real + kind = kind_phys [ca_closure] standard_name = flag_for_global_cellular_automata_closure long_name = switch for ca on closure @@ -6859,41 +6880,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[skebu_wts] - standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind_flipped - long_name = weights for stochastic skeb perturbation of x wind, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[skebv_wts] - standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind_flipped - long_name = weights for stochastic skeb perturbation of y wind, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[sppt_wts] - standard_name = weights_for_stochastic_sppt_perturbation_flipped - long_name = weights for stochastic sppt perturbation, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[shum_wts] - standard_name = weights_for_stochastic_shum_perturbation_flipped - long_name = weights for stochastic shum perturbation, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys -[sfc_wts] - standard_name = weights_for_stochastic_surface_physics_perturbation_flipped - long_name = weights for stochastic surface physics perturbation, flipped - units = none - dimensions = (horizontal_loop_extent,number_of_perturbed_land_surface_variables) - type = real - kind = kind_phys [zmtnblck] standard_name = level_of_dividing_streamline long_name = level of the dividing streamline @@ -9519,12 +9505,6 @@ type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_noah_wrfv4_land_surface_scheme) -[slopetype] - standard_name = surface_slope_classification - long_name = surface slope type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer [smcmax] standard_name = soil_porosity long_name = volumetric soil porosity @@ -9625,12 +9605,6 @@ type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_noah_wrfv4_land_surface_scheme) -[soiltype] - standard_name = soil_type_classification - long_name = soil type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer [stc_save] standard_name = soil_temperature_save long_name = soil temperature before entering a physics scheme @@ -9877,12 +9851,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[vegtype] - standard_name = vegetation_type_classification - long_name = vegetation type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -10110,7 +10078,7 @@ standard_name = saturation_vapor_pressure long_name = saturation vapor pressure units = Pa - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys optional = F @@ -10119,7 +10087,7 @@ standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio units = kg/kg - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys optional = F diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 23c830a5c..be79b5963 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -20,6 +20,7 @@ module GFS_diagnostics !--- private data type definition --- type data_subtype + integer, dimension(:), pointer :: int2 => NULL() real(kind=kind_phys), dimension(:), pointer :: var2 => NULL() real(kind=kind_phys), dimension(:), pointer :: var21 => NULL() real(kind=kind_phys), dimension(:,:), pointer :: var3 => NULL() @@ -113,6 +114,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ! ExtDiag%mask [char*64 ] description of mask-type ! ! ExtDiag%intpl_method [char*64 ] method to use for interpolation ! ! ExtDiag%cnvfac [real*8 ] conversion factor to output specified units ! +! ExtDiag%data(nb)%int2(:) [integer ] pointer to 2D data [=> null() for a 3D field] ! ! ExtDiag%data(nb)%var2(:) [real*8 ] pointer to 2D data [=> null() for a 3D field] ! ! ExtDiag%data(nb)%var21(:) [real*8 ] pointer to 2D data for ratios ! ! ExtDiag%data(nb)%var3(:,:) [real*8 ] pointer to 3D data [=> null() for a 2D field] ! @@ -2037,7 +2039,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%skebu_wts(:,:) + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%skebu_wts(:,:) enddo idx = idx + 1 @@ -2048,7 +2050,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%skebv_wts(:,:) + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%skebv_wts(:,:) enddo idx = idx + 1 @@ -2091,7 +2093,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%sppt_wts(:,:) + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%sppt_wts(:,:) enddo idx = idx + 1 @@ -2102,7 +2104,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%shum_wts(:,:) + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%shum_wts(:,:) enddo idx = idx + 1 @@ -2113,7 +2115,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%sfc_wts(:,1) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%sfc_wts(:,1) enddo idx = idx + 1 @@ -2124,7 +2126,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%sfc_wts(:,2) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%sfc_wts(:,2) enddo idx = idx + 1 @@ -2135,7 +2137,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca1(:) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca1(:) enddo idx = idx + 1 @@ -2146,7 +2148,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_deep(:) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_deep(:) enddo idx = idx + 1 @@ -2157,7 +2159,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_turb(:) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_turb(:) enddo idx = idx + 1 @@ -2168,7 +2170,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_shal(:) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_shal(:) enddo idx = idx + 1 @@ -2179,7 +2181,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_rad(:) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_rad(:) enddo idx = idx + 1 @@ -2190,7 +2192,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_micro(:) + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_micro(:) enddo if (Model%ldiag_ugwp) THEN @@ -2610,7 +2612,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%slope(:) + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%slope(:) enddo idx = idx + 1 @@ -2724,7 +2726,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%stype(:) + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%stype(:) enddo idx = idx + 1 @@ -2819,7 +2821,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%vtype(:) + ExtDiag(idx)%data(nb)%int2 => sfcprop(nb)%vtype(:) enddo idx = idx + 1 diff --git a/ccpp/framework b/ccpp/framework index 922fe4494..6874fc9b4 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 922fe44948acddaec6bc08d2392beaa047fe2587 +Subproject commit 6874fc9b49237b70df7af9b513ea10df697c27d6 diff --git a/ccpp/physics b/ccpp/physics index 144b521e4..95c67d3c8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 144b521e4b855efedc66b9222d7d96c0c65c8432 +Subproject commit 95c67d3c897d5dda57b92c13966df2a1ac84f2b0 diff --git a/ccpp/suites/suite_FV3_GFS_2017_coupled.xml b/ccpp/suites/suite_FV3_GFS_2017_coupled.xml deleted file mode 100644 index 55e20f8e3..000000000 --- a/ccpp/suites/suite_FV3_GFS_2017_coupled.xml +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - GFS_time_vary_pre - GFS_rrtmg_setup - GFS_rad_time_vary - GFS_phys_time_vary - - - - - GFS_suite_interstitial_rad_reset - GFS_rrtmg_pre - GFS_radiation_surface - rrtmg_sw_pre - rrtmg_sw - rrtmg_sw_post - rrtmg_lw_pre - rrtmg_lw - rrtmg_lw_post - GFS_rrtmg_post - - - - - GFS_suite_interstitial_phys_reset - GFS_suite_stateout_reset - get_prs_fv3 - GFS_suite_interstitial_1 - GFS_surface_generic_pre - GFS_surface_composites_pre - dcyc2t3 - GFS_surface_composites_inter - GFS_suite_interstitial_2 - - - - sfc_diff - GFS_surface_loop_control_part1 - sfc_ocean - lsm_noah - sfc_cice - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - hedmf - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - GFS_SCNV_generic_post - GFS_suite_interstitial_4 - cnvc90 - GFS_MP_generic_pre - zhaocarr_gscond - zhaocarr_precpd - GFS_MP_generic_post - maximum_hourly_diagnostics - phys_tend - - - - - GFS_stochastics - - - - diff --git a/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml b/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml deleted file mode 100644 index 3c45e5b0e..000000000 --- a/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - GFS_time_vary_pre - GFS_rrtmg_setup - GFS_rad_time_vary - GFS_phys_time_vary - - - - - GFS_suite_interstitial_rad_reset - GFS_rrtmg_pre - GFS_radiation_surface - rrtmg_sw_pre - rrtmg_sw - rrtmg_sw_post - rrtmg_lw_pre - rrtmg_lw - rrtmg_lw_post - GFS_rrtmg_post - - - - - GFS_suite_interstitial_phys_reset - GFS_suite_stateout_reset - get_prs_fv3 - GFS_suite_interstitial_1 - GFS_surface_generic_pre - GFS_surface_composites_pre - dcyc2t3 - GFS_surface_composites_inter - GFS_suite_interstitial_2 - - - - sfc_diff - GFS_surface_loop_control_part1 - lsm_noah - sfc_nst_pre - sfc_nst - sfc_nst_post - sfc_cice - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - hedmf - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - GFS_SCNV_generic_post - GFS_suite_interstitial_4 - cnvc90 - GFS_MP_generic_pre - zhaocarr_gscond - zhaocarr_precpd - GFS_MP_generic_post - maximum_hourly_diagnostics - phys_tend - - - - - GFS_stochastics - - - - diff --git a/ccpp/suites/suite_FV3_GFS_2017_satmedmf_coupled.xml b/ccpp/suites/suite_FV3_GFS_2017_satmedmf_coupled.xml deleted file mode 100644 index bf53393e0..000000000 --- a/ccpp/suites/suite_FV3_GFS_2017_satmedmf_coupled.xml +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - GFS_time_vary_pre - GFS_rrtmg_setup - GFS_rad_time_vary - GFS_phys_time_vary - - - - - GFS_suite_interstitial_rad_reset - GFS_rrtmg_pre - GFS_radiation_surface - rrtmg_sw_pre - rrtmg_sw - rrtmg_sw_post - rrtmg_lw_pre - rrtmg_lw - rrtmg_lw_post - GFS_rrtmg_post - - - - - GFS_suite_interstitial_phys_reset - GFS_suite_stateout_reset - get_prs_fv3 - GFS_suite_interstitial_1 - GFS_surface_generic_pre - GFS_surface_composites_pre - dcyc2t3 - GFS_surface_composites_inter - GFS_suite_interstitial_2 - - - - sfc_diff - GFS_surface_loop_control_part1 - sfc_ocean - lsm_noah - sfc_cice - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - satmedmfvdif - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - GFS_SCNV_generic_post - GFS_suite_interstitial_4 - cnvc90 - GFS_MP_generic_pre - zhaocarr_gscond - zhaocarr_precpd - GFS_MP_generic_post - maximum_hourly_diagnostics - phys_tend - - - - - GFS_stochastics - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml b/ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml deleted file mode 100644 index 727f85120..000000000 --- a/ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml +++ /dev/null @@ -1,93 +0,0 @@ - - - - - - - fv_sat_adj - - - - - GFS_time_vary_pre - GFS_rrtmg_setup - GFS_rad_time_vary - GFS_phys_time_vary - - - - - GFS_suite_interstitial_rad_reset - GFS_rrtmg_pre - GFS_radiation_surface - rrtmg_sw_pre - rrtmg_sw - rrtmg_sw_post - rrtmg_lw_pre - rrtmg_lw - rrtmg_lw_post - GFS_rrtmg_post - - - - - GFS_suite_interstitial_phys_reset - GFS_suite_stateout_reset - get_prs_fv3 - GFS_suite_interstitial_1 - GFS_surface_generic_pre - GFS_surface_composites_pre - dcyc2t3 - GFS_surface_composites_inter - GFS_suite_interstitial_2 - - - - sfc_diff - GFS_surface_loop_control_part1 - sfc_ocean - lsm_noah - sfc_cice - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - hedmf - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys_2015 - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - GFS_SCNV_generic_post - GFS_suite_interstitial_4 - cnvc90 - GFS_MP_generic_pre - gfdl_cloud_microphys - GFS_MP_generic_post - maximum_hourly_diagnostics - phys_tend - - - - - GFS_stochastics - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v15p2_couplednsst.xml b/ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml similarity index 93% rename from ccpp/suites/suite_FV3_GFS_v15p2_couplednsst.xml rename to ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml index 55f7e31f2..27bd85442 100644 --- a/ccpp/suites/suite_FV3_GFS_v15p2_couplednsst.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml @@ -1,6 +1,6 @@ - + @@ -48,8 +48,7 @@ sfc_nst_pre sfc_nst sfc_nst_post - lsm_noah - sfc_cice + noahmpdrv sfc_sice GFS_surface_loop_control_part2 @@ -60,11 +59,11 @@ sfc_diag_post GFS_surface_generic_post GFS_PBL_generic_pre - hedmf + satmedmfvdifq GFS_PBL_generic_post GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post + ugwpv1_gsldrag + ugwpv1_gsldrag_post GFS_GWD_generic_post GFS_suite_stateout_update ozphys_2015 diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90 index f2f6fd4e8..02ef0ebc8 100644 --- a/cpl/module_block_data.F90 +++ b/cpl/module_block_data.F90 @@ -8,6 +8,7 @@ module module_block_data implicit none interface block_data_copy + module procedure block_copy_1d_i4_to_2d_r8 module procedure block_copy_1d_to_2d_r8 module procedure block_copy_2d_to_2d_r8 module procedure block_copy_2d_to_3d_r8 @@ -50,6 +51,40 @@ module module_block_data ! -- copy: 1D to 2D + subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + integer, pointer :: source_ptr(:) + type(block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind_phys), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind_phys) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + factor = 1._kind_phys + if (present(scale_factor)) factor = scale_factor + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = factor * real(source_ptr(ix), kind=kind_phys) + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_1d_i4_to_2d_r8 + subroutine block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) ! -- arguments diff --git a/fv3_cap.F90 b/fv3_cap.F90 index eca8cf686..a256fbdf6 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -39,7 +39,7 @@ module fv3gfs_cap_mod wrttasks_per_group, n_group, & lead_wrttask, last_wrttask, & output_grid, output_file, & - nsout_io, iau_offset + nsout_io, iau_offset, lflname_fulltime ! use module_fcst_grid_comp, only: fcstSS => SetServices, & fcstGrid, numLevels, numSoilLayers, & @@ -140,7 +140,7 @@ subroutine SetServices(gcomp, rc) ! specializations required to support 'inline' run sequences call NUOPC_CompSpecialize(gcomp, specLabel=label_CheckImport, & - specPhaseLabel="phase1", specRoutine=NUOPC_NoOp, rc=rc) + specPhaseLabel="phase1", specRoutine=fv3_checkimport, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call NUOPC_CompSpecialize(gcomp, specLabel=label_TimestampExport, & @@ -181,7 +181,7 @@ subroutine InitializeAdvertise(gcomp, rc) integer(ESMF_KIND_I4) :: nhf, nrg integer,dimension(6) :: date, date_init - integer :: i, j, k, io_unit, urc, ierr + integer :: i, j, k, io_unit, urc, ierr, ist integer :: noutput_fh, nfh, nfh2 integer :: petcount integer :: num_output_file @@ -688,7 +688,7 @@ subroutine InitializeAdvertise(gcomp, rc) output_fh(i) = (i-1)*nfhout_hf + output_startfh enddo do i=1,nfh2 - output_fh(nfh+i) = nfhmax_hf + i*nfhout + output_fh(nfh+i) = nfhmax_hf + i*nfhout enddo endif elseif (nfhout > 0 ) then @@ -721,6 +721,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (noutput_fh > 0 ) then !--- use output_fh to sepcify output forecast time loutput_fh = .true. + lflname_fulltime = .false. if(noutput_fh == 1) then call ESMF_ConfigGetAttribute(CF,value=outputfh,label='output_fh:', rc=rc) if(outputfh == -1) loutput_fh = .false. @@ -745,6 +746,12 @@ subroutine InitializeAdvertise(gcomp, rc) endif do i=2,nfh output_fh(i) = (i-1)*outputfh2(1) + output_startfh + ! Except fh000, which is the first time output, if any other of the + ! output time is not integer hour, set lflname_fulltime to be true, so the + ! history file names will contain the full time stamp (HHH-MM-SS). + if(.not.lflname_fulltime) then + if(mod(nint(output_fh(i)*3600.),3600) /= 0) lflname_fulltime = .true. + endif enddo endif endif @@ -756,16 +763,35 @@ subroutine InitializeAdvertise(gcomp, rc) count=noutput_fh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if( output_startfh == 0) then - if(output_fh(1)==0) output_fh(1) = dt_atmos/3600. + ! If the output time in output_fh array contains first time stamp output, + ! check the rest of output time, otherwise, check all the output time. + ! If any of them is not integer hour, the history file names will + ! contain the full time stamp (HHH-MM-SS) + ist = 1 + if(output_fh(1)==0) then + output_fh(1) = dt_atmos/3600. + ist= 2 + endif + do i=ist,noutput_fh + if(.not.lflname_fulltime) then + if(mod(nint(output_fh(i)*3600.),3600) /= 0) lflname_fulltime = .true. + endif + enddo else do i=1,noutput_fh output_fh(i) = output_startfh + output_fh(i) + ! When output_startfh >0, check all the output time, if any of + ! them is not integer hour, set lflname_fulltime to be true. The + ! history file names will contain the full time stamp (HHH-MM-SS). + if(.not.lflname_fulltime) then + if(mod(nint(output_fh(i)*3600.),3600) /= 0) lflname_fulltime = .true. + endif enddo endif endif endif ! end loutput_fh endif - if(mype==0) print *,'output_fh=',output_fh(1:size(output_fh)) + if(mype==0) print *,'output_fh=',output_fh(1:size(output_fh)),'lflname_fulltime=',lflname_fulltime ! ! --- advertise Fields in importState and exportState ------------------- @@ -1186,7 +1212,7 @@ subroutine fv3_checkimport(gcomp, rc) type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime, invalidTime type(ESMF_State) :: importState - logical :: timeCheck1,timeCheck2 + logical :: isValid type(ESMF_Field),pointer :: fieldList(:) character(len=128) :: fldname character(esmf_maxstr) :: msgString @@ -1224,25 +1250,32 @@ subroutine fv3_checkimport(gcomp, rc) call ESMF_FieldGet(fieldList(n), name=fldname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - nf = queryImportFields(fldname) - timeCheck1 = NUOPC_IsAtTime(fieldList(n), invalidTime, rc=rc) + ! check if import field carries a valid timestamp + call NUOPC_GetTimestamp(fieldList(n), isValid=isValid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (timeCheck1) then - importFieldsValid(nf) = .false. -! if(mtype==0) print *,'in fv3_checkimport,',trim(fldname),' is set unvalid, nf=',nf,' at time',date(1:6) - else - timeCheck2 = NUOPC_IsAtTime(fieldList(n), currTime, rc=rc) + if (isValid) then + ! if timestamp is set, check if it is valid + isValid = .not.NUOPC_IsAtTime(fieldList(n), invalidTime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if - if (.not.timeCheck2) then - !TODO: introduce and use INCOMPATIBILITY return codes!!!! + ! store field status in internal array + nf = queryImportFields(fldname) + importFieldsValid(nf) = isValid + + if (isValid) then + ! check if field is current + isValid = NUOPC_IsAtTime(fieldList(n), currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (.not.isValid) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="NUOPC INCOMPATIBILITY DETECTED: Import Field not at current time", & + msg="NUOPC INCOMPATIBILITY DETECTED: Import Field " & + // trim(fldname) // " not at current time", & line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - endif + return + end if + end if write(msgString,'(A,2i4,l3)') "fv3_checkimport "//trim(fldname),n,nf,importFieldsValid(nf) call ESMF_LogWrite(msgString,ESMF_LOGMSG_INFO,rc=rc) enddo diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index adc3c9b03..7d5a84f4e 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -3,7 +3,7 @@ module FV3GFS_io_mod !----------------------------------------------------------------------- ! gfs_physics_driver_mod defines the GFS physics routines used by ! the GFDL FMS system to obtain tendencies and boundary fluxes due -! to the physical parameterizations and processes that drive +! to the physical parameterizations and processes that drive ! atmospheric time tendencies for use by other components, namely ! the atmospheric dynamical core. ! @@ -17,10 +17,13 @@ module FV3GFS_io_mod use block_control_mod, only: block_control_type use mpp_mod, only: mpp_error, mpp_pe, mpp_root_pe, & mpp_chksum, NOTE, FATAL - use fms_mod, only: file_exist, stdout - use fms_io_mod, only: restart_file_type, free_restart_type, & - register_restart_field, & - restore_state, save_restart + use fms_mod, only: stdout + use fms2_io_mod, only: FmsNetcdfDomainFile_t, unlimited, & + open_file, close_file, & + register_axis, register_restart_field, & + register_variable_attribute, register_field, & + read_restart, write_restart, write_data, & + get_global_io_domain_indices, variable_exists use mpp_domains_mod, only: domain1d, domain2d, domainUG use time_manager_mod, only: time_type use diag_manager_mod, only: register_diag_field, send_data @@ -42,7 +45,7 @@ module FV3GFS_io_mod !----------------------------------------------------------------------- implicit none private - + !--- public interfaces --- public FV3GFS_restart_read, FV3GFS_restart_write public FV3GFS_GFS_checksum @@ -58,10 +61,10 @@ module FV3GFS_io_mod character(len=32) :: fn_srf = 'sfc_data.nc' character(len=32) :: fn_phy = 'phy_data.nc' - !--- GFDL FMS netcdf restart data types - type(restart_file_type) :: Oro_restart, Sfc_restart, Phy_restart - type(restart_file_type) :: Oro_ls_restart, Oro_ss_restart - + !--- GFDL FMS netcdf restart data types defined in fms2_io + type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, Phy_restart + type(FmsNetcdfDomainFile_t) :: Oro_ls_restart, Oro_ss_restart + !--- GFDL FMS restart containers character(len=32), allocatable, dimension(:) :: oro_name2, sfc_name2, sfc_name3 real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_var2, sfc_var2, phy_var2, sfc_var3ice @@ -96,7 +99,7 @@ module FV3GFS_io_mod real, parameter:: drythresh = 1.e-4_r8, zero = 0.0_r8, one = 1.0_r8 real, parameter:: min_lake_orog = 200.0_r8 real(kind=kind_phys), parameter :: timin = 173.0_r8 ! minimum temperature allowed for snow/ice - + !--- miscellaneous other variables logical :: use_wrtgridcomp_output = .FALSE. logical :: module_is_initialized = .FALSE. @@ -119,8 +122,8 @@ subroutine FV3GFS_restart_read (GFS_Data, GFS_Restart, Atm_block, Model, fv_doma type(GFS_control_type), intent(inout) :: Model type(domain2d), intent(in) :: fv_domain logical, intent(in) :: warm_start - - !--- read in surface data from chgres + + !--- read in surface data from chgres call sfc_prop_restart_read (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, warm_start) !--- read in physics restart data @@ -138,10 +141,10 @@ subroutine FV3GFS_restart_write (GFS_Data, GFS_Restart, Atm_block, Model, fv_dom type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain character(len=32), optional, intent(in) :: timestamp - - !--- write surface data from chgres + + !--- write surface data from chgres call sfc_prop_restart_write (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, timestamp) - + !--- write physics restart data call phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) @@ -212,13 +215,13 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,14) = GFS_Data(nb)%Sfcprop%alnwf(ix) temp2d(i,j,15) = GFS_Data(nb)%Sfcprop%facsf(ix) temp2d(i,j,16) = GFS_Data(nb)%Sfcprop%facwf(ix) - temp2d(i,j,17) = GFS_Data(nb)%Sfcprop%slope(ix) + temp2d(i,j,17) = real(GFS_Data(nb)%Sfcprop%slope(ix), kind=kind_phys) temp2d(i,j,18) = GFS_Data(nb)%Sfcprop%shdmin(ix) temp2d(i,j,19) = GFS_Data(nb)%Sfcprop%shdmax(ix) temp2d(i,j,20) = GFS_Data(nb)%Sfcprop%tg3(ix) temp2d(i,j,21) = GFS_Data(nb)%Sfcprop%vfrac(ix) - temp2d(i,j,22) = GFS_Data(nb)%Sfcprop%vtype(ix) - temp2d(i,j,23) = GFS_Data(nb)%Sfcprop%stype(ix) + temp2d(i,j,22) = real(GFS_Data(nb)%Sfcprop%vtype(ix), kind=kind_phys) + temp2d(i,j,23) = real(GFS_Data(nb)%Sfcprop%stype(ix), kind=kind_phys) temp2d(i,j,24) = GFS_Data(nb)%Sfcprop%uustar(ix) temp2d(i,j,25) = GFS_Data(nb)%Sfcprop%oro(ix) temp2d(i,j,26) = GFS_Data(nb)%Sfcprop%oro_uf(ix) @@ -490,7 +493,7 @@ end subroutine FV3GFS_GFS_checksum ! calls: register_restart_field, restart_state, free_restart ! ! opens: oro_data.tile?.nc, sfc_data.tile?.nc -! +! !---------------------------------------------------------------------- subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_start) !--- interface variable definitions @@ -515,7 +518,13 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: vegtyp logical :: mand real(kind=kind_phys) :: rsnow, tem, tem1 - + !--- directory of the input files + character(5) :: indir='INPUT' + character(37) :: infile + !--- fms2_io file open logic + logical :: amiopen + logical :: is_lsoil + nvar_o2 = 19 nvar_oro_ls_ss = 10 nvar_s2o = 18 @@ -551,8 +560,14 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta npz = Atm_block%npz nx = (iec - isc + 1) ny = (jec - jsc + 1) - + !--- OROGRAPHY FILE + + !--- open file + infile=trim(indir)//'/'//trim(fn_oro) + amiopen=open_file(Oro_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file '//trim(infile) ) + if (.not. allocated(oro_name2)) then !--- allocate the various containers needed for orography data allocate(oro_name2(nvar_o2)) @@ -579,23 +594,29 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- variables below here are optional oro_name2(18) = 'lake_frac' ! lake fraction [0:1] oro_name2(19) = 'lake_depth' ! lake depth(m) + + !--- register axis + call register_axis( Oro_restart, "lon", 'X' ) + call register_axis( Oro_restart, "lat", 'Y' ) !--- register the 2D fields do num = 1,nvar_o2 - var2_p => oro_var2(:,:,num) - if (trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') then - id_restart = register_restart_field(Oro_restart, fn_oro, oro_name2(num), var2_p, domain=fv_domain, mandatory=.false.) - else - id_restart = register_restart_field(Oro_restart, fn_oro, oro_name2(num), var2_p, domain=fv_domain) - endif + var2_p => oro_var2(:,:,num) + if (trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') then + call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + else + call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/)) + endif enddo nullify(var2_p) - endif + endif - !--- read the orography restart/data - call mpp_error(NOTE,'reading topographic/orographic information from INPUT/oro_data.tile*.nc') - call restore_state(Oro_restart) + !--- read the orography restart/data + call mpp_error(NOTE,'reading topographic/orographic information from INPUT/oro_data.tile*.nc') + call read_restart(Oro_restart) + call close_file(Oro_restart) - !--- copy data into GFS containers + + !--- copy data into GFS containers !$omp parallel do default(shared) private(i, j, nb, ix) do nb = 1, Atm_block%nblks @@ -635,7 +656,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo enddo - + nvar_s2m = 44 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then nvar_s2m = nvar_s2m + 4 @@ -647,11 +668,21 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) - call free_restart_type(Oro_restart) - !--- Modify/read-in additional orographic static fields for GSL drag suite + !--- Modify/read-in additional orographic static fields for GSL drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then + + !--- open restart file + infile=trim(indir)//'/'//trim(fn_oro_ls) + amiopen=open_file(Oro_ls_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( .not.amiopen ) call mpp_error( FATAL, 'Error with opening file '//trim(infile) ) + + !--- open restart file + infile=trim(indir)//'/'//trim(fn_oro_ss) + amiopen=open_file(Oro_ss_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( .not.amiopen ) call mpp_error( FATAL, 'Error with opening file '//trim(infile) ) + if (.not. allocated(oro_ls_ss_name)) then !--- allocate the various containers needed for orography data allocate(oro_ls_ss_name(nvar_oro_ls_ss)) @@ -668,28 +699,34 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta oro_ls_ss_name(8) = 'ol2' oro_ls_ss_name(9) = 'ol3' oro_ls_ss_name(10) = 'ol4' - !--- register the 2D fields + + call register_axis(Oro_ls_restart, "lon", 'X') + call register_axis(Oro_ls_restart, "lat", 'Y') + call register_axis(Oro_ss_restart, "lon", 'X') + call register_axis(Oro_ss_restart, "lat", 'Y') + do num = 1,nvar_oro_ls_ss var2_p => oro_ls_var(:,:,num) - id_restart = register_restart_field(Oro_ls_restart, fn_oro_ls, & - oro_ls_ss_name(num), var2_p, domain=fv_domain) + call register_restart_field(Oro_ls_restart, oro_ls_ss_name(num), var2_p, dimensions=(/'lon','lat'/)) enddo nullify(var2_p) do num = 1,nvar_oro_ls_ss var2_p => oro_ss_var(:,:,num) - id_restart = register_restart_field(Oro_ss_restart, fn_oro_ss, & - oro_ls_ss_name(num), var2_p, domain=fv_domain) + call register_restart_field(Oro_ss_restart, oro_ls_ss_name(num), var2_p, dimensions=(/'lon','lat'/)) enddo nullify(var2_p) - endif + end if !--- read new GSL created orography restart/data call mpp_error(NOTE,'reading topographic/orographic information from & - &INPUT/oro_data_ls.tile*.nc') - call restore_state(Oro_ls_restart) + &INPUT/oro_data_ls.tile*.nc') + call read_restart(Oro_ls_restart) + call close_file(Oro_ls_restart) call mpp_error(NOTE,'reading topographic/orographic information from & - &INPUT/oro_data_ss.tile*.nc') - call restore_state(Oro_ss_restart) + &INPUT/oro_data_ss.tile*.nc') + call read_restart(Oro_ss_restart) + call close_file(Oro_ss_restart) + do nb = 1, Atm_block%nblks !--- 2D variables @@ -727,11 +764,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo enddo - call free_restart_type(Oro_ls_restart) - call free_restart_type(Oro_ss_restart) - endif + end if + + !--- SURFACE FILE + + !--- open file + infile=trim(indir)//'/'//trim(fn_srf) + amiopen=open_file(Sfc_restart, trim(infile), "read", domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( .not.amiopen ) call mpp_error(FATAL, 'Error opening file'//trim(infile)) - !--- SURFACE FILE if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) @@ -894,6 +935,36 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+19) = 'lai' endif + is_lsoil=.false. + if ( .not. warm_start ) then + if( variable_exists(Sfc_restart,"lsoil") ) then + is_lsoil=.true. + call register_axis(Sfc_restart, 'lon', 'X') + call register_axis(Sfc_restart, 'lat', 'Y') + call register_axis(Sfc_restart, 'lsoil', dimension_length=Model%lsoil) + else + call register_axis(Sfc_restart, 'xaxis_1', 'X') + call register_axis(Sfc_restart, 'yaxis_1', 'Y') + call register_axis(Sfc_restart, 'zaxis_1', dimension_length=4) + call register_axis(Sfc_restart, 'Time', 1) + end if + else + call register_axis(Sfc_restart, 'xaxis_1', 'X') + call register_axis(Sfc_restart, 'yaxis_1', 'Y') + call register_axis(Sfc_restart, 'zaxis_1', dimension_length=Model%kice) + + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil) + else if(Model%lsm == Model%lsm_ruc) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil_lsm) + end if + if(Model%lsm == Model%lsm_noahmp) then + call register_axis(Sfc_restart, 'zaxis_3', dimension_length=3) + call register_axis(Sfc_restart, 'zaxis_4', dimension_length=7) + end if + call register_axis(Sfc_restart, 'Time', unlimited) + end if + !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) @@ -901,47 +972,69 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & - .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdifvis_ice' & - .or. trim(sfc_name2(num)) == 'albdirnir_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & - .or. trim(sfc_name2(num)) == 'emis_lnd' ) then - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) + .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdirnir_ice' & + .or. trim(sfc_name2(num)) == 'albdifvis_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & + .or. trim(sfc_name2(num)) == 'emis_lnd' ) then + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/),& + &is_optional=.true.) + end if else - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) + if(is_lsoil) then + call register_restart_field(Sfc_restart,sfc_name2(num),var2_p, dimensions=(/'lat','lon'/)) + else + call register_restart_field(Sfc_restart,sfc_name2(num),var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/)) + end if endif - enddo - + enddo if (Model%nstf_name(1) > 0) then - mand = .false. - if (Model%nstf_name(2) == 0) mand = .true. - do num = nvar_s2m+1,nvar_s2m+nvar_s2o - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo + mand = .false. + if (Model%nstf_name(2) == 0) mand = .true. + do num = nvar_s2m+1,nvar_s2m+nvar_s2o + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.not.mand) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/), & + &is_optional=.not.mand) + endif + enddo endif if (Model%lsm == Model%lsm_ruc) then ! nvar_s2mp = 0 - do num = nvar_s2m+nvar_s2o+1, nvar_s2m+nvar_s2o+nvar_s2r - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) - enddo + do num = nvar_s2m+nvar_s2o+1, nvar_s2m+nvar_s2o+nvar_s2r + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/) ) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/) ) + end if + enddo endif ! mp/ruc + ! Noah MP register only necessary only lsm = 2, not necessary has values if (nvar_s2mp > 0) then - mand = .false. - do num = nvar_s2m+nvar_s2o+1,nvar_s2m+nvar_s2o+nvar_s2mp - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo + mand = .false. + do num = nvar_s2m+nvar_s2o+1,nvar_s2m+nvar_s2o+nvar_s2mp + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.not.mand) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/), & + &is_optional=.not.mand) + end if + enddo endif ! noahmp - nullify(var2_p) - endif ! if not allocated + endif ! if not allocated + - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' @@ -966,29 +1059,43 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- register the 3D fields sfc_name3(0) = 'tiice' var3_p => sfc_var3ice(:,:,:) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain, mandatory=.false.) - + call register_restart_field(Sfc_restart, sfc_name3(0), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_1', 'Time '/),& + &is_optional=.true.) + do num = 1,nvar_s3 - var3_p => sfc_var3(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p, domain=fv_domain) + var3_p => sfc_var3(:,:,:,num) + if ( warm_start ) then + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'lsoil ', 'Time '/),& + &is_optional=.true.) + else + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'lat ', 'lon ', 'lsoil'/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& + &is_optional=.true.) + end if + end if enddo + if (Model%lsm == Model%lsm_noahmp) then - mand = .false. - do num = nvar_s3+1,nvar_s3+3 - var3_p1 => sfc_var3sn(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p1, domain=fv_domain,mandatory=mand) - enddo + mand = .false. + do num = nvar_s3+1,nvar_s3+3 + var3_p1 => sfc_var3sn(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p1, dimensions=(/'xaxis_1', 'yaxis_1','zaxis_2', 'Time '/),& + &is_optional=.not.mand) + enddo - var3_p2 => sfc_var3eq(:,:,:,7) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(7), var3_p2, domain=fv_domain,mandatory=mand) + var3_p2 => sfc_var3eq(:,:,:,7) + call register_restart_field(Sfc_restart, sfc_name3(7), var3_p2, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/),& + &is_optional=.not.mand) - var3_p3 => sfc_var3zn(:,:,:,8) - id_restart = register_restart_fIeld(Sfc_restart, fn_srf, sfc_name3(8), var3_p3, domain=fv_domain,mandatory=mand) - - nullify(var3_p1) - nullify(var3_p2) - nullify(var3_p3) + var3_p3 => sfc_var3zn(:,:,:,8) + call register_restart_field(Sfc_restart, sfc_name3(8), var3_p3, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_4', 'Time '/),& + &is_optional=.not.mand) + nullify(var3_p1) + nullify(var3_p2) + nullify(var3_p3) endif !mp nullify(var3_p) @@ -1002,7 +1109,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- read the surface restart/data call mpp_error(NOTE,'reading surface properties data from INPUT/sfc_data.tile*.nc') - call restore_state(Sfc_restart) + call read_restart(Sfc_restart) + call close_file(Sfc_restart) ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,35)),maxval(sfc_var2(:,:,35)),' sfc_name2=',sfc_name2(35) ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,18)),maxval(sfc_var2(:,:,18)) @@ -1034,8 +1142,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%f10m(ix) = sfc_var2(i,j,14) !--- f10m Sfcprop(nb)%t2m(ix) = sfc_var2(i,j,15) !--- t2m Sfcprop(nb)%q2m(ix) = sfc_var2(i,j,16) !--- q2m - Sfcprop(nb)%vtype(ix) = sfc_var2(i,j,17) !--- vtype - Sfcprop(nb)%stype(ix) = sfc_var2(i,j,18) !--- stype + Sfcprop(nb)%vtype(ix) = int(sfc_var2(i,j,17)) !--- vtype + Sfcprop(nb)%stype(ix) = int(sfc_var2(i,j,18)) !--- stype Sfcprop(nb)%uustar(ix) = sfc_var2(i,j,19) !--- uustar Sfcprop(nb)%ffmm(ix) = sfc_var2(i,j,20) !--- ffmm Sfcprop(nb)%ffhh(ix) = sfc_var2(i,j,21) !--- ffhh @@ -1047,7 +1155,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%snowd(ix) = sfc_var2(i,j,27) !--- snowd (snwdph in the file) Sfcprop(nb)%shdmin(ix) = sfc_var2(i,j,28) !--- shdmin Sfcprop(nb)%shdmax(ix) = sfc_var2(i,j,29) !--- shdmax - Sfcprop(nb)%slope(ix) = sfc_var2(i,j,30) !--- slope + Sfcprop(nb)%slope(ix) = int(sfc_var2(i,j,30)) !--- slope Sfcprop(nb)%snoalb(ix) = sfc_var2(i,j,31) !--- snoalb Sfcprop(nb)%sncovr(ix) = sfc_var2(i,j,32) !--- sncovr Sfcprop(nb)%snodl(ix) = sfc_var2(i,j,33) !--- snodl (snowd on land portion of a cell) @@ -1075,7 +1183,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif - if (nint(Sfcprop(nb)%stype(ix)) == 14 .or. int(Sfcprop(nb)%stype(ix)+0.5) <= 0) then + if (Sfcprop(nb)%stype(ix) == 14 .or. Sfcprop(nb)%stype(ix) <= 0) then Sfcprop(nb)%landfrac(ix) = zero Sfcprop(nb)%stype(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then @@ -1086,7 +1194,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%frac_grid) then if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) - if (Sfcprop(nb)%slmsk(ix) == 1 .and. nint(Sfcprop(nb)%stype(ix)) == 14) & + if (Sfcprop(nb)%slmsk(ix) == 1 .and. Sfcprop(nb)%stype(ix) == 14) & Sfcprop(nb)%slmsk(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell @@ -1137,7 +1245,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else Sfcprop(nb)%slmsk(ix) = nint(Sfcprop(nb)%landfrac(ix)) - if (Sfcprop(nb)%stype(ix) <= 0 .or. nint(Sfcprop(nb)%stype(ix)) == 14) & + if (Sfcprop(nb)%stype(ix) <= 0 .or. Sfcprop(nb)%stype(ix) == 14) & Sfcprop(nb)%slmsk(ix) = zero if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then Sfcprop(nb)%oceanfrac(ix) = one @@ -1152,7 +1260,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif else if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & - .and. nint(Sfcprop(nb)%stype(ix)) /= 14) then + .and. Sfcprop(nb)%stype(ix) /= 14) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero @@ -1296,7 +1404,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%snicexy(ix,lsoil) = sfc_var3sn(i,j,lsoil,4) Sfcprop(nb)%snliqxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,5) Sfcprop(nb)%tsnoxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,6) - enddo + enddo do lsoil = 1, 4 Sfcprop(nb)%smoiseq(ix,lsoil) = sfc_var3eq(i,j,lsoil,7) @@ -1304,7 +1412,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta do lsoil = -2, 4 Sfcprop(nb)%zsnsoxy(ix,lsoil) = sfc_var3zn(i,j,lsoil,8) - enddo + enddo endif else if (Model%lsm == Model%lsm_ruc) then @@ -1512,6 +1620,14 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p1 => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p3 => NULL() + !--- directory of the input files + character(7) :: indir='RESTART' + character(72) :: infile + !--- fms2_io file open logic + logical :: amiopen + !--- variables used for fms2_io register axis + integer :: is, ie + integer, allocatable, dimension(:) :: buffer nvar2m = 44 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then @@ -1557,11 +1673,83 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta deallocate(sfc_name3) deallocate(sfc_var2) deallocate(sfc_var3) - call free_restart_type(Sfc_restart) - end if + end if end if end if + !--- set filename + infile=trim(indir)//'/'//trim(fn_srf) + if( present(timestamp) ) infile=trim(indir)//'/'//trim(timestamp)//'.'//trim(fn_srf) + + !--- register axis + amiopen=open_file(Sfc_restart, trim(infile), 'overwrite', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( amiopen ) then + call register_axis(Sfc_restart, 'xaxis_1', 'X') + call register_field(Sfc_restart, 'xaxis_1', 'double', (/'xaxis_1'/)) + call register_variable_attribute(Sfc_restart, 'xaxis_1', 'cartesian_axis', 'X', str_len=1) + call get_global_io_domain_indices(Sfc_restart, 'xaxis_1', is, ie, indices=buffer) + call write_data(Sfc_restart, "xaxis_1", buffer) + deallocate(buffer) + + call register_axis(Sfc_restart, 'yaxis_1', 'Y') + call register_field(Sfc_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_variable_attribute(Sfc_restart, 'yaxis_1', 'cartesian_axis', 'Y', str_len=1) + call get_global_io_domain_indices(Sfc_restart, 'yaxis_1', is, ie, indices=buffer) + call write_data(Sfc_restart, "yaxis_1", buffer) + deallocate(buffer) + + call register_axis(Sfc_restart, 'zaxis_1', dimension_length=Model%kice) + call register_field(Sfc_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_1', 'cartesian_axis', 'Z', str_len=1) + allocate( buffer(Model%kice) ) + do i=1, Model%kice + buffer(i) = i + end do + call write_data(Sfc_restart, 'zaxis_1', buffer) + deallocate(buffer) + + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil) + call register_field(Sfc_restart, 'zaxis_2', 'double', (/'zaxis_2'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_2', 'cartesian_axis', 'Z', str_len=1) + allocate( buffer(Model%lsoil) ) + do i=1, Model%lsoil + buffer(i)=i + end do + call write_data(Sfc_restart, 'zaxis_2', buffer) + deallocate(buffer) + endif + + if(Model%lsm == Model%lsm_noahmp) then + call register_axis(Sfc_restart, 'zaxis_3', dimension_length=3) + call register_field(Sfc_restart, 'zaxis_3', 'double', (/'zaxis_3'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_3', 'cartesian_axis', 'Z', str_len=1) + allocate(buffer(3)) + do i=1, 3 + buffer(i) = i + end do + call write_data(Sfc_restart, 'zaxis_3', buffer) + deallocate(buffer) + + call register_axis(Sfc_restart, 'zaxis_4', dimension_length=7) + call register_field(Sfc_restart, 'zaxis_4', 'double', (/'zaxis_4'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_4', 'cartesian_axis' ,'Z', str_len=1) + allocate(buffer(7)) + do i=1, 7 + buffer(i)=i + end do + call write_data(Sfc_restart, 'zaxis_4', buffer) + deallocate(buffer) + end if + call register_axis(Sfc_restart, 'Time', unlimited) + call register_field(Sfc_restart, 'Time', 'double', (/'Time'/)) + call register_variable_attribute(Sfc_restart, 'Time', 'cartesian_axis', 'T', str_len=1) + call write_data( Sfc_restart, 'Time', 1) + else + call mpp_error(FATAL, 'Error in opening file'//trim(infile) ) + end if + + if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) @@ -1716,100 +1904,112 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+46) = 'deeprechxy' sfc_name2(nvar2m+47) = 'rechxy' endif + end if - !--- register the 2D fields - do num = 1,nvar2m - var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr' .or. trim(sfc_name2(num)) == 'tsfcl' .or.trim(sfc_name2(num)) == 'zorll' & - .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & - .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & - .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & - .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdifvis_ice' & - .or. trim(sfc_name2(num)) == 'albdirnir_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & -! .or. trim(sfc_name2(num)) == 'sfalb_ice' & - .or. trim(sfc_name2(num)) == 'emis_lnd' ) then - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) - else - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) - endif - enddo - if (Model%nstf_name(1) > 0) then - mand = .false. - if (Model%nstf_name(2) ==0) mand = .true. - do num = nvar2m+1,nvar2m+nvar2o - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo + !--- register the 2D fields + do num = 1,nvar2m + var2_p => sfc_var2(:,:,num) + if (trim(sfc_name2(num)) == 'sncovr' .or. trim(sfc_name2(num)) == 'tsfcl' .or.trim(sfc_name2(num)) == 'zorll' & + .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & + .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & + .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & + .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdirnir_ice' & + .or. trim(sfc_name2(num)) == 'albdifvis_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & + .or. trim(sfc_name2(num)) == 'emis_lnd' ) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/) ) endif + enddo + if (Model%nstf_name(1) > 0) then + mand = .false. + if (Model%nstf_name(2) ==0) mand = .true. + do num = nvar2m+1,nvar2m+nvar2o + var2_p => sfc_var2(:,:,num) + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/),& + &is_optional=.not.mand) + enddo + endif - if (Model%lsm == Model%lsm_ruc) then ! nvar2mp =0 - do num = nvar2m+nvar2o+1, nvar2m+nvar2o+nvar2r - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) - enddo - else if (Model%lsm == Model%lsm_noahmp) then ! nvar2r =0 - mand = .true. ! actually should be true since it is after cold start - do num = nvar2m+nvar2o+1,nvar2m+nvar2o+nvar2mp - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo - endif - nullify(var2_p) + if (Model%lsm == Model%lsm_ruc) then ! nvar2mp =0 + do num = nvar2m+nvar2o+1, nvar2m+nvar2o+nvar2r + var2_p => sfc_var2(:,:,num) + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/)) + enddo + else if (Model%lsm == Model%lsm_noahmp) then ! nvar2r =0 + mand = .true. ! actually should be true since it is after cold start + do num = nvar2m+nvar2o+1,nvar2m+nvar2o+nvar2mp + var2_p => sfc_var2(:,:,num) + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/),& + &is_optional=.not.mand) + enddo + endif + nullify(var2_p) - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then - !--- names of the 3D variables to save - sfc_name3(1) = 'stc' - sfc_name3(2) = 'smc' - sfc_name3(3) = 'slc' - if (Model%lsm == Model%lsm_noahmp) then - sfc_name3(4) = 'snicexy' - sfc_name3(5) = 'snliqxy' - sfc_name3(6) = 'tsnoxy' - sfc_name3(7) = 'smoiseq' - sfc_name3(8) = 'zsnsoxy' - endif - else if (Model%lsm == Model%lsm_ruc) then - !--- names of the 3D variables to save - sfc_name3(1) = 'tslb' - sfc_name3(2) = 'smois' - sfc_name3(3) = 'sh2o' - sfc_name3(4) = 'smfr' - sfc_name3(5) = 'flfr' - end if + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then + !--- names of the 3D variables to save + sfc_name3(1) = 'stc' + sfc_name3(2) = 'smc' + sfc_name3(3) = 'slc' + if (Model%lsm == Model%lsm_noahmp) then + sfc_name3(4) = 'snicexy' + sfc_name3(5) = 'snliqxy' + sfc_name3(6) = 'tsnoxy' + sfc_name3(7) = 'smoiseq' + sfc_name3(8) = 'zsnsoxy' + endif + else if (Model%lsm == Model%lsm_ruc) then + !--- names of the 3D variables to save + sfc_name3(1) = 'tslb' + sfc_name3(2) = 'smois' + sfc_name3(3) = 'sh2o' + sfc_name3(4) = 'smfr' + sfc_name3(5) = 'flfr' + end if - !--- register the 3D fields -! if (Model%frac_grid) then - sfc_name3(0) = 'tiice' - var3_p => sfc_var3ice(:,:,:) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain) -! endif + !--- register the 3D fields + ! if (Model%frac_grid) then + sfc_name3(0) = 'tiice' + var3_p => sfc_var3ice(:,:,:) + call register_restart_field(Sfc_restart, sfc_name3(0), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_1', 'Time '/)) + ! endif + if(Model%lsm == Model%lsm_ruc) then do num = 1,nvar3 - var3_p => sfc_var3(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p, domain=fv_domain) + var3_p => sfc_var3(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_1', 'Time '/)) enddo nullify(var3_p) + else + do num = 1,nvar3 + var3_p => sfc_var3(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_2', 'Time '/)) + enddo + nullify(var3_p) + endif - if (Model%lsm == Model%lsm_noahmp) then - mand = .true. - do num = nvar3+1,nvar3+3 - var3_p1 => sfc_var3sn(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p1, domain=fv_domain,mandatory=mand) - enddo - - var3_p2 => sfc_var3eq(:,:,:,7) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(7), var3_p2, domain=fv_domain,mandatory=mand) - - var3_p3 => sfc_var3zn(:,:,:,8) - id_restart = register_restart_fIeld(Sfc_restart, fn_srf, sfc_name3(8), var3_p3, domain=fv_domain,mandatory=mand) + if (Model%lsm == Model%lsm_noahmp) then + mand = .true. + do num = nvar3+1,nvar3+3 + var3_p1 => sfc_var3sn(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p1, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/),& + &is_optional=.not.mand) + enddo - nullify(var3_p1) - nullify(var3_p2) - nullify(var3_p3) - endif ! lsm = lsm_noahmp - endif + var3_p2 => sfc_var3eq(:,:,:,7) + call register_restart_field(Sfc_restart, sfc_name3(7), var3_p2, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_2', 'Time '/),& + &is_optional=.not.mand) + + var3_p3 => sfc_var3zn(:,:,:,8) + call register_restart_field(Sfc_restart, sfc_name3(8), var3_p3, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_4', 'Time '/),& + &is_optional=.not.mand) + + nullify(var3_p1) + nullify(var3_p2) + nullify(var3_p3) + endif ! lsm = lsm_noahmp !$omp parallel do default(shared) private(i, j, nb, ix, lsoil) @@ -1834,8 +2034,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,14) = Sfcprop(nb)%f10m(ix) !--- f10m sfc_var2(i,j,15) = Sfcprop(nb)%t2m(ix) !--- t2m sfc_var2(i,j,16) = Sfcprop(nb)%q2m(ix) !--- q2m - sfc_var2(i,j,17) = Sfcprop(nb)%vtype(ix) !--- vtype - sfc_var2(i,j,18) = Sfcprop(nb)%stype(ix) !--- stype + sfc_var2(i,j,17) = real(Sfcprop(nb)%vtype(ix), kind=kind_phys) !--- vtype + sfc_var2(i,j,18) = real(Sfcprop(nb)%stype(ix), kind=kind_phys) !--- stype sfc_var2(i,j,19) = Sfcprop(nb)%uustar(ix)!--- uustar sfc_var2(i,j,20) = Sfcprop(nb)%ffmm(ix) !--- ffmm sfc_var2(i,j,21) = Sfcprop(nb)%ffhh(ix) !--- ffhh @@ -1847,7 +2047,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,27) = Sfcprop(nb)%snowd(ix) !--- snowd (snwdph in the file) sfc_var2(i,j,28) = Sfcprop(nb)%shdmin(ix)!--- shdmin sfc_var2(i,j,29) = Sfcprop(nb)%shdmax(ix)!--- shdmax - sfc_var2(i,j,30) = Sfcprop(nb)%slope(ix) !--- slope + sfc_var2(i,j,30) = real(Sfcprop(nb)%slope(ix), kind=kind_phys) !--- slope sfc_var2(i,j,31) = Sfcprop(nb)%snoalb(ix)!--- snoalb sfc_var2(i,j,32) = Sfcprop(nb)%sncovr(ix) !--- sncovr sfc_var2(i,j,33) = Sfcprop(nb)%snodl(ix) !--- snodl (snowd on land) @@ -1993,7 +2193,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta enddo enddo - call save_restart(Sfc_restart, timestamp) + call write_restart(Sfc_restart) + call close_file(Sfc_restart) end subroutine sfc_prop_restart_write @@ -2009,7 +2210,7 @@ end subroutine sfc_prop_restart_write ! calls: register_restart_field, restart_state, free_restart ! ! opens: phys_data.tile?.nc -! +! !---------------------------------------------------------------------- subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) !--- interface variable definitions @@ -2025,7 +2226,9 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) character(len=64) :: fname real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() - + !--- directory of the input files + character(5) :: indir='INPUT' + logical :: amiopen isc = Atm_block%isc iec = Atm_block%iec @@ -2039,7 +2242,20 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) nvar3d = GFS_Restart%num3d fdiag = GFS_Restart%fdiag ldiag = GFS_Restart%ldiag - + + !--- open restart file and register axes + fname = trim(indir)//'/'//trim(fn_phy) + amiopen=open_file(Phy_restart, trim(fname), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( amiopen ) then + call register_axis(Phy_restart, 'xaxis_1', 'X') + call register_axis(Phy_restart, 'yaxis_1', 'Y') + call register_axis(Phy_restart, 'zaxis_1', npz) + call register_axis(Phy_restart, 'Time', unlimited) + else + call mpp_error(NOTE,'No physics restarts - cold starting physical parameterizations') + return + endif + !--- register the restart fields if (.not. allocated(phy_var2)) then allocate (phy_var2(nx,ny,nvar2d)) @@ -2049,28 +2265,22 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) do num = 1,nvar2d var2_p => phy_var2(:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_Restart%name2d(num)), & - var2_p, domain=fv_domain, mandatory=.false.) + call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& + &is_optional=.true.) enddo do num = 1,nvar3d var3_p => phy_var3(:,:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_restart%name3d(num)), & - var3_p, domain=fv_domain, mandatory=.false.) + call register_restart_field(Phy_restart, trim(GFS_restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/), is_optional=.true.) enddo nullify(var2_p) nullify(var3_p) endif - fname = 'INPUT/'//trim(fn_phy) - if (file_exist(fname)) then - !--- read the surface restart/data - call mpp_error(NOTE,'reading physics restart data from INPUT/phy_data.tile*.nc') - call restore_state(Phy_restart) - else - call mpp_error(NOTE,'No physics restarts - cold starting physical parameterizations') - return - endif - + !--- read the surface restart/data + call mpp_error(NOTE,'reading physics restart data from INPUT/phy_data.tile*.nc') + call read_restart(Phy_restart) + call close_file(Phy_restart) + !--- place the data into the block GFS containers !--- phy_var* variables !$omp parallel do default(shared) private(i, j, nb, ix) @@ -2093,7 +2303,7 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) j = Atm_block%index(nb)%jj(ix) - jsc + 1 GFS_Restart%data(nb,num)%var2p(ix) = zero enddo - enddo + enddo enddo endif do num = 1,nvar3d @@ -2136,7 +2346,12 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta integer :: nvar2d, nvar3d real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() - + !--- used for axis data for fms2_io + integer :: is, ie + integer, allocatable, dimension(:) :: buffer + character(7) :: indir='RESTART' + character(72) :: infile + logical :: amiopen isc = Atm_block%isc iec = Atm_block%iec @@ -2148,32 +2363,70 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta nvar2d = GFS_Restart%num2d nvar3d = GFS_Restart%num3d - !--- register the restart fields + !--- set file name + infile=trim(indir)//'/'//trim(fn_phy) + if( present(timestamp) ) infile=trim(indir)//'/'//trim(timestamp)//'.'//trim(fn_phy) + !--- register axis + amiopen=open_file(Phy_restart, trim(infile), 'overwrite', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( amiopen ) then + call register_axis(Phy_restart, 'xaxis_1', 'X') + call register_field(Phy_restart, 'xaxis_1', 'double', (/'xaxis_1'/)) + call register_variable_attribute(Phy_restart, 'xaxis_1', 'cartesian_axis', 'X', str_len=1) + call get_global_io_domain_indices(Phy_restart, 'xaxis_1', is, ie, indices=buffer) + call write_data(Phy_restart, "xaxis_1", buffer) + deallocate(buffer) + + call register_axis(Phy_restart, 'yaxis_1', 'Y') + call register_field(Phy_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_variable_attribute(Phy_restart, 'yaxis_1', 'cartesian_axis', 'Y', str_len=1) + call get_global_io_domain_indices(Phy_restart, 'yaxis_1', is, ie, indices=buffer) + call write_data(Phy_restart, "yaxis_1", buffer) + deallocate(buffer) + + call register_axis(Phy_restart, 'zaxis_1', npz) + call register_field(Phy_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_variable_attribute(Phy_restart, 'zaxis_1', 'cartesian_axis', 'Z', str_len=1) + allocate( buffer(npz) ) + do i=1, npz + buffer(i)=i + end do + call write_data(Phy_restart, "zaxis_1", buffer) + deallocate(buffer) + + call register_axis(Phy_restart, 'Time', unlimited) + call register_field(Phy_restart, 'Time', 'double', (/'Time'/)) + call register_variable_attribute(Phy_restart, 'Time', 'cartesian_axis', 'T', str_len=1) + call write_data(Phy_restart, "Time", 1) + else + call mpp_error(FATAL, 'Error opening file '//trim(infile)) + end if + + !--- register the restart fields if (.not. allocated(phy_var2)) then allocate (phy_var2(nx,ny,nvar2d)) allocate (phy_var3(nx,ny,npz,nvar3d)) phy_var2 = zero phy_var3 = zero - - do num = 1,nvar2d - var2_p => phy_var2(:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_Restart%name2d(num)), & - var2_p, domain=fv_domain, mandatory=.false.) - enddo - do num = 1,nvar3d - var3_p => phy_var3(:,:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_restart%name3d(num)), & - var3_p, domain=fv_domain, mandatory=.false.) - enddo - nullify(var2_p) - nullify(var3_p) endif + do num = 1,nvar2d + var2_p => phy_var2(:,:,num) + call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& + &is_optional=.true.) + enddo + do num = 1,nvar3d + var3_p => phy_var3(:,:,:,num) + call register_restart_field(Phy_restart, trim(GFS_Restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& + &is_optional=.true.) + enddo + nullify(var2_p) + nullify(var3_p) + !--- 2D variables !$omp parallel do default(shared) private(i, j, num, nb, ix) do num = 1,nvar2d do nb = 1,Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) + do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 phy_var2(i,j,num) = GFS_Restart%data(nb,num)%var2p(ix) @@ -2185,7 +2438,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta do num = 1,nvar3d do nb = 1,Atm_block%nblks do k=1,npz - do ix = 1, Atm_block%blksz(nb) + do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 phy_var3(i,j,k,num) = GFS_Restart%data(nb,num)%var3p(ix,k) @@ -2194,7 +2447,8 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta enddo enddo - call save_restart(Phy_restart, timestamp) + call write_restart(Phy_restart) + call close_file(Phy_restart) end subroutine phys_restart_write @@ -2321,7 +2575,7 @@ end subroutine fv3gfs_diag_register !------------------------------------------------------------------------- !--- gfs_diag_output --- !------------------------------------------------------------------------- -! routine to transfer the diagnostic data to the gfdl fms diagnostic +! routine to transfer the diagnostic data to the gfdl fms diagnostic ! manager for eventual output to the history files. ! ! calls: send_data @@ -2384,101 +2638,122 @@ subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & endif endif if (diag(idx)%axes == 2) then - if (trim(diag(idx)%mask) == 'positive_flux') then - !--- albedos are actually a ratio of two radiation surface properties - var2(1:nx,1:ny) = 0._kind_phys - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix) > 0._kind_phys) & - var2(i,j) = max(0._kind_phys,min(1._kind_phys,Diag(idx)%data(nb)%var2(ix)/Diag(idx)%data(nb)%var21(ix)))*lcnvfac + ! Integer data + int_or_real: if (associated(Diag(idx)%data(1)%int2)) then + if (trim(Diag(idx)%intpl_method) == 'nearest_stod') then + var2(1:nx,1:ny) = 0._kind_phys + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + var2(i,j) = real(Diag(idx)%data(nb)%int2(ix), kind=kind_phys) + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'land_ice_only') then - !--- need to "mask" gflux to output valid data over land/ice only - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix) /= 0) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + call store_data(Diag(idx)%id, var2, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) + else + call mpp_error(FATAL, 'Interpolation method ' // trim(Diag(idx)%intpl_method) // ' for integer variable ' & + // trim(Diag(idx)%name) // ' not supported.') + endif + ! Real data + else ! int_or_real + if (trim(diag(idx)%mask) == 'positive_flux') then + !--- albedos are actually a ratio of two radiation surface properties + var2(1:nx,1:ny) = 0._kind_phys + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix) > 0._kind_phys) & + var2(i,j) = max(0._kind_phys,min(1._kind_phys,Diag(idx)%data(nb)%var2(ix)/Diag(idx)%data(nb)%var21(ix)))*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'land_only') then - !--- need to "mask" soilm to have value only over land - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix) == 1) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + elseif (trim(Diag(idx)%mask) == 'land_ice_only') then + !--- need to "mask" gflux to output valid data over land/ice only + var2(1:nx,1:ny) = missing_value + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix) /= 0) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'cldmask') then - !--- need to "mask" soilm to have value only over land - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix)*100. > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + elseif (trim(Diag(idx)%mask) == 'land_only') then + !--- need to "mask" soilm to have value only over land + var2(1:nx,1:ny) = missing_value + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix) == 1) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'cldmask_ratio') then - !--- need to "mask" soilm to have value only over land - var2(1:nx,1:ny) = missing_value - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - if (Diag(idx)%data(nb)%var21(ix)*100.*lcnvfac > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)/ & - Diag(idx)%data(nb)%var21(ix) + elseif (trim(Diag(idx)%mask) == 'cldmask') then + !--- need to "mask" soilm to have value only over land + var2(1:nx,1:ny) = missing_value + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + if (Diag(idx)%data(nb)%var21(ix)*100. > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac + enddo enddo - enddo - elseif (trim(Diag(idx)%mask) == 'pseudo_ps') then - if ( use_wrtgridcomp_output ) then + elseif (trim(Diag(idx)%mask) == 'cldmask_ratio') then + !--- need to "mask" soilm to have value only over land + var2(1:nx,1:ny) = missing_value do j = 1, ny jj = j + jsc -1 do i = 1, nx ii = i + isc -1 nb = Atm_block%blkno(ii,jj) ix = Atm_block%ixp(ii,jj) - var2(i,j) = (Diag(idx)%data(nb)%var2(ix)/stndrd_atmos_ps)**(rdgas/grav*stndrd_atmos_lapse) + if (Diag(idx)%data(nb)%var21(ix)*100.*lcnvfac > 0.5) var2(i,j) = Diag(idx)%data(nb)%var2(ix)/ & + Diag(idx)%data(nb)%var21(ix) enddo enddo - else + elseif (trim(Diag(idx)%mask) == 'pseudo_ps') then + if ( use_wrtgridcomp_output ) then + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + var2(i,j) = (Diag(idx)%data(nb)%var2(ix)/stndrd_atmos_ps)**(rdgas/grav*stndrd_atmos_lapse) + enddo + enddo + else + do j = 1, ny + jj = j + jsc -1 + do i = 1, nx + ii = i + isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + var2(i,j) = Diag(idx)%data(nb)%var2(ix) + enddo + enddo + endif + elseif (trim(Diag(idx)%mask) == '') then do j = 1, ny jj = j + jsc -1 do i = 1, nx ii = i + isc -1 nb = Atm_block%blkno(ii,jj) ix = Atm_block%ixp(ii,jj) - var2(i,j) = Diag(idx)%data(nb)%var2(ix) + var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac enddo enddo endif - elseif (trim(Diag(idx)%mask) == '') then - do j = 1, ny - jj = j + jsc -1 - do i = 1, nx - ii = i + isc -1 - nb = Atm_block%blkno(ii,jj) - ix = Atm_block%ixp(ii,jj) - var2(i,j) = Diag(idx)%data(nb)%var2(ix)*lcnvfac - enddo - enddo - endif + endif int_or_real ! used=send_data(Diag(idx)%id, var2, Time) ! print *,'in phys, after store_data, idx=',idx,' var=', trim(Diag(idx)%name) call store_data(Diag(idx)%id, var2, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) diff --git a/io/module_fv3_io_def.F90 b/io/module_fv3_io_def.F90 index 253d922fe..65d2b926b 100644 --- a/io/module_fv3_io_def.F90 +++ b/io/module_fv3_io_def.F90 @@ -20,6 +20,7 @@ module module_fv3_io_def integer :: ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d integer :: nbdlphys integer :: nsout_io, iau_offset, ideflate, nbits + logical :: lflname_fulltime real :: cen_lon, cen_lat, lon1, lat1, lon2, lat2, dlon, dlat real :: stdlat1, stdlat2, dx, dy character(len=esmf_maxstr),dimension(:),allocatable :: filename_base diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index f3d366ff8..e7469813f 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -39,7 +39,7 @@ module module_wrt_grid_comp cen_lon, cen_lat, & lon1, lat1, lon2, lat2, dlon, dlat, & stdlat1, stdlat2, dx, dy, iau_offset, & - ideflate + ideflate, lflname_fulltime use module_write_netcdf, only : write_netcdf use physcons, only : pi => con_pi use inline_post, only : inline_post_run, inline_post_getattr @@ -1408,11 +1408,10 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) nf_minutes = int((nf_seconds-nf_hours*3600.)/60.) nseconds = int(nf_seconds-nf_hours*3600.-nf_minutes*60.) -! if (nf_seconds-nf_hours*3600 > 0 .and. nsout > 0) then - if (nsout > 0) then + if (nsout > 0 .or. lflname_fulltime) then ndig = max(log10(nf_hours+0.5)+1., 3.) write(cform, '("(I",I1,".",I1,",A1,I2.2,A1,I2.2)")') ndig, ndig - write(cfhour, cform) nf_hours,':',nf_minutes,':',nseconds + write(cfhour, cform) nf_hours,'-',nf_minutes,'-',nseconds else ndig = max(log10(nf_hours+0.5)+1., 3.) write(cform, '("(I",I1,".",I1,")")') ndig, ndig diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 9ff27b1a6..a6e69b13a 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -24,7 +24,7 @@ module module_fcst_grid_comp use esmf use time_manager_mod, only: time_type, set_calendar_type, set_time, & - set_date, days_in_month, month_name, & + set_date, month_name, & operator(+), operator(-), operator (<), & operator (>), operator (/=), operator (/), & operator (==), operator (*), & @@ -43,22 +43,20 @@ module module_fcst_grid_comp addLsmask2grid use constants_mod, only: constants_init - use fms_mod, only: open_namelist_file, file_exist, check_nml_error, & - error_mesg, fms_init, fms_end, close_file, & + use fms_mod, only: error_mesg, fms_init, fms_end, & write_version_number, uppercase use mpp_mod, only: mpp_init, mpp_pe, mpp_root_pe, & mpp_error, FATAL, WARNING - use mpp_mod, only: mpp_clock_id, mpp_clock_begin, mpp_clock_end + use mpp_mod, only: mpp_clock_id, mpp_clock_begin - use mpp_io_mod, only: mpp_open, mpp_close, MPP_NATIVE, MPP_RDONLY, MPP_DELETE + use mpp_io_mod, only: mpp_open, mpp_close, MPP_DELETE use mpp_domains_mod, only: mpp_get_compute_domains, domain2D - use memutils_mod, only: print_memuse_stats use sat_vapor_pres_mod, only: sat_vapor_pres_init use diag_manager_mod, only: diag_manager_init, diag_manager_end, & - get_base_date, diag_manager_set_time_end + diag_manager_set_time_end use data_override_mod, only: data_override_init use fv_nggps_diags_mod, only: fv_dyn_bundle_setup @@ -359,9 +357,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if(restart_interval(2)== -1) freq_restart = .true. endif if(freq_restart) then - if(restart_interval(1) == 0) then - frestart(1) = total_inttime - else if(restart_interval(1) > 0) then + if(restart_interval(1) >= 0) then tmpvar = restart_interval(1) * 3600 atm_int_state%Time_step_restart = set_time (tmpvar, 0) if(iau_offset > 0 ) then @@ -371,16 +367,18 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) atm_int_state%Time_restart = atm_int_state%Time_init + atm_int_state%Time_step_restart frestart(1) = tmpvar endif - i = 2 - do while ( atm_int_state%Time_restart < atm_int_state%Time_end ) - frestart(i) = frestart(i-1) + tmpvar - atm_int_state%Time_restart = atm_int_state%Time_restart + atm_int_state%Time_step_restart - i = i + 1 - enddo + if(restart_interval(1) > 0) then + i = 2 + do while ( atm_int_state%Time_restart < atm_int_state%Time_end ) + frestart(i) = frestart(i-1) + tmpvar + atm_int_state%Time_restart = atm_int_state%Time_restart + atm_int_state%Time_step_restart + i = i + 1 + enddo + endif endif ! otherwise it is an array with forecast time at which the restart files will be written out else if(num_restart_interval >= 1) then - if(restart_interval(1) == 0 ) then + if(num_restart_interval == 1 .and. restart_interval(1) == 0 ) then frestart(1) = total_inttime else if(iau_offset > 0 ) then @@ -861,11 +859,11 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) !--- intermediate restart if (atm_int_state%intrm_rst>0) then if (na /= atm_int_state%num_atmos_calls-1) then - call get_time(atm_int_state%Time_atmos - atm_int_state%Time_atstart, seconds) + call get_time(atm_int_state%Time_atmos - atm_int_state%Time_init, seconds) if (ANY(frestart(:) == seconds)) then - restart_inctime = set_time(seconds, 0) - atm_int_state%Time_restart = atm_int_state%Time_atstart + restart_inctime - timestamp = date_to_string (atm_int_state%Time_restart) + if (mype == 0) write(0,*)'write out restart at na=',na,' seconds=',seconds, & + 'integration lenght=',na*dt_atmos/3600. + timestamp = date_to_string (atm_int_state%Time_atmos) call atmos_model_restart(atm_int_state%Atm, timestamp) call write_stoch_restart_atm('RESTART/'//trim(timestamp)//'.atm_stoch.res.nc') @@ -873,8 +871,6 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) endif endif endif -! - call print_memuse_stats('after full step') ! !----------------------------------------------------------------------- ! diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index f0e476d5b..8a50eae9b 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -41,9 +41,7 @@ module stochastic_physics_wrapper_mod real(kind=kind_phys), dimension(:,:), allocatable, save :: lake real(kind=kind_phys), dimension(:,:), allocatable, save :: condition real(kind=kind_phys), dimension(:,:), allocatable, save :: ca_deep_cpl, ca_turb_cpl, ca_shal_cpl - real(kind=kind_phys), dimension(:,:), allocatable, save :: ca_deep_diag,ca_turb_diag,ca_shal_diag real(kind=kind_phys), dimension(:,:), allocatable, save :: ca1_cpl, ca2_cpl, ca3_cpl - real(kind=kind_phys), dimension(:,:), allocatable, save :: ca1_diag,ca2_diag,ca3_diag !---------------- @@ -170,21 +168,21 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) if (.not. minval(Atm_block%blksz) == maxblk) then call mpp_error(FATAL, 'Logic errror: cellular_automata not compatible with non-uniform blocksizes') end if - ! *DH - do nb=1,nblks - GFS_Data(nb)%Intdiag%ca_deep(:) = 0. - GFS_Data(nb)%Intdiag%ca_turb(:) = 0. - GFS_Data(nb)%Intdiag%ca_shal(:) = 0. - GFS_Data(nb)%Coupling%ca_deep(:) = 0. - GFS_Data(nb)%Coupling%ca_turb(:) = 0. - GFS_Data(nb)%Coupling%ca_shal(:) = 0. - GFS_Data(nb)%Coupling%ca1(:) = 0. - GFS_Data(nb)%Coupling%ca2(:) = 0. - GFS_Data(nb)%Coupling%ca3(:) = 0. - GFS_Data(nb)%Intdiag%ca1(:) = 0. - GFS_Data(nb)%Intdiag%ca2(:) = 0. - GFS_Data(nb)%Intdiag%ca3(:) = 0. - enddo + if(GFS_Control%ca_sgs)then + allocate(sst (1:nblks, maxblk)) + allocate(lmsk (1:nblks, maxblk)) + allocate(lake (1:nblks, maxblk)) + allocate(condition (1:nblks, maxblk)) + allocate(ca_deep_cpl (1:nblks, maxblk)) + allocate(ca_turb_cpl (1:nblks, maxblk)) + allocate(ca_shal_cpl (1:nblks, maxblk)) + endif + if(GFS_Control%ca_global)then + ! Allocate contiguous arrays; no need to copy in (intent out) + allocate(ca1_cpl (1:nblks, maxblk)) + allocate(ca2_cpl (1:nblks, maxblk)) + allocate(ca3_cpl (1:nblks, maxblk)) + endif endif is_initialized = .true. @@ -254,7 +252,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif call lndp_apply_perts(GFS_Control%blksz, GFS_Control%lsm, GFS_Control%lsm_noah, GFS_Control%lsm_ruc, lsoil, & - GFS_Control%dtf, GFS_Control%kdt, GFS_Control%lndp_each_step, & + GFS_Control%dtp, GFS_Control%kdt, GFS_Control%lndp_each_step, & GFS_Control%n_var_lndp, GFS_Control%lndp_var_list, GFS_Control%lndp_prt_list, & sfc_wts, xlon, xlat, stype, GFS_Control%pores, GFS_Control%resid,param_update_flag, & smc, slc, stc, vfrac, alvsf, alnsf, alvwf, alnwf, facsf, facwf, snoalb, semis, zorll, ierr) @@ -297,17 +295,6 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) if (GFS_Control%do_ca) then if(GFS_Control%ca_sgs)then - ! Allocate contiguous arrays; copy in as needed - allocate(sst (1:nblks, maxblk)) - allocate(lmsk (1:nblks, maxblk)) - allocate(lake (1:nblks, maxblk)) - allocate(ca_deep_diag(1:nblks, maxblk)) - allocate(ca_turb_diag(1:nblks, maxblk)) - allocate(ca_shal_diag(1:nblks, maxblk)) - allocate(condition (1:nblks, maxblk)) - allocate(ca_deep_cpl (1:nblks, maxblk)) - allocate(ca_turb_cpl (1:nblks, maxblk)) - allocate(ca_shal_cpl (1:nblks, maxblk)) do nb=1,nblks sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) @@ -317,61 +304,31 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) ca_turb_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_turb(:) ca_shal_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_shal(:) enddo - call cellular_automata_sgs(GFS_Control%kdt,GFS_control%dtf,GFS_control%restart,GFS_Control%first_time_step, & - sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl,ca_deep_diag,ca_turb_diag, & - ca_shal_diag,Atm(mygrid)%domain_for_coupler,nblks, & + call cellular_automata_sgs(GFS_Control%kdt,GFS_control%dtp,GFS_control%restart,GFS_Control%first_time_step, & + sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl, Atm(mygrid)%domain_for_coupler,nblks, & Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, levs, & - GFS_Control%nthresh,GFS_Control%rcell,GFS_Control%nca,GFS_Control%scells,GFS_Control%tlives,GFS_Control%nfracseed, & - GFS_Control%nseed,GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca, & - GFS_Control%ca_smooth,GFS_Control%nspinup,GFS_Control%ca_trigger,Atm_block%blksz(1),GFS_Control%master,GFS_Control%communicator) + GFS_Control%nthresh,GFS_Control%rcell,GFS_Control%tile_num,GFS_Control%nca,GFS_Control%scells,GFS_Control%tlives, & + GFS_Control%nfracseed, GFS_Control%nseed,GFS_Control%iseed_ca, & + GFS_Control%nspinup,GFS_Control%ca_trigger,Atm_block%blksz(1),GFS_Control%master,GFS_Control%communicator) ! Copy contiguous data back as needed do nb=1,nblks - GFS_Data(nb)%Intdiag%ca_deep(:) = ca_deep_diag(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Intdiag%ca_turb(:) = ca_turb_diag(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Intdiag%ca_shal(:) = ca_shal_diag(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca_deep(:) = ca_deep_cpl (nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca_turb(:) = ca_turb_cpl (nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca_shal(:) = ca_shal_cpl (nb,1:GFS_Control%blksz(nb)) enddo - deallocate(sst ) - deallocate(lmsk ) - deallocate(lake ) - deallocate(condition ) - deallocate(ca_deep_cpl ) - deallocate(ca_turb_cpl ) - deallocate(ca_shal_cpl ) - deallocate(ca_deep_diag) - deallocate(ca_turb_diag) - deallocate(ca_shal_diag) endif if(GFS_Control%ca_global)then - ! Allocate contiguous arrays; no need to copy in (intent out) - allocate(ca1_cpl (1:nblks, maxblk)) - allocate(ca2_cpl (1:nblks, maxblk)) - allocate(ca3_cpl (1:nblks, maxblk)) - allocate(ca1_diag(1:nblks, maxblk)) - allocate(ca2_diag(1:nblks, maxblk)) - allocate(ca3_diag(1:nblks, maxblk)) - call cellular_automata_global(GFS_Control%kdt,GFS_Control%first_time_step,ca1_cpl,ca2_cpl,ca3_cpl,ca1_diag,ca2_diag,ca3_diag, & + call cellular_automata_global(GFS_Control%kdt,GFS_control%restart,GFS_Control%first_time_step,ca1_cpl,ca2_cpl,ca3_cpl, & Atm(mygrid)%domain_for_coupler, nblks,Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy,levs, & GFS_Control%nca_g,GFS_Control%ncells_g,GFS_Control%nlives_g,GFS_Control%nfracseed,GFS_Control%nseed_g, & - GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca,GFS_Control%ca_smooth,GFS_Control%nspinup,Atm_block%blksz(1), & + GFS_Control%iseed_ca,GFS_control%tile_num,GFS_Control%ca_smooth,GFS_Control%nspinup,Atm_block%blksz(1), & GFS_Control%nsmooth,GFS_Control%ca_amplitude,GFS_Control%master,GFS_Control%communicator) ! Copy contiguous data back do nb=1,nblks - GFS_Data(nb)%Coupling%ca1(:) = ca1_cpl (nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Coupling%ca2(:) = ca2_cpl (nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Coupling%ca3(:) = ca3_cpl (nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Intdiag%ca1(:) = ca1_diag(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Intdiag%ca2(:) = ca2_diag(nb,1:GFS_Control%blksz(nb)) - GFS_Data(nb)%Intdiag%ca3(:) = ca3_diag(nb,1:GFS_Control%blksz(nb)) + GFS_Data(nb)%Coupling%ca1(:) = ca1_cpl(nb,1:GFS_Control%blksz(nb)) + GFS_Data(nb)%Coupling%ca2(:) = ca2_cpl(nb,1:GFS_Control%blksz(nb)) + GFS_Data(nb)%Coupling%ca3(:) = ca3_cpl(nb,1:GFS_Control%blksz(nb)) enddo - deallocate(ca1_cpl ) - deallocate(ca2_cpl ) - deallocate(ca3_cpl ) - deallocate(ca1_diag) - deallocate(ca2_diag) - deallocate(ca3_diag) endif endif !do_ca @@ -425,6 +382,20 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) endif call finalize_stochastic_physics() endif + if(GFS_Control%ca_sgs)then + deallocate(sst ) + deallocate(lmsk ) + deallocate(lake ) + deallocate(condition ) + deallocate(ca_deep_cpl ) + deallocate(ca_turb_cpl ) + deallocate(ca_shal_cpl ) + endif + if(GFS_Control%ca_global)then + deallocate(ca1_cpl ) + deallocate(ca2_cpl ) + deallocate(ca3_cpl ) + endif end subroutine stochastic_physics_wrapper_end end module stochastic_physics_wrapper_mod