From 606cb31a5bcb08ed7c8a1214488beb580a6e2781 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Mon, 12 Jun 2023 14:04:40 -0600 Subject: [PATCH 01/48] MYNN fix for numerical stability issues with mixing snow (#656) * MYNN fix for numerical stability issues with mixing snow --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 8cb164377..90c708975 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 8cb1643774b8c0ede7bd3f2f4e0881d4f32500b8 +Subproject commit 90c70897562884f413b27b7bca35130e8b881b7f From f9d68ad799a8dcdaa2fdb706fe51204641a82b6b Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Tue, 20 Jun 2023 16:03:58 -0400 Subject: [PATCH 02/48] Refactor fv3atm history & restart to reduce redundant code. Add rrfs-sd and clm lake to quilt restart. (#660) * move utility routines, data structures, and name generation out of FV3GFS_io.F90 * move RRFS SD state restart io to separate file and rename clm_lake_io.F90 * sfc array indices are calculated in FV3GFS_sfc_io.F90 * move rrfs sd emissions input code to FV3GFS_rrfs_sd_io.F90 * allocate sfc arrays in FV3GFS_sfc_io.F90 * define and write axes in FV3GFS_sfc_io.F90 * register sfc fields in FV3GFS_sfc_io.F90 * move sfc read loop to FV3GFS_sfc_io.F90 * Put post-read safeguards in FV3GFS_sfc_io.F90 * copy to grid in FV3GFS_sfc_io.F90 and make things private * move oro reading to FV3GFS_oro_io.F90 * gwd I/O in FV3GFS_oro_io.F90 * store quilt restart data structures in FV3GFS_sfc_io types * remove copy_from_GFS_Data calls from FV3GFS_restart_io.F90 * consistent naming and clm lake quilt restart --- CMakeLists.txt | 10 +- atmos_model.F90 | 29 +- fv3_cap.F90 | 18 +- io/FV3GFS_io.F90 | 4325 ------------------------ io/FV3GFS_restart_io.F90 | 920 ----- io/clm_lake_io.F90 | 432 --- io/fv3atm_clm_lake_io.F90 | 521 +++ io/fv3atm_common_io.F90 | 518 +++ io/fv3atm_history_io.F90 | 1184 +++++++ io/fv3atm_oro_io.F90 | 333 ++ io/fv3atm_restart_io.F90 | 1282 +++++++ io/fv3atm_rrfs_sd_io.F90 | 607 ++++ io/fv3atm_sfc_io.F90 | 1625 +++++++++ io/module_wrt_grid_comp.F90 | 4 +- module_fcst_grid_comp.F90 | 4 +- moving_nest/fv_moving_nest_physics.F90 | 2 +- 16 files changed, 6106 insertions(+), 5708 deletions(-) delete mode 100644 io/FV3GFS_io.F90 delete mode 100644 io/FV3GFS_restart_io.F90 delete mode 100644 io/clm_lake_io.F90 create mode 100644 io/fv3atm_clm_lake_io.F90 create mode 100644 io/fv3atm_common_io.F90 create mode 100644 io/fv3atm_history_io.F90 create mode 100644 io/fv3atm_oro_io.F90 create mode 100644 io/fv3atm_restart_io.F90 create mode 100644 io/fv3atm_rrfs_sd_io.F90 create mode 100644 io/fv3atm_sfc_io.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 226aea148..549738794 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -85,9 +85,13 @@ add_library(fv3atm cpl/module_block_data.F90 cpl/module_cplfields.F90 cpl/module_cap_cpl.F90 - io/clm_lake_io.F90 - io/FV3GFS_io.F90 - io/FV3GFS_restart_io.F90 + io/fv3atm_common_io.F90 + io/fv3atm_clm_lake_io.F90 + io/fv3atm_rrfs_sd_io.F90 + io/fv3atm_sfc_io.F90 + io/fv3atm_oro_io.F90 + io/fv3atm_history_io.F90 + io/fv3atm_restart_io.F90 io/module_write_netcdf.F90 io/module_write_restart_netcdf.F90 io/module_fv3_io_def.F90 diff --git a/atmos_model.F90 b/atmos_model.F90 index 7470f6971..5c54aed86 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -90,13 +90,14 @@ module atmos_model_mod use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper,stochastic_physics_wrapper_end -use FV3GFS_io_mod, only: FV3GFS_restart_read, FV3GFS_restart_write, & - FV3GFS_GFS_checksum, & - FV3GFS_diag_register, FV3GFS_diag_output, & +use fv3atm_history_io_mod, only: fv3atm_diag_register, fv3atm_diag_output, & DIAG_SIZE -use FV3GFS_restart_io_mod, only: FV3GFS_restart_register, & +use fv3atm_restart_io_mod, only: fv3atm_restart_register, & + fv3atm_checksum, & fv_phy_restart_output, & - fv_sfc_restart_output + fv_sfc_restart_output, & + fv3atm_restart_read, & + fv3atm_restart_write use fv_ufs_restart_io_mod, only: fv_dyn_restart_register, & fv_dyn_restart_output use fv_iau_mod, only: iau_external_data_type,getiauforcing,iau_initialize @@ -369,7 +370,7 @@ subroutine update_atmos_radiation_physics (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'RADIATION STEP ', GFS_control%kdt, GFS_control%fhour - call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) + call fv3atm_checksum(GFS_control, GFS_data, Atm_block) endif if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "physics driver" @@ -383,7 +384,7 @@ subroutine update_atmos_radiation_physics (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP1 ', GFS_control%kdt, GFS_control%fhour - call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) + call fv3atm_checksum(GFS_control, GFS_data, Atm_block) endif if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & @@ -402,7 +403,7 @@ subroutine update_atmos_radiation_physics (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP2 ', GFS_control%kdt, GFS_control%fhour - call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) + call fv3atm_checksum(GFS_control, GFS_data, Atm_block) endif call getiauforcing(GFS_control,IAU_data) if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "end of radiation and physics step" @@ -736,15 +737,15 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !rab call atmosphere_tracer_postinit (GFS_data, Atm_block) call atmosphere_nggps_diag (Time, init=.true.) - call FV3GFS_diag_register (GFS_Diag, Time, Atm_block, GFS_control, Atmos%lon, Atmos%lat, Atmos%axes) + call fv3atm_diag_register (GFS_Diag, Time, Atm_block, GFS_control, Atmos%lon, Atmos%lat, Atmos%axes) call GFS_restart_populate (GFS_restart_var, GFS_control, GFS_data%Statein, GFS_data%Stateout, GFS_data%Sfcprop, & GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & GFS_data%IntDiag, Init_parm, GFS_Diag) if (quilting_restart) then call fv_dyn_restart_register (Atm(mygrid)) - call FV3GFS_restart_register (GFS_data%Sfcprop, GFS_restart_var, Atm_block, GFS_control) + call fv3atm_restart_register (GFS_data%Sfcprop, GFS_restart_var, Atm_block, GFS_control) endif - call FV3GFS_restart_read (GFS_data, GFS_restart_var, Atm_block, GFS_control, Atmos%domain_for_read, & + call fv3atm_restart_read (GFS_data, GFS_restart_var, Atm_block, GFS_control, Atmos%domain_for_read, & Atm(mygrid)%flagstruct%warm_start, ignore_rst_cksum) if(GFS_control%do_ca .and. Atm(mygrid)%flagstruct%warm_start)then call read_ca_restart (Atmos%domain,GFS_control%ncells,GFS_control%nca,GFS_control%ncells_g,GFS_control%nca_g) @@ -966,7 +967,7 @@ subroutine update_atmos_model_state (Atmos, rc) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'UPDATE STATE ', GFS_control%kdt, GFS_control%fhour if (mpp_pe() == mpp_root_pe()) print *,'in UPDATE STATE ', size(GFS_data(1)%SfcProp%tsfc),'nblks=',Atm_block%nblks - call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) + call fv3atm_checksum(GFS_control, GFS_data, Atm_block) endif !--- advance time --- @@ -995,7 +996,7 @@ subroutine update_atmos_model_state (Atmos, rc) endif if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs' call atmosphere_nggps_diag(Atmos%Time) - call FV3GFS_diag_output(Atmos%Time, GFS_Diag, Atm_block, GFS_control%nx, GFS_control%ny, & + call fv3atm_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) endif @@ -1109,7 +1110,7 @@ subroutine atmos_model_restart(Atmos, timestamp) call fv_dyn_restart_output(Atm(mygrid), timestamp) else call atmosphere_restart(timestamp) - call FV3GFS_restart_write (GFS_data, GFS_restart_var, Atm_block, & + call fv3atm_restart_write (GFS_data, GFS_restart_var, Atm_block, & GFS_control, Atmos%domain, timestamp) endif if(GFS_control%do_ca)then diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 7b3ab2eba..50ad49104 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -1,4 +1,4 @@ -!--------------- FV3GFS solo model ----------------- +!--------------- FV3 ATM solo model ---------------- ! !*** The FV3 atmosphere grid component nuopc cap ! @@ -11,7 +11,7 @@ ! 02 Nov 2017: J. Wang Use Gerhard's transferable RouteHandle ! -module fv3gfs_cap_mod +module fv3atm_cap_mod use ESMF use NUOPC @@ -80,14 +80,14 @@ module fv3gfs_cap_mod contains !----------------------------------------------------------------------- -!------------------- Solo fv3gfs code starts here ---------------------- +!------------------- Solo fv3atm code starts here ---------------------- !----------------------------------------------------------------------- subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - character(len=*),parameter :: subname='(fv3gfs_cap:SetServices)' + character(len=*),parameter :: subname='(fv3atm_cap:SetServices)' rc = ESMF_SUCCESS @@ -983,7 +983,7 @@ subroutine InitializeRealize(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname='(fv3gfs_cap:InitializeRealize)' + character(len=*),parameter :: subname='(fv3atm_cap:InitializeRealize)' type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState integer :: urc @@ -1248,7 +1248,7 @@ subroutine fv3_checkimport(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname='(fv3gfs_cap:fv3_checkimport)' + character(len=*),parameter :: subname='(fv3atm_cap:fv3_checkimport)' integer :: n, nf type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime, invalidTime @@ -1335,7 +1335,7 @@ subroutine TimestampExport_phase1(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname='(fv3gfs_cap:TimestampExport_phase1)' + character(len=*),parameter :: subname='(fv3atm_cap:TimestampExport_phase1)' type(ESMF_Clock) :: driverClock, modelClock type(ESMF_State) :: exportState @@ -1365,7 +1365,7 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname='(fv3gfs_cap:ModelFinalize)' + character(len=*),parameter :: subname='(fv3atm_cap:ModelFinalize)' integer :: i, urc type(ESMF_VM) :: vm real(kind=8) :: MPI_Wtime, timeffs @@ -1413,4 +1413,4 @@ end subroutine ModelFinalize ! !----------------------------------------------------------------------------- -end module fv3gfs_cap_mod +end module fv3atm_cap_mod diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 deleted file mode 100644 index 876248d16..000000000 --- a/io/FV3GFS_io.F90 +++ /dev/null @@ -1,4325 +0,0 @@ -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 -! atmospheric time tendencies for use by other components, namely -! the atmospheric dynamical core. -! -! NOTE: This module currently supports only the operational GFS -! parameterizations as of September 2015. Further development -! is needed to support the full suite of physical -! parameterizations present in the GFS physics package. -!----------------------------------------------------------------------- -! -!--- FMS/GFDL modules - 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: 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 - use diag_axis_mod, only: get_axis_global_length, get_diag_axis, & - get_diag_axis_name - use diag_data_mod, only: output_fields, max_output_fields - use diag_util_mod, only: find_input_field - use constants_mod, only: grav, rdgas - use physcons, only: con_tice !saltwater freezing temp (K) - use clm_lake_io, only: clm_lake_data_type -! -!--- GFS_typedefs - use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, & - GFS_data_type, kind_phys - use GFS_restart, only: GFS_restart_type - use GFS_diagnostics, only: GFS_externaldiag_type - -! -!----------------------------------------------------------------------- - implicit none - private - - !--- public interfaces --- - public FV3GFS_restart_read, FV3GFS_restart_write - public FV3GFS_GFS_checksum - public fv3gfs_diag_register, fv3gfs_diag_output -#ifdef use_WRTCOMP - public fv_phys_bundle_setup -#endif - - !--- GFDL filenames - character(len=32) :: fn_oro = 'oro_data.nc' - character(len=32) :: fn_oro_ls = 'oro_data_ls.nc' - character(len=32) :: fn_oro_ss = 'oro_data_ss.nc' - character(len=32) :: fn_srf = 'sfc_data.nc' - character(len=32) :: fn_phy = 'phy_data.nc' - character(len=32) :: fn_dust12m= 'dust12m_data.nc' - character(len=32) :: fn_emi = 'emi_data.nc' - character(len=32) :: fn_rrfssd = 'SMOKE_RRFS_data.nc' - - !--- GFDL FMS netcdf restart data types defined in fms2_io - type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, Phy_restart, dust12m_restart, emi_restart, rrfssd_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 - character(len=32), allocatable, dimension(:) :: oro_ls_ss_name - real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_ls_var, oro_ss_var, oro_var3v, oro_var3s - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3, phy_var3 - character(len=32), allocatable, dimension(:) :: dust12m_name, emi_name, rrfssd_name - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: rrfssd_var - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: dust12m_var - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: emi_var - !--- Noah MP restart containers - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3sn,sfc_var3eq,sfc_var3zn - - real(kind=kind_phys) :: zhour -! - integer, parameter :: r8 = kind_phys - integer :: tot_diag_idx = 0 - integer :: total_outputlevel = 0 - integer :: isco,ieco,jsco,jeco,levo,num_axes_phys - integer :: fhzero, ncld, nsoil, imp_physics, landsfcmdl - real(4) :: dtp - logical :: lprecip_accu - character(len=64) :: Sprecip_accu - integer,dimension(:), allocatable :: nstt, nstt_vctbl, all_axes - character(20),dimension(:), allocatable :: axis_name, axis_name_vert - real(4), dimension(:,:,:), allocatable, target :: buffer_phys_bl, buffer_phys_nb - real(4), dimension(:,:,:,:), allocatable, target :: buffer_phys_windvect - real(kind=kind_phys),dimension(:,:),allocatable :: lon, lat, uwork - real(kind=kind_phys),dimension(:,:,:),allocatable:: uwork3d - logical :: uwork_set = .false. - character(128) :: uwindname - integer, parameter, public :: DIAG_SIZE = 800 - real, parameter :: missing_value = 9.99e20_r8 - real, parameter:: stndrd_atmos_ps = 101325.0_r8 - real, parameter:: stndrd_atmos_lapse = 0.0065_r8 - 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. - - type rrfs_sd_data_type - ! The smoke_data_type stores temporary arrays used to read or - ! write RRFS-SD restart and axis variables. - - real(kind_phys), pointer, private, dimension(:,:) :: & ! i,j variables - emdust=>null(), emseas=>null(), emanoc=>null(), fhist=>null(), coef_bb_dc=>null() - - real(kind_phys), pointer, private, dimension(:,:,:) :: & - fire_in=>null() ! i, j, fire_aux_data_levels - - contains - procedure, public :: register_axis => rrfs_sd_register_axis ! register fire_aux_data_levels axis - procedure, public :: write_axis => rrfs_sd_write_axis ! write fire_aux_data_levels variable - procedure, public :: allocate_data => rrfs_sd_allocate_data ! allocate all pointers - procedure, public :: fill_data => rrfs_sd_fill_data ! fill data with default values - procedure, public :: register_fields => rrfs_sd_register_fields ! register rrfs_sd fields - procedure, public :: deallocate_data => rrfs_sd_deallocate_data ! deallocate pointers - procedure, public :: copy_to_temporaries => rrfs_sd_copy_to_temporaries ! Copy Sfcprop to arrays - procedure, public :: copy_from_temporaries => rrfs_sd_copy_from_temporaries ! Copy arrays to Sfcprop - final :: rrfs_sd_final ! Destructor; calls deallocate_data - end type rrfs_sd_data_type - - interface copy_from_GFS_Data - module procedure copy_from_GFS_Data_2d_phys2phys, & - copy_from_GFS_Data_3d_phys2phys, & - copy_from_GFS_Data_2d_int2phys, & - copy_from_GFS_Data_3d_int2phys, & - copy_from_GFS_Data_2d_stack_phys2phys - end interface - - interface copy_to_GFS_Data - module procedure copy_to_GFS_Data_2d_phys2phys, & - copy_to_GFS_Data_3d_phys2phys, & - copy_to_GFS_Data_2d_int2phys, & - copy_to_GFS_Data_3d_int2phys, & - copy_to_GFS_Data_3d_slice_phys2phys - end interface copy_to_GFS_Data - - CONTAINS - -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! -! PUBLIC SUBROUTINES -! -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! -!-------------------- -! FV3GFS_restart_read -!-------------------- - subroutine FV3GFS_restart_read (GFS_Data, GFS_Restart, Atm_block, Model, fv_domain, warm_start, ignore_rst_cksum) - type(GFS_data_type), intent(inout) :: GFS_Data(:) - type(GFS_restart_type), intent(inout) :: GFS_Restart - type(block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(inout) :: Model - type(domain2d), intent(in) :: fv_domain - logical, intent(in) :: warm_start - logical, intent(in) :: ignore_rst_cksum - - !--- read in surface data from chgres - call sfc_prop_restart_read (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, warm_start, ignore_rst_cksum) - - !--- read in physics restart data - call phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain, ignore_rst_cksum) - - end subroutine FV3GFS_restart_read - -!--------------------- -! FV3GFS_restart_write -!--------------------- - subroutine FV3GFS_restart_write (GFS_Data, GFS_Restart, Atm_block, Model, fv_domain, timestamp) - type(GFS_data_type), intent(inout) :: GFS_Data(:) - type(GFS_restart_type), intent(inout) :: GFS_Restart - type(block_control_type), intent(in) :: Atm_block - 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 - 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) - - end subroutine FV3GFS_restart_write - - -!-------------------- -! FV3GFS_GFS_checksum -!-------------------- - subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) - !--- interface variables - type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: GFS_Data(:) - type (block_control_type), intent(in) :: Atm_block - !--- local variables - integer :: outunit, j, i, ix, nb, isc, iec, jsc, jec, lev, ct, l, ntr, k - integer :: nsfcprop2d, idx_opt, nt - real(kind=kind_phys), allocatable :: temp2d(:,:,:) - real(kind=kind_phys), allocatable :: temp3d(:,:,:,:) - real(kind=kind_phys), allocatable :: temp3dlevsp1(:,:,:,:) - integer, allocatable :: ii1(:), jj1(:) - character(len=32) :: name - - isc = Model%isc - iec = Model%isc+Model%nx-1 - jsc = Model%jsc - jec = Model%jsc+Model%ny-1 - lev = Model%levs - - ntr = size(GFS_Data(1)%Statein%qgrs,3) - - nsfcprop2d = 93 - if (Model%lsm == Model%lsm_noahmp) then - nsfcprop2d = nsfcprop2d + 49 - if (Model%use_cice_alb) then - nsfcprop2d = nsfcprop2d + 4 - endif - elseif (Model%lsm == Model%lsm_ruc) then - nsfcprop2d = nsfcprop2d + 4 + 12 - if (Model%rdlai) then - nsfcprop2d = nsfcprop2d + 1 - endif - else - if (Model%use_cice_alb) then - nsfcprop2d = nsfcprop2d + 4 - endif - endif - - if (Model%nstf_name(1) > 0) then - nsfcprop2d = nsfcprop2d + 16 - endif - - if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - nsfcprop2d = nsfcprop2d + 10 - endif - - allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot2d+Model%nctp)) - allocate (temp3d(isc:iec,jsc:jec,1:lev,14+Model%ntot3d+2*ntr)) - allocate (temp3dlevsp1(isc:iec,jsc:jec,1:lev+1,3)) - - temp2d = zero - temp3d = zero - temp3dlevsp1 = zero - -!$omp parallel do default(shared) private(i, j, k, nb, ix, nt, ii1, jj1) - block_loop: do nb = 1, Atm_block%nblks - allocate(ii1(Atm_block%blksz(nb))) - allocate(jj1(Atm_block%blksz(nb))) - ii1=Atm_block%index(nb)%ii - isc + 1 - jj1=Atm_block%index(nb)%jj - jsc + 1 - - ! Copy into temp2d - nt=0 - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Statein%pgr) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%slmsk) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsfc) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tisfc) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zorl) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%fice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%hprime(:,1)) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sncovr) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snoalb) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alvsf) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alnsf) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alvwf) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alnwf) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%facsf) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%facwf) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%slope) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%shdmin) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%shdmax) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tg3) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%vfrac) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%vtype) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stype) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%uustar) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%oro) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%oro_uf) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%hice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%weasd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%canopy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%ffmm) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%ffhh) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%f10m) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tprcp) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%srflag) - lsm_choice: if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%slc) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smc) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stc) - elseif (Model%lsm == Model%lsm_ruc) then - do k=1,3 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sh2o(:,k)) - enddo - ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - nt=nt+1 - do ix=1,Atm_block%blksz(nb) - temp2d(ii1(ix),jj1(ix),nt) = sum(GFS_Data(nb)%Sfcprop%sh2o(ix,4:Model%lsoil_lsm)) - enddo - do k=1,3 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smois(:,k)) - enddo - ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - nt=nt+1 - do ix=1,Atm_block%blksz(nb) - temp2d(ii1(ix),jj1(ix),nt) = sum(GFS_Data(nb)%Sfcprop%smois(ix,4:Model%lsoil_lsm)) - enddo - do k=1,3 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tslb(:,k)) - enddo - ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - nt=nt+1 - do ix=1,Atm_block%blksz(nb) - temp2d(ii1(ix),jj1(ix),nt) = sum(GFS_Data(nb)%Sfcprop%tslb(ix,4:Model%lsoil_lsm)) - enddo - endif lsm_choice - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t2m) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%q2m) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirbmdi) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirdfdi) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visbmdi) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visdfdi) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirbmui) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirdfui) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visbmui) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visdfui) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%sfcdsw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%sfcnsw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%sfcdlw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%xlon) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%xlat) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%xlat_d) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%sinlat) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%coslat) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%area) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%dx) - if (Model%ntoz > 0) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%ddy_o3) - endif - if (Model%h2o_phys) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%ddy_h) - endif - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Cldprop%cv) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Cldprop%cvt) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Cldprop%cvb) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%sfalb) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%coszen) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%tsflw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%semis) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%coszdg) - - ! Radtend%sfcfsw is an array of derived type, so we copy all - ! eight elements of the type in one loop - do ix=1,Atm_block%blksz(nb) - temp2d(ii1(ix),jj1(ix),nt+1) = GFS_Data(nb)%Radtend%sfcfsw(ix)%upfxc - temp2d(ii1(ix),jj1(ix),nt+2) = GFS_Data(nb)%Radtend%sfcfsw(ix)%upfx0 - temp2d(ii1(ix),jj1(ix),nt+3) = GFS_Data(nb)%Radtend%sfcfsw(ix)%dnfxc - temp2d(ii1(ix),jj1(ix),nt+4) = GFS_Data(nb)%Radtend%sfcfsw(ix)%dnfx0 - temp2d(ii1(ix),jj1(ix),nt+5) = GFS_Data(nb)%Radtend%sfcflw(ix)%upfxc - temp2d(ii1(ix),jj1(ix),nt+6) = GFS_Data(nb)%Radtend%sfcflw(ix)%upfx0 - temp2d(ii1(ix),jj1(ix),nt+7) = GFS_Data(nb)%Radtend%sfcflw(ix)%dnfxc - temp2d(ii1(ix),jj1(ix),nt+8) = GFS_Data(nb)%Radtend%sfcflw(ix)%dnfx0 - enddo - nt = nt + 8 - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tiice(:,1)) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tiice(:,2)) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirvis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirnir_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifvis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifnir_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%emis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%emis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sncovr_ice) - - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirvis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirnir_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifvis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifnir_ice) - endif - - lsm_choice_2: if (Model%lsm == Model%lsm_noahmp) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tvxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tgxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%canicexy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%canliqxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%eahxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tahxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%cmxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%chxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%fwetxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sneqvoxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alboldxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qsnowxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%wslakexy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zwtxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%waxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%wtxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%lfmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%rtmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%woodxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stblcpxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%fastcpxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xsaixy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xlaixy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%taussxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smcwtdxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%deeprechxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%rechxy) - - ! These five arrays use bizarre indexing, so we use loops: - do k=-2,0 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snicexy(:,k)) - enddo - - do k=-2,0 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snliqxy(:,k)) - enddo - - do k=-2,0 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsnoxy(:,k)) - enddo - - do k=1,4 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smoiseq(:,k)) - enddo - - do k=-2,4 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zsnsoxy(:,k)) - enddo - elseif (Model%lsm == Model%lsm_ruc) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%wetness) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%clw_surf_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%clw_surf_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qwv_surf_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qwv_surf_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsnow_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsnow_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowfallac_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowfallac_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sfalb_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sfalb_lnd_bck) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sfalb_ice) - if (Model%rdlai) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xlaixy) - endif - endif lsm_choice_2 - - nstf_name_choice: if (Model%nstf_name(1) > 0) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tref) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%z_c) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%c_0) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%c_d) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%w_0) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%w_d) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xt) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xs) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xu) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xz) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zm) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xtts) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xzts) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%ifd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%dt_cool) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qrain) - endif nstf_name_choice - -! Flake - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%T_snow) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%T_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%h_ML) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_ML) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_mnw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%h_talb) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_talb) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_bot1) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_bot2) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%c_t) - endif - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Tbd%phy_f2d) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Tbd%phy_fctd) - - ! Copy to temp3dlevsp1 - nt=0 - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3dlevsp1, GFS_Data(nb)%Statein%phii) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3dlevsp1, GFS_Data(nb)%Statein%prsi) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3dlevsp1, GFS_Data(nb)%Statein%prsik) - - ! Copy to temp3d - nt=0 - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%phil) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%prsl) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%prslk) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%ugrs) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%vgrs) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%vvl) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%tgrs) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gu0) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gv0) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gt0) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%htrsw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%htrlw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%swhc) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%lwhc) - do l = 1,Model%ntot3d - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Tbd%phy_f3d(:,:,l)) - enddo - do l = 1,ntr - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%qgrs(:,:,l)) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gq0(:,:,l)) - enddo - enddo block_loop - - - outunit = stdout() - do i = 1,nsfcprop2d+Model%ntot2d+Model%nctp - write (name, '(i3.3,3x,4a)') i, ' 2d ' - write(outunit,100) name, mpp_chksum(temp2d(:,:,i:i)) - enddo - do i = 1,3 - write (name, '(i2.2,3x,4a)') i, ' 3d levsp1' - write(outunit,100) name, mpp_chksum(temp3dlevsp1(:,:,:,i:i)) - enddo - do i = 1,14+Model%ntot3d+2*ntr - write (name, '(i2.2,3x,4a)') i, ' 3d levs' - write(outunit,100) name, mpp_chksum(temp3d(:,:,:,i:i)) - enddo -100 format("CHECKSUM::",A32," = ",Z20) - - deallocate(temp2d) - deallocate(temp3d) - deallocate(temp3dlevsp1) - end subroutine FV3GFS_GFS_checksum - -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! -! PRIVATE SUBROUTINES -! -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - pure subroutine copy_from_GFS_Data_2d_phys2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(in) :: var_block(:) - real(kind=kind_phys), intent(out) :: var2d(:,:,:) - integer ix - - nt=nt+1 - do ix=1,size(var_block) - var2d(ii1(ix),jj1(ix),nt) = var_block(ix) - enddo - end subroutine copy_from_GFS_Data_2d_phys2phys - - pure subroutine copy_from_GFS_Data_3d_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(in) :: var_block(:,:) - real(kind=kind_phys), intent(out) :: var3d(:,:,:,:) - integer ix, k - - nt=nt+1 - do k=lbound(var_block,2),ubound(var_block,2) - do ix=1,size(var_block,1) - var3d(ii1(ix),jj1(ix),k,nt) = var_block(ix,k) - enddo - enddo - end subroutine copy_from_GFS_Data_3d_phys2phys - - pure subroutine copy_from_GFS_Data_2d_int2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc, var_block(:) - integer, intent(inout) :: nt - real(kind=kind_phys), intent(out) :: var2d(:,:,:) - integer ix - - nt=nt+1 - do ix=1,size(var_block) - var2d(ii1(ix),jj1(ix),nt) = var_block(ix) - enddo - end subroutine copy_from_GFS_Data_2d_int2phys - - pure subroutine copy_from_GFS_Data_2d_stack_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - ! For copying phy_f2d and phy_fctd - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(in) :: var_block(:,:) - real(kind=kind_phys), intent(out) :: var3d(:,:,:) - integer ix, k - - nt=nt+1 - do k=lbound(var_block,2),ubound(var_block,2) - do ix=1,size(var_block,1) - var3d(ii1(ix),jj1(ix),nt) = var_block(ix,k) - enddo - enddo - end subroutine copy_from_GFS_Data_2d_stack_phys2phys - - pure subroutine copy_from_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), var_block(:,:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(out) :: var3d(:,:,:,:) - integer ix, k - - nt=nt+1 - do k=lbound(var_block,2),ubound(var_block,2) - do ix=1,size(var_block,1) - var3d(ii1(ix),jj1(ix),k,nt) = real(var_block(ix,k),kind_phys) - enddo - enddo - end subroutine copy_from_GFS_Data_3d_int2phys - - pure subroutine copy_to_GFS_Data_2d_phys2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(out) :: var_block(:) - real(kind=kind_phys), intent(in) :: var2d(:,:,:) - integer ix - - nt=nt+1 - do ix=1,size(var_block) - var_block(ix) = var2d(ii1(ix),jj1(ix),nt) - enddo - end subroutine copy_to_GFS_Data_2d_phys2phys - - pure subroutine copy_to_GFS_Data_3d_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(out) :: var_block(:,:) - real(kind=kind_phys), intent(in) :: var3d(:,:,:,:) - integer ix, k - - nt=nt+1 - do k=lbound(var_block,2),ubound(var_block,2) - do ix=1,size(var_block,1) - var_block(ix,k) = var3d(ii1(ix),jj1(ix),k,nt) - enddo - enddo - end subroutine copy_to_GFS_Data_3d_phys2phys - - pure subroutine copy_to_GFS_Data_3d_slice_phys2phys(ii1,jj1,isc,jsc,nt,k1,k2,var3d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc, k1, k2 - integer, intent(inout) :: nt - real(kind=kind_phys), intent(out) :: var_block(:,:) - real(kind=kind_phys), intent(in) :: var3d(:,:,:,:) - integer ix, k - - nt=nt+1 - do k=k1,k2 - do ix=1,size(var_block,1) - var_block(ix,k) = var3d(ii1(ix),jj1(ix),k,nt) - enddo - enddo - end subroutine copy_to_GFS_Data_3d_slice_phys2phys - - pure subroutine copy_to_GFS_Data_2d_int2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - integer, intent(out) :: var_block(:) - real(kind=kind_phys), intent(in) :: var2d(:,:,:) - integer ix - - nt=nt+1 - do ix=1,size(var_block) - var_block(ix) = int(var2d(ii1(ix),jj1(ix),nt)) - enddo - end subroutine copy_to_GFS_Data_2d_int2phys - - pure subroutine copy_to_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - integer, intent(out) :: var_block(:,:) - real(kind=kind_phys), intent(in) :: var3d(:,:,:,:) - integer ix - - nt=nt+1 - do ix=1,size(var_block,1) - var_block(ix,:) = int(var3d(ii1(ix),jj1(ix),:,nt)) - enddo - end subroutine copy_to_GFS_Data_3d_int2phys - - - pure subroutine fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,warm_start) - implicit none - type(GFS_control_type), intent(in) :: Model - integer, intent(in) :: nvar_s2m - character(len=32),intent(out) :: sfc_name2(:), sfc_name3(:) - logical, intent(in) :: warm_start - integer :: nt - - !--- names of the 2D variables to save - nt=0 - nt=nt+1 ; sfc_name2(nt) = 'slmsk' - nt=nt+1 ; sfc_name2(nt) = 'tsea' !tsfc - nt=nt+1 ; sfc_name2(nt) = 'sheleg' !weasd - nt=nt+1 ; sfc_name2(nt) = 'tg3' - nt=nt+1 ; sfc_name2(nt) = 'zorl' - nt=nt+1 ; sfc_name2(nt) = 'alvsf' - nt=nt+1 ; sfc_name2(nt) = 'alvwf' - nt=nt+1 ; sfc_name2(nt) = 'alnsf' - nt=nt+1 ; sfc_name2(nt) = 'alnwf' - nt=nt+1 ; sfc_name2(nt) = 'facsf' - nt=nt+1 ; sfc_name2(nt) = 'facwf' - nt=nt+1 ; sfc_name2(nt) = 'vfrac' - nt=nt+1 ; sfc_name2(nt) = 'canopy' - nt=nt+1 ; sfc_name2(nt) = 'f10m' - nt=nt+1 ; sfc_name2(nt) = 't2m' - nt=nt+1 ; sfc_name2(nt) = 'q2m' - nt=nt+1 ; sfc_name2(nt) = 'vtype' - nt=nt+1 ; sfc_name2(nt) = 'stype' - nt=nt+1 ; sfc_name2(nt) = 'uustar' - nt=nt+1 ; sfc_name2(nt) = 'ffmm' - nt=nt+1 ; sfc_name2(nt) = 'ffhh' - nt=nt+1 ; sfc_name2(nt) = 'hice' - nt=nt+1 ; sfc_name2(nt) = 'fice' - nt=nt+1 ; sfc_name2(nt) = 'tisfc' - nt=nt+1 ; sfc_name2(nt) = 'tprcp' - nt=nt+1 ; sfc_name2(nt) = 'srflag' - nt=nt+1 ; sfc_name2(nt) = 'snwdph' !snowd - nt=nt+1 ; sfc_name2(nt) = 'shdmin' - nt=nt+1 ; sfc_name2(nt) = 'shdmax' - nt=nt+1 ; sfc_name2(nt) = 'slope' - nt=nt+1 ; sfc_name2(nt) = 'snoalb' - !--- variables below here are optional - nt=nt+1 ; sfc_name2(nt) = 'sncovr' - nt=nt+1 ; sfc_name2(nt) = 'snodl' !snowd on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'weasdl'!weasd on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'tsfc' !tsfc composite - nt=nt+1 ; sfc_name2(nt) = 'tsfcl' !temp on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'zorlw' !zorl on water portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'zorll' !zorl on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'zorli' !zorl on ice portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'albdirvis_lnd' - nt=nt+1 ; sfc_name2(nt) = 'albdirnir_lnd' - nt=nt+1 ; sfc_name2(nt) = 'albdifvis_lnd' - nt=nt+1 ; sfc_name2(nt) = 'albdifnir_lnd' - nt=nt+1 ; sfc_name2(nt) = 'emis_lnd' - nt=nt+1 ; sfc_name2(nt) = 'emis_ice' - nt=nt+1 ; sfc_name2(nt) = 'sncovr_ice' - nt=nt+1 ; sfc_name2(nt) = 'snodi' ! snowd on ice portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'weasdi'! weasd on ice portion of a cell - - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - nt=nt+1 ; sfc_name2(nt) = 'albdirvis_ice' - nt=nt+1 ; sfc_name2(nt) = 'albdifvis_ice' - nt=nt+1 ; sfc_name2(nt) = 'albdirnir_ice' - nt=nt+1 ; sfc_name2(nt) = 'albdifnir_ice' - endif - - if(Model%cplwav) then - nt=nt+1 ; sfc_name2(nvar_s2m) = 'zorlwav' !zorl from wave component - endif - - if (Model%nstf_name(1) > 0) then - !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) - nt=nt+1 ; sfc_name2(nt) = 'tref' - nt=nt+1 ; sfc_name2(nt) = 'z_c' - nt=nt+1 ; sfc_name2(nt) = 'c_0' - nt=nt+1 ; sfc_name2(nt) = 'c_d' - nt=nt+1 ; sfc_name2(nt) = 'w_0' - nt=nt+1 ; sfc_name2(nt) = 'w_d' - nt=nt+1 ; sfc_name2(nt) = 'xt' - nt=nt+1 ; sfc_name2(nt) = 'xs' - nt=nt+1 ; sfc_name2(nt) = 'xu' - nt=nt+1 ; sfc_name2(nt) = 'xv' - nt=nt+1 ; sfc_name2(nt) = 'xz' - nt=nt+1 ; sfc_name2(nt) = 'zm' - nt=nt+1 ; sfc_name2(nt) = 'xtts' - nt=nt+1 ; sfc_name2(nt) = 'xzts' - nt=nt+1 ; sfc_name2(nt) = 'd_conv' - nt=nt+1 ; sfc_name2(nt) = 'ifd' - nt=nt+1 ; sfc_name2(nt) = 'dt_cool' - nt=nt+1 ; sfc_name2(nt) = 'qrain' - endif -! -! Only needed when Noah MP LSM is used - 29 2D -! - if (Model%lsm == Model%lsm_noahmp) then - nt=nt+1 ; sfc_name2(nt) = 'snowxy' - nt=nt+1 ; sfc_name2(nt) = 'tvxy' - nt=nt+1 ; sfc_name2(nt) = 'tgxy' - nt=nt+1 ; sfc_name2(nt) = 'canicexy' - nt=nt+1 ; sfc_name2(nt) = 'canliqxy' - nt=nt+1 ; sfc_name2(nt) = 'eahxy' - nt=nt+1 ; sfc_name2(nt) = 'tahxy' - nt=nt+1 ; sfc_name2(nt) = 'cmxy' - nt=nt+1 ; sfc_name2(nt) = 'chxy' - nt=nt+1 ; sfc_name2(nt) = 'fwetxy' - nt=nt+1 ; sfc_name2(nt) = 'sneqvoxy' - nt=nt+1 ; sfc_name2(nt) = 'alboldxy' - nt=nt+1 ; sfc_name2(nt) = 'qsnowxy' - nt=nt+1 ; sfc_name2(nt) = 'wslakexy' - nt=nt+1 ; sfc_name2(nt) = 'zwtxy' - nt=nt+1 ; sfc_name2(nt) = 'waxy' - nt=nt+1 ; sfc_name2(nt) = 'wtxy' - nt=nt+1 ; sfc_name2(nt) = 'lfmassxy' - nt=nt+1 ; sfc_name2(nt) = 'rtmassxy' - nt=nt+1 ; sfc_name2(nt) = 'stmassxy' - nt=nt+1 ; sfc_name2(nt) = 'woodxy' - nt=nt+1 ; sfc_name2(nt) = 'stblcpxy' - nt=nt+1 ; sfc_name2(nt) = 'fastcpxy' - nt=nt+1 ; sfc_name2(nt) = 'xsaixy' - nt=nt+1 ; sfc_name2(nt) = 'xlaixy' - nt=nt+1 ; sfc_name2(nt) = 'taussxy' - nt=nt+1 ; sfc_name2(nt) = 'smcwtdxy' - nt=nt+1 ; sfc_name2(nt) = 'deeprechxy' - nt=nt+1 ; sfc_name2(nt) = 'rechxy' - else if (Model%lsm == Model%lsm_ruc .and. warm_start) then - nt=nt+1 ; sfc_name2(nt) = 'wetness' - nt=nt+1 ; sfc_name2(nt) = 'clw_surf_land' - nt=nt+1 ; sfc_name2(nt) = 'clw_surf_ice' - nt=nt+1 ; sfc_name2(nt) = 'qwv_surf_land' - nt=nt+1 ; sfc_name2(nt) = 'qwv_surf_ice' - nt=nt+1 ; sfc_name2(nt) = 'tsnow_land' - nt=nt+1 ; sfc_name2(nt) = 'tsnow_ice' - nt=nt+1 ; sfc_name2(nt) = 'snowfall_acc_land' - nt=nt+1 ; sfc_name2(nt) = 'snowfall_acc_ice' - nt=nt+1 ; sfc_name2(nt) = 'sfalb_lnd' - nt=nt+1 ; sfc_name2(nt) = 'sfalb_lnd_bck' - nt=nt+1 ; sfc_name2(nt) = 'sfalb_ice' - if (Model%rdlai) then - nt=nt+1 ; sfc_name2(nt) = 'lai' - endif - else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then - nt=nt+1 ; sfc_name2(nt) = 'lai' - endif - - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - nt=nt+1 ; sfc_name2(nt) = 'T_snow' - nt=nt+1 ; sfc_name2(nt) = 'T_ice' - nt=nt+1 ; sfc_name2(nt) = 'h_ML' - nt=nt+1 ; sfc_name2(nt) = 't_ML' - nt=nt+1 ; sfc_name2(nt) = 't_mnw' - nt=nt+1 ; sfc_name2(nt) = 'h_talb' - nt=nt+1 ; sfc_name2(nt) = 't_talb' - nt=nt+1 ; sfc_name2(nt) = 't_bot1' - nt=nt+1 ; sfc_name2(nt) = 't_bot2' - nt=nt+1 ; sfc_name2(nt) = 'c_t' - endif - end subroutine fill_sfcprop_names - -!---------------------------------------------------------------------- -! sfc_prop_restart_read -!---------------------------------------------------------------------- -! creates and populates a data type which is then used to "register" -! restart variables with the GFDL FMS restart subsystem. -! calls a GFDL FMS routine to restore the data from a restart file. -! calculates sncovr if it is not present in the restart file. -! -! 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, ignore_rst_cksum) - !--- interface variable definitions - type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) - type (block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(inout) :: Model - type (domain2d), intent(in) :: fv_domain - logical, intent(in) :: warm_start - logical, intent(in) :: ignore_rst_cksum - !--- local variables - integer :: i, j, k, ix, lsoil, num, nb, i_start, j_start, i_end, j_end, nt, n - integer :: isc, iec, jsc, jec, npz, nx, ny - integer :: id_restart - integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 - integer :: nvar_oro_ls_ss - integer :: nvar_vegfr, nvar_soilfr - integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow - integer :: nvar_emi, nvar_dust12m, nvar_gbbepx, nvar_before_lake, nvar_s2l, nvar_rrfssd - integer, allocatable :: ii1(:), jj1(:) - real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() - real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() - 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() - real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_fr => NULL() - !--- local variables for sncovr calculation - 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 - - type(clm_lake_data_type) :: clm_lake - type(rrfs_sd_data_type) :: rrfs_sd_data - - nvar_o2 = 19 - nvar_oro_ls_ss = 10 - - nvar_vegfr = Model%nvegcat - nvar_soilfr = Model%nsoilcat - - if (Model%nstf_name(1) > 0) then - nvar_s2o = 18 - else - nvar_s2o = 0 - endif - if(Model%rrfs_sd) then - nvar_dust12m = 5 - nvar_rrfssd = 3 - nvar_emi = 1 - else - nvar_dust12m = 0 - nvar_rrfssd = 0 - nvar_emi = 0 - endif - - if (Model%lsm == Model%lsm_ruc .and. warm_start) then - if(Model%rdlai) then - nvar_s2r = 13 - else - nvar_s2r = 12 - end if - nvar_s3 = 5 - else - if(Model%rdlai) then - nvar_s2r = 1 - else - nvar_s2r = 0 - endif - nvar_s3 = 3 - endif - - if (Model%lsm == Model%lsm_noahmp) then - nvar_s2mp = 29 !mp 2D - nvar_s3mp = 5 !mp 3D - else - nvar_s2mp = 0 !mp 2D - nvar_s3mp = 0 !mp 3D - endif - - isc = Atm_block%isc - iec = Atm_block%iec - jsc = Atm_block%jsc - jec = Atm_block%jec - 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)) - allocate(oro_var2(nx,ny,nvar_o2)) - - allocate(oro_var3v(nx,ny,nvar_vegfr)) - allocate(oro_var3s(nx,ny,nvar_soilfr)) - - oro_var2 = -9999._kind_phys - - num = 1 ; oro_name2(num) = 'stddev' ! hprime(ix,1) - num = num + 1 ; oro_name2(num) = 'convexity' ! hprime(ix,2) - num = num + 1 ; oro_name2(num) = 'oa1' ! hprime(ix,3) - num = num + 1 ; oro_name2(num) = 'oa2' ! hprime(ix,4) - num = num + 1 ; oro_name2(num) = 'oa3' ! hprime(ix,5) - num = num + 1 ; oro_name2(num) = 'oa4' ! hprime(ix,6) - num = num + 1 ; oro_name2(num) = 'ol1' ! hprime(ix,7) - num = num + 1 ; oro_name2(num) = 'ol2' ! hprime(ix,8) - num = num + 1 ; oro_name2(num) = 'ol3' ! hprime(ix,9) - num = num + 1 ; oro_name2(num) = 'ol4' ! hprime(ix,10) - num = num + 1 ; oro_name2(num) = 'theta' ! hprime(ix,11) - num = num + 1 ; oro_name2(num) = 'gamma' ! hprime(ix,12) - num = num + 1 ; oro_name2(num) = 'sigma' ! hprime(ix,13) - num = num + 1 ; oro_name2(num) = 'elvmax' ! hprime(ix,14) - num = num + 1 ; oro_name2(num) = 'orog_filt' ! oro - num = num + 1 ; oro_name2(num) = 'orog_raw' ! oro_uf - num = num + 1 ; oro_name2(num) = 'land_frac' ! land fraction [0:1] - !--- variables below here are optional - num = num + 1 ; oro_name2(num) = 'lake_frac' ! lake fraction [0:1] - num = num + 1 ; oro_name2(num) = '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 n = 1,num - var2_p => oro_var2(:,:,n) - if (trim(oro_name2(n)) == 'lake_frac' .or. trim(oro_name2(n)) == 'lake_depth' ) then - call register_restart_field(Oro_restart, oro_name2(n), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) - else - call register_restart_field(Oro_restart, oro_name2(n), var2_p, dimensions=(/'lat','lon'/)) - endif - enddo - nullify(var2_p) - - !--- register 3D vegetation and soil fractions - var3_fr => oro_var3v(:,:,:) - call register_restart_field(Oro_restart, 'vegetation_type_pct', var3_fr, dimensions=(/'num_veg_cat','lat ','lon '/) , is_optional=.true.) - var3_fr => oro_var3s(:,:,:) - call register_restart_field(Oro_restart, 'soil_type_pct', var3_fr, dimensions=(/'num_soil_cat','lat ','lon '/) , is_optional=.true.) - nullify(var3_fr) - - endif - - !--- read the orography restart/data - call mpp_error(NOTE,'reading topographic/orographic information from INPUT/oro_data.tile*.nc') - call read_restart(Oro_restart, ignore_checksum=ignore_rst_cksum) - call close_file(Oro_restart) - - - !--- copy data into GFS containers - -!$omp parallel do default(shared) private(i, j, nb, ix, num) - do nb = 1, Atm_block%nblks - !--- 2D variables - 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 - !--- stddev -! Sfcprop(nb)%hprim(ix) = oro_var2(i,j,1) - !--- hprime(1:14) - num = 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro_var2(i,j,num) - !--- oro - num = num + 1 ; Sfcprop(nb)%oro(ix) = oro_var2(i,j,num) - num = num + 1 ; Sfcprop(nb)%oro_uf(ix) = oro_var2(i,j,num) - - Sfcprop(nb)%landfrac(ix) = -9999.0 - Sfcprop(nb)%lakefrac(ix) = -9999.0 - - num = num + 1 ; Sfcprop(nb)%landfrac(ix) = oro_var2(i,j,num) !land frac [0:1] - if (Model%lkm > 0 ) then - if(oro_var2(i,j,num+1)>Model%lakefrac_threshold .and. & - oro_var2(i,j,num+2)>Model%lakedepth_threshold) then - Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,num+1) !lake frac [0:1] - Sfcprop(nb)%lakedepth(ix) = oro_var2(i,j,num+2) !lake depth [m] !YWu - else - Sfcprop(nb)%lakefrac(ix) = 0 - Sfcprop(nb)%lakedepth(ix) = -9999 - endif - else - Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,num+1) !lake frac [0:1] - Sfcprop(nb)%lakedepth(ix) = oro_var2(i,j,num+2) !lake depth [m] !YWu - endif - num = num + 2 ! To account for lakefrac and lakedepth - - Sfcprop(nb)%vegtype_frac(ix,:) = -9999.0 - Sfcprop(nb)%soiltype_frac(ix,:) = -9999.0 - - Sfcprop(nb)%vegtype_frac(ix,:) = oro_var3v(i,j,:) ! vegetation type fractions, [0:1] - Sfcprop(nb)%soiltype_frac(ix,:) = oro_var3s(i,j,:) ! soil type fractions, [0:1] - - !do n=1,nvar_vegfr - ! if (Sfcprop(nb)%vegtype_frac(ix,n) > 0.) print *,'Sfcprop(nb)%vegtype_frac(ix,n)',Sfcprop(nb)%vegtype_frac(ix,n),n - !enddo - !do n=1,nvar_soilfr - ! if (Sfcprop(nb)%soiltype_frac(ix,n) > 0.) print *,'Sfcprop(nb)%soiltype_frac(ix,n)',Sfcprop(nb)%soiltype_frac(ix,n),n - !enddo - - enddo - enddo - - nvar_s2m = 48 - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - nvar_s2m = nvar_s2m + 4 -! nvar_s2m = nvar_s2m + 5 - endif - if (Model%cplwav) then - nvar_s2m = nvar_s2m + 1 - endif -! CLM Lake and Flake - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake ) then - nvar_s2l = 10 - else - nvar_s2l = 0 - endif - - nvar_before_lake=nvar_s2m+nvar_s2o+nvar_s2r+nvar_s2mp - - !--- deallocate containers and free restart container - deallocate(oro_name2, oro_var2) - deallocate(oro_var3v) - deallocate(oro_var3s) - - if_smoke: if(Model%rrfs_sd) then ! for RRFS-SD - - !--- Dust input FILE - !--- open file - infile=trim(indir)//'/'//trim(fn_dust12m) - amiopen=open_file(dust12m_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(dust12m_name)) then - !--- allocate the various containers needed for fengsha dust12m data - allocate(dust12m_name(nvar_dust12m)) - allocate(dust12m_var(nx,ny,12,nvar_dust12m)) - - dust12m_name(1) = 'clay' - dust12m_name(2) = 'rdrag' - dust12m_name(3) = 'sand' - dust12m_name(4) = 'ssm' - dust12m_name(5) = 'uthr' - - !--- register axis - call register_axis(dust12m_restart, 'lon', 'X') - call register_axis(dust12m_restart, 'lat', 'Y') - call register_axis(dust12m_restart, 'time', 12) - !--- register the 3D fields - do num = 1,nvar_dust12m - var3_p2 => dust12m_var(:,:,:,num) - call register_restart_field(dust12m_restart, dust12m_name(num), var3_p2, dimensions=(/'time', 'lat ', 'lon '/),& - &is_optional=.not.mand) - enddo - nullify(var3_p2) - endif - - !--- read new GSL created dust12m restart/data - call mpp_error(NOTE,'reading dust12m information from INPUT/dust12m_data.tile*.nc') - call read_restart(dust12m_restart) - call close_file(dust12m_restart) - - do nb = 1, Atm_block%nblks - !--- 3D variables - 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 - do k = 1, 12 - Sfcprop(nb)%dust12m_in(ix,k,1) = dust12m_var(i,j,k,1) - Sfcprop(nb)%dust12m_in(ix,k,2) = dust12m_var(i,j,k,2) - Sfcprop(nb)%dust12m_in(ix,k,3) = dust12m_var(i,j,k,3) - Sfcprop(nb)%dust12m_in(ix,k,4) = dust12m_var(i,j,k,4) - Sfcprop(nb)%dust12m_in(ix,k,5) = dust12m_var(i,j,k,5) - enddo - enddo - enddo - - deallocate(dust12m_name,dust12m_var) - - read_emi: if(nvar_emi>0) then - !--- open anthropogenic emission file - infile=trim(indir)//'/'//trim(fn_emi) - amiopen=open_file(emi_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(emi_name)) then - !--- allocate the various containers needed for anthropogenic emission data - if(allocated(emi_name)) deallocate(emi_name) - if(allocated(emi_var)) deallocate(emi_var) - allocate(emi_name(nvar_emi)) - allocate(emi_var(nx,ny,1,nvar_emi)) - - emi_name(1) = 'e_oc' - !--- register axis - call register_axis( emi_restart, 'time', 1) ! only read first time level, even if multiple are present - call register_axis( emi_restart, "grid_xt", 'X' ) - call register_axis( emi_restart, "grid_yt", 'Y' ) - !--- register the 2D fields - do num = 1,nvar_emi - var3_p2 => emi_var(:,:,:,num) - call register_restart_field(emi_restart, emi_name(num), var3_p2, dimensions=(/'time ','grid_yt','grid_xt'/)) - enddo - nullify(var3_p2) - !endif - - !--- read anthropogenic emi restart/data - call mpp_error(NOTE,'reading emi information from INPUT/emi_data.tile*.nc') - call read_restart(emi_restart) - call close_file(emi_restart) - - do num=1,nvar_emi - do nb = 1, Atm_block%nblks - !--- 2D variables - 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 - Sfcprop(nb)%emi_in(ix,num) = emi_var(i,j,1,num) - enddo - enddo - enddo - - !--- deallocate containers and free restart container - deallocate(emi_name, emi_var) - endif read_emi - - !--- Dust input FILE - !--- open file - infile=trim(indir)//'/'//trim(fn_rrfssd) - amiopen=open_file(rrfssd_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(rrfssd_name)) then - !--- allocate the various containers needed for rrfssd fire data - allocate(rrfssd_name(nvar_rrfssd)) - allocate(rrfssd_var(nx,ny,24,nvar_rrfssd)) - - rrfssd_name(1) = 'ebb_smoke_hr' - rrfssd_name(2) = 'frp_avg_hr' - rrfssd_name(3) = 'frp_std_hr' - - !--- register axis - call register_axis(rrfssd_restart, 'lon', 'X') - call register_axis(rrfssd_restart, 'lat', 'Y') - call register_axis(rrfssd_restart, 't', 24) - !--- register the 3D fields - mand = .false. - do num = 1,nvar_rrfssd - var3_p2 => rrfssd_var(:,:,:,num) - call register_restart_field(rrfssd_restart, rrfssd_name(num), var3_p2, dimensions=(/'t ', 'lat', 'lon'/),& - &is_optional=.not.mand) - enddo - nullify(var3_p2) - endif - - !--- read new GSL created rrfssd restart/data - call mpp_error(NOTE,'reading rrfssd information from INPUT/SMOKE_RRFS_data.nc') - call read_restart(rrfssd_restart) - call close_file(rrfssd_restart) - - do nb = 1, Atm_block%nblks - !--- 3D variables - 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 - !--- assign hprime(1:10) and hprime(15:24) with new oro stat data - do k = 1, 24 - Sfcprop(nb)%smoke_RRFS(ix,k,1) = rrfssd_var(i,j,k,1) - Sfcprop(nb)%smoke_RRFS(ix,k,2) = rrfssd_var(i,j,k,2) - Sfcprop(nb)%smoke_RRFS(ix,k,3) = rrfssd_var(i,j,k,3) - enddo - enddo - enddo - - deallocate(rrfssd_name, rrfssd_var) - endif if_smoke ! RRFS_SD - - !--- 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)) - allocate(oro_ls_var(nx,ny,nvar_oro_ls_ss)) - allocate(oro_ss_var(nx,ny,nvar_oro_ls_ss)) - - oro_ls_ss_name(1) = 'stddev' - oro_ls_ss_name(2) = 'convexity' - oro_ls_ss_name(3) = 'oa1' - oro_ls_ss_name(4) = 'oa2' - oro_ls_ss_name(5) = 'oa3' - oro_ls_ss_name(6) = 'oa4' - oro_ls_ss_name(7) = 'ol1' - oro_ls_ss_name(8) = 'ol2' - oro_ls_ss_name(9) = 'ol3' - oro_ls_ss_name(10) = 'ol4' - - 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) - 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) - call register_restart_field(Oro_ss_restart, oro_ls_ss_name(num), var2_p, dimensions=(/'lon','lat'/)) - enddo - nullify(var2_p) - 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 read_restart(Oro_ls_restart, ignore_checksum=ignore_rst_cksum) - call close_file(Oro_ls_restart) - call mpp_error(NOTE,'reading topographic/orographic information from & - &INPUT/oro_data_ss.tile*.nc') - call read_restart(Oro_ss_restart, ignore_checksum=ignore_rst_cksum) - call close_file(Oro_ss_restart) - - - do nb = 1, Atm_block%nblks - !--- 2D variables - 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 - ! Replace hprime(1:10) with GSL oro stat data only when using GSL - ! drag suite with large scale GWD and blocking as part of unified drag - ! suite. Otherwise, original oro stat data is used. - if ( (Model%gwd_opt==3 .or. Model%gwd_opt==33) .or. & - ( (Model%gwd_opt==2 .or. Model%gwd_opt==22) .and. & - Model%do_gsl_drag_ls_bl ) ) then - !--- assign hprime(1:10) and hprime(15:24) with new oro stat data - Sfcprop(nb)%hprime(ix,1) = oro_ls_var(i,j,1) - Sfcprop(nb)%hprime(ix,2) = oro_ls_var(i,j,2) - Sfcprop(nb)%hprime(ix,3) = oro_ls_var(i,j,3) - Sfcprop(nb)%hprime(ix,4) = oro_ls_var(i,j,4) - Sfcprop(nb)%hprime(ix,5) = oro_ls_var(i,j,5) - Sfcprop(nb)%hprime(ix,6) = oro_ls_var(i,j,6) - Sfcprop(nb)%hprime(ix,7) = oro_ls_var(i,j,7) - Sfcprop(nb)%hprime(ix,8) = oro_ls_var(i,j,8) - Sfcprop(nb)%hprime(ix,9) = oro_ls_var(i,j,9) - Sfcprop(nb)%hprime(ix,10) = oro_ls_var(i,j,10) - endif - Sfcprop(nb)%hprime(ix,15) = oro_ss_var(i,j,1) - Sfcprop(nb)%hprime(ix,16) = oro_ss_var(i,j,2) - Sfcprop(nb)%hprime(ix,17) = oro_ss_var(i,j,3) - Sfcprop(nb)%hprime(ix,18) = oro_ss_var(i,j,4) - Sfcprop(nb)%hprime(ix,19) = oro_ss_var(i,j,5) - Sfcprop(nb)%hprime(ix,20) = oro_ss_var(i,j,6) - Sfcprop(nb)%hprime(ix,21) = oro_ss_var(i,j,7) - Sfcprop(nb)%hprime(ix,22) = oro_ss_var(i,j,8) - Sfcprop(nb)%hprime(ix,23) = oro_ss_var(i,j,9) - Sfcprop(nb)%hprime(ix,24) = oro_ss_var(i,j,10) - enddo - enddo - - 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)) - - if (.not. allocated(sfc_name2)) then - !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) - allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) - allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) - ! Note that this may cause problems with RUC LSM for coldstart runs from GFS data - ! if the initial conditions do contain this variable, because Model%kice is 9 for - ! RUC LSM, but tiice in the initial conditions will only have two vertical layers - allocate(sfc_var3ice(nx,ny,Model%kice)) - - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then - allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3)) - else if (Model%lsm == Model%lsm_ruc) then - allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar_s3)) - end if - - sfc_var2 = -9999.0_r8 - sfc_var3 = -9999.0_r8 - sfc_var3ice= -9999.0_r8 -! - if (Model%lsm == Model%lsm_noahmp) then - allocate(sfc_var3sn(nx,ny,-2:0,4:6)) - allocate(sfc_var3eq(nx,ny,1:4,7:7)) - allocate(sfc_var3zn(nx,ny,-2:4,8:8)) - sfc_var3sn = -9999.0_r8 - sfc_var3eq = -9999.0_r8 - sfc_var3zn = -9999.0_r8 - end if - - call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,warm_start) - - 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) 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 - - ! Tell CLM Lake to allocate data, and register its axes and fields - if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then - call clm_lake%allocate_data(Model) - call clm_lake%copy_to_temporaries(Model,Sfcprop,Atm_block) - call clm_lake%register_axes(Model, Sfc_restart) - call clm_lake%register_fields(Sfc_restart) - endif - - if(Model%rrfs_sd) then - call rrfs_sd_data%allocate_data(Model) - call rrfs_sd_data%fill_data(Model, Sfcprop, Atm_block) - call rrfs_sd_data%register_axis(Model) - call rrfs_sd_data%register_fields - endif - - !--- register the 2D fields - do num = 1,nvar_s2m - 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)) == 'snodi' .or. trim(sfc_name2(num)) == 'weasdi' & - .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' .or. trim(sfc_name2(num)) == 'emis_ice' & - .or. trim(sfc_name2(num)) == 'sncovr_ice') 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 - 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 - - 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) - 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) - 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) - 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 - -! Flake - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - mand = .false. - do num = nvar_before_lake+1,nvar_before_lake+nvar_s2l - 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 - - nullify(var2_p) - endif ! if not allocated - - - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) 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 2D variables to save - sfc_name3(1) = 'tslb' - sfc_name3(2) = 'smois' - sfc_name3(3) = 'sh2o' - sfc_name3(4) = 'smfr' - sfc_name3(5) = 'flfr' - endif - - !--- register the 3D fields - 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 '/),& - &is_optional=.true.) - - do num = 1,nvar_s3 - 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) - 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) - 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) - 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) - -!--- Noah MP define arbitrary value (number layers of snow) to indicate -!coldstart(sfcfile doesn't include noah mp fields) or not - - if (Model%lsm == Model%lsm_noahmp) then - sfc_var2(1,1,nvar_s2m+19) = -66666.0_r8 - endif - - !--- read the surface restart/data - call mpp_error(NOTE,'reading surface properties data from INPUT/sfc_data.tile*.nc') - call read_restart(Sfc_restart, ignore_checksum=ignore_rst_cksum) - call close_file(Sfc_restart) - - ! Tell clm_lake to copy data to temporary arrays - if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then - call clm_lake%copy_from_temporaries(Model,Sfcprop,Atm_block) - endif - - if(Model%rrfs_sd) then - call rrfs_sd_data%copy_from_temporaries(Model,Sfcprop,Atm_block) - end if - -! 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)) -! write(0,*)' sfc_var2=',sfc_var2(:,:,12) - - !--- place the data into the block GFS containers - -!$omp parallel do default(shared) private(i, j, nb, ix, nt, ii1, jj1, lsoil) - block_loop: do nb = 1, Atm_block%nblks - allocate(ii1(Atm_block%blksz(nb))) - allocate(jj1(Atm_block%blksz(nb))) - ii1=Atm_block%index(nb)%ii - isc + 1 - jj1=Atm_block%index(nb)%jj - jsc + 1 - - nt=0 - -!--- 2D variables -! ------------ - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%slmsk) !--- slmsk - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfco) !--- tsfc (tsea in sfc file) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasd) !--- weasd (sheleg in sfc file) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tg3) !--- tg3 - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorl) !--- zorl composite - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alvsf) !--- alvsf - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alvwf) !--- alvwf - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alnsf) !--- alnsf - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alnwf) !--- alnwf - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%facsf) !--- facsf - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%facwf) !--- facwf - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%vfrac) !--- vfrac - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canopy) !--- canopy - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%f10m) !--- f10m - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t2m) !--- t2m - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%q2m) !--- q2m - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%vtype) !--- vtype - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stype) !--- stype - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%uustar) !--- uustar - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ffmm) !--- ffmm - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ffhh) !--- ffhh - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%hice) !--- hice - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fice) !--- fice - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tisfc) !--- tisfc - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tprcp) !--- tprcp - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%srflag) !--- srflag - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowd) !--- snowd (snwdph in the file) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%shdmin) !--- shdmin - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%shdmax) !--- shdmax - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%slope) !--- slope - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snoalb) !--- snoalb - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sncovr) !--- sncovr - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snodl) !--- snodl (snowd on land portion of a cell) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasdl) !--- weasdl (weasd on land portion of a cell) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfc) !--- tsfc composite - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfcl) !--- tsfcl (temp on land portion of a cell) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorlw) !--- zorlw (zorl on water portion of a cell) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorll) !--- zorll (zorl on land portion of a cell) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorli) !--- zorli (zorl on ice portion of a cell) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirvis_lnd) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirnir_lnd) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifvis_lnd) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifnir_lnd) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%emis_lnd) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%emis_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sncovr_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snodi) !--- snodi (snowd on ice portion of a cell) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasdi) !--- weasdi (weasd on ice portion of a cell) - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirvis_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifvis_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirnir_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifnir_ice) -! call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_ice) - endif - if(Model%cplwav) then - !tgs - the following line is a bug. It should be nt = nt - !nt = nvar_s2m-1 ! Next item will be at nvar_s2m - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorlwav) !--- (zorl from wave model) - else - Sfcprop(nb)%zorlwav = Sfcprop(nb)%zorlw - endif - - do_lsi_fractions: do ix = 1, Atm_block%blksz(nb) - 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 - Sfcprop(nb)%lakefrac(ix) = one - endif - endif - - if_frac_grid: 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. 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 - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 - endif - endif - else - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 - endif - endif - endif - else - Model%frac_grid = .false. - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - else - if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then - Sfcprop(nb)%landfrac(ix) = zero - if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%oceanfrac(ix) = zero - else ! ocean - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - endif - endif - endif - endif - else ! not a fractional grid - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%slmsk(ix) = zero - 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. Sfcprop(nb)%stype(ix) == 14) & - Sfcprop(nb)%slmsk(ix) = zero - if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 - else - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - endif - endif - else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & - .and. Sfcprop(nb)%stype(ix) /= 14) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - else - Sfcprop(nb)%slmsk(ix) = zero - Sfcprop(nb)%landfrac(ix) = zero - if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%oceanfrac(ix) = zero - if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - else ! ocean - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 - endif - endif - endif - endif if_frac_grid - enddo do_lsi_fractions - - if (warm_start .and. Model%kdt > 1) then - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%slmsk(ix) = sfc_var2(ii1(ix),jj1(ix),1) !--- slmsk - enddo - endif - - ! - !--- NSSTM variables - !tgs - the following line is a bug that will show if(Model%cplwav) = true - !nt = nvar_s2m - if (Model%nstf_name(1) > 0) then - if (Model%nstf_name(2) == 1) then ! nsst spinup - !--- nsstm tref - nt = nt + 18 - Sfcprop(nb)%tref = Sfcprop(nb)%tsfco - Sfcprop(nb)%z_c = zero - Sfcprop(nb)%c_0 = zero - Sfcprop(nb)%c_d = zero - Sfcprop(nb)%w_0 = zero - Sfcprop(nb)%w_d = zero - Sfcprop(nb)%xt = zero - Sfcprop(nb)%xs = zero - Sfcprop(nb)%xu = zero - Sfcprop(nb)%xv = zero - Sfcprop(nb)%xz = 20.0_r8 - Sfcprop(nb)%zm = zero - Sfcprop(nb)%xtts = zero - Sfcprop(nb)%xzts = zero - Sfcprop(nb)%d_conv = zero - Sfcprop(nb)%ifd = zero - Sfcprop(nb)%dt_cool = zero - Sfcprop(nb)%qrain = zero - elseif (Model%nstf_name(2) == 0) then ! nsst restart - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tref) !--- nsstm tref - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%z_c) !--- nsstm z_c - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_0) !--- nsstm c_0 - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_d) !--- nsstm c_d - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%w_0) !--- nsstm w_0 - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%w_d) !--- nsstm w_d - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xt) !--- nsstm xt - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xs) !--- nsstm xs - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xu) !--- nsstm xu - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xv) !--- nsstm xv - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xz) !--- nsstm xz - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zm) !--- nsstm zm - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xtts) !--- nsstm xtts - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xzts) !--- nsstm xzts - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%d_conv) !--- nsstm d_conv - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ifd) !--- nsstm ifd - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%dt_cool) !--- nsstm dt_cool - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qrain) !--- nsstm qrain - endif - endif - - if (Model%lsm == Model%lsm_ruc .and. warm_start) then - !--- Extra RUC variables - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wetness) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%clw_surf_land) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%clw_surf_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qwv_surf_land) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qwv_surf_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsnow_land) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsnow_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowfallac_land) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowfallac_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_lnd) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_lnd_bck) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_ice) - if (Model%rdlai) then - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - endif - else if (Model%lsm == Model%lsm_ruc) then - ! Initialize RUC snow cover on ice from snow cover - Sfcprop(nb)%sncovr_ice = Sfcprop(nb)%sncovr - if (Model%rdlai) then - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - end if - elseif (Model%lsm == Model%lsm_noahmp) then - !--- Extra Noah MP variables - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tvxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tgxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canicexy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canliqxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%eahxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tahxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%cmxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%chxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fwetxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sneqvoxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alboldxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qsnowxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wslakexy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zwtxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%waxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wtxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%lfmassxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%rtmassxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stmassxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%woodxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stblcpxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fastcpxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xsaixy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%taussxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%smcwtdxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%deeprechxy) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%rechxy) - endif - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%T_snow) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%T_ice) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%h_ML) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_ML) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_mnw) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%h_talb) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_talb) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_bot1) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_bot2) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_t) - endif - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then - !--- 3D variables - nt=0 - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil,sfc_var3,Sfcprop(nb)%stc) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil,sfc_var3,Sfcprop(nb)%smc) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil,sfc_var3,Sfcprop(nb)%slc) - - if (Model%lsm == Model%lsm_noahmp) then - ! These use weird indexing which is lost during a Fortran subroutine call, so we use loops instead: - nt=nt+1 - do lsoil = -2, 0 - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%snicexy(ix,lsoil) = sfc_var3sn(ii1(ix),jj1(ix),lsoil,nt) - enddo - enddo - - nt=nt+1 - do lsoil = -2, 0 - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%snliqxy(ix,lsoil) = sfc_var3sn(ii1(ix),jj1(ix),lsoil,nt) - enddo - enddo - - nt=nt+1 - do lsoil = -2, 0 - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tsnoxy(ix,lsoil) = sfc_var3sn(ii1(ix),jj1(ix),lsoil,nt) - enddo - enddo - - nt=nt+1 - do lsoil = 1, 4 - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%smoiseq(ix,lsoil) = sfc_var3eq(ii1(ix),jj1(ix),lsoil,nt) - enddo - enddo - - nt=nt+1 - do lsoil = -2, 4 - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zsnsoxy(ix,lsoil) = sfc_var3zn(ii1(ix),jj1(ix),lsoil,nt) - enddo - enddo - endif - - else if (Model%lsm == Model%lsm_ruc) then - !--- 3D variables - nt=0 - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil_lsm,sfc_var3,Sfcprop(nb)%tslb) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil_lsm,sfc_var3,Sfcprop(nb)%smois) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil_lsm,sfc_var3,Sfcprop(nb)%sh2o) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil_lsm,sfc_var3,Sfcprop(nb)%keepsmfr) - call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,1,Model%lsoil_lsm,sfc_var3,Sfcprop(nb)%flag_frsoil) - endif - - do k = 1,Model%kice - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tiice(ix,k) = sfc_var3ice(ii1(ix),jj1(ix),k) !--- internal ice temp - enddo - enddo - - deallocate(ii1,jj1) - - end do block_loop - call mpp_error(NOTE, 'gfs_driver:: - after put to container ') - -! so far: At cold start everything is 9999.0, warm start snowxy has values -! but the 3D of snow fields are not available because not allocated yet. -! ix,nb loops may be consolidate with the Noah MP isnowxy init -! restore traditional vars first,we need some of them to init snow fields -! snow depth to actual snow layers; so we can allocate and register -! note zsnsoxy is from -2:4 - isnowxy is from 0:-2, but we need -! exact snow layers to pass 3D fields correctly, snow layers are -! different fro grid to grid, we have to init point by point/grid. -! It has to be done after the weasd is available -! sfc_var2(1,1,32) is the first; we need this to allocate snow related fields - - i = Atm_block%index(1)%ii(1) - isc + 1 - j = Atm_block%index(1)%jj(1) - jsc + 1 - - if (sfc_var2(i,j,33) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodl') -!$omp parallel do default(shared) private(nb, ix, tem) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%landfrac(ix) > zero) then - tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) - Sfcprop(nb)%snodl(ix) = Sfcprop(nb)%snowd(ix) * tem - else - Sfcprop(nb)%snodl(ix) = zero - endif - enddo - enddo - endif - - if (sfc_var2(i,j,34) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasdl') -!$omp parallel do default(shared) private(nb, ix, tem) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%landfrac(ix) > zero) then - tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) - Sfcprop(nb)%weasdl(ix) = Sfcprop(nb)%weasd(ix) * tem - else - Sfcprop(nb)%weasdl(ix) = zero - endif - enddo - enddo - endif - - if (sfc_var2(i,j,36) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) !--- compute tsfcl from existing variables - enddo - enddo - endif - - if (sfc_var2(i,j,37) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlw') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%landfrac(ix) < one .and. Sfcprop(nb)%fice(ix) < one) then - Sfcprop(nb)%zorlw(ix) = min(Sfcprop(nb)%zorl(ix), 0.317) - endif - enddo - enddo - endif - - if (sfc_var2(i,j,38) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorll') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorl(ix) !--- compute zorll from existing variables - enddo - enddo - endif - - if (sfc_var2(i,j,39) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix)) > zero) then - Sfcprop(nb)%zorli(ix) = one - endif - enddo - enddo - endif - - if (sfc_var2(i,j,45) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing emis_ice') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%emis_ice(ix) = 0.96 - enddo - enddo - endif - - if (sfc_var2(i,j,46) < -9990.0_r8 .and. Model%lsm /= Model%lsm_ruc) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr_ice') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) -! Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) - Sfcprop(nb)%sncovr_ice(ix) = zero - enddo - enddo - endif - - if (sfc_var2(i,j,47) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodi') -!$omp parallel do default(shared) private(nb, ix, tem) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%fice(ix) > zero) then - tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) - Sfcprop(nb)%snodi(ix) = min(Sfcprop(nb)%snowd(ix) * tem, 3.0) - else - Sfcprop(nb)%snodi(ix) = zero - endif - enddo - enddo - endif - - if (sfc_var2(i,j,48) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasdi') -!$omp parallel do default(shared) private(nb, ix, tem) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%fice(ix) > zero) then - tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) - Sfcprop(nb)%weasdi(ix) = Sfcprop(nb)%weasd(ix)*tem - else - Sfcprop(nb)%weasdi(ix) = zero - endif - enddo - enddo - endif - - if (Model%use_cice_alb) then - if (sfc_var2(i,j,49) < -9990.0_r8) then -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%oceanfrac(ix) > zero .and. & - Sfcprop(nb)%fice(ix) >= Model%min_seaice) then - Sfcprop(nb)%albdirvis_ice(ix) = 0.6_kind_phys - Sfcprop(nb)%albdifvis_ice(ix) = 0.6_kind_phys - Sfcprop(nb)%albdirnir_ice(ix) = 0.6_kind_phys - Sfcprop(nb)%albdifnir_ice(ix) = 0.6_kind_phys - endif - enddo - enddo - endif - - endif - - ! Fill in composite tsfc for coldstart runs - must happen after tsfcl is computed - compute_tsfc_for_colstart: if (sfc_var2(i,j,35) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing composite tsfc') - if(Model%frac_grid) then ! 3-way composite -!$omp parallel do default(shared) private(nb, ix, tem, tem1) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) ! this may break restart reproducibility - tem1 = one - Sfcprop(nb)%landfrac(ix) - tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & - + Sfcprop(nb)%tisfc(ix) * tem & - + Sfcprop(nb)%tsfco(ix) * (tem1-tem) - enddo - enddo - else -!$omp parallel do default(shared) private(nb, ix, tem) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - if (Sfcprop(nb)%slmsk(ix) == 1) then - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) - else - tem = one - Sfcprop(nb)%fice(ix) - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & - + Sfcprop(nb)%tsfco(ix) * tem - endif - enddo - enddo - endif - endif compute_tsfc_for_colstart - - if (sfc_var2(i,j,nvar_s2m) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlwav') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorl(ix) !--- compute zorlwav from existing variables - enddo - enddo - endif - - if (nint(sfc_var3ice(1,1,1)) == -9999) then !--- initialize internal ice temp from layer 1 and 2 soil temp - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tiice(ix,1) = max(timin, min(con_tice, Sfcprop(nb)%stc(ix,1))) - Sfcprop(nb)%tiice(ix,2) = max(timin, min(con_tice, Sfcprop(nb)%stc(ix,2))) - enddo - enddo - endif - - ! A standard-compliant Fortran 2003 compiler will call clm_lake_final and rrfs_sd_final here. - - end subroutine sfc_prop_restart_read - - -!---------------------------------------------------------------------- -! sfc_prop_restart_write -!---------------------------------------------------------------------- -! routine to write out GFS surface restarts via the GFDL FMS restart -! subsystem. -! takes an optional argument to append timestamps for intermediate -! restarts. -! -! calls: register_restart_field, save_restart -!---------------------------------------------------------------------- - subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timestamp) - !--- interface variable definitions - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(in) :: Model - type(domain2d), intent(in) :: fv_domain - character(len=32), optional, intent(in) :: timestamp - !--- local variables - integer :: i, j, k, nb, ix, lsoil, num, nt - integer :: isc, iec, jsc, jec, npz, nx, ny - integer :: id_restart - integer :: nvar2m, nvar2o, nvar3 - integer :: nvar2r, nvar2mp, nvar3mp, nvar_before_lake, nvar2l - logical :: mand - integer, allocatable :: ii1(:), jj1(:) - character(len=32) :: fn_srf = 'sfc_data.nc' - real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() - real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() - 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() - real(kind_phys) :: ice - !--- 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 - type(clm_lake_data_type), target :: clm_lake - !--- temporary variables for storing rrfs_sd fields - type(rrfs_sd_data_type) :: rrfs_sd_data - - nvar2m = 48 - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - nvar2m = nvar2m + 4 -! nvar2m = nvar2m + 5 - endif - if (Model%cplwav) nvar2m = nvar2m + 1 - if (Model%nstf_name(1) > 0) then - nvar2o = 18 - else - nvar2o = 0 - endif - if (Model%lsm == Model%lsm_ruc) then - if (Model%rdlai) then - nvar2r = 13 - else - nvar2r = 12 - endif - nvar3 = 5 - else - nvar2r = 0 - nvar3 = 3 - endif - nvar2mp = 0 - nvar3mp = 0 - if (Model%lsm == Model%lsm_noahmp) then - nvar2mp = 29 - nvar3mp = 5 - endif -!CLM Lake and Flake - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - nvar2l = 10 - else - nvar2l = 0 - endif - - nvar_before_lake=nvar2m+nvar2o+nvar2r+nvar2mp - - isc = Atm_block%isc - iec = Atm_block%iec - jsc = Atm_block%jsc - jec = Atm_block%jec - npz = Atm_block%npz - nx = (iec - isc + 1) - ny = (jec - jsc + 1) - - nvar_before_lake=nvar2m+nvar2o+nvar2r+nvar2mp - - if (Model%lsm == Model%lsm_ruc) then - if (allocated(sfc_name2)) then - ! Re-allocate if one or more of the dimensions don't match - if (size(sfc_name2).ne.nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l .or. & - size(sfc_name3).ne.nvar3+nvar3mp .or. & - size(sfc_var3,dim=3).ne.Model%lsoil_lsm) then - !--- deallocate containers and free restart container - deallocate(sfc_name2) - deallocate(sfc_name3) - deallocate(sfc_var2) - deallocate(sfc_var3) - 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: 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) 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_amiopen - - ! Tell clm_lake to allocate data, register its axes, and call write_data for each axis's variable - if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then - call clm_lake%allocate_data(Model) - call clm_lake%register_axes(Model, Sfc_restart) - call clm_lake%write_axes(Model, Sfc_restart) - endif - - if(Model%rrfs_sd) then - call rrfs_sd_data%allocate_data(Model) - call rrfs_sd_data%register_axis(Model) - call rrfs_sd_data%write_axis(Model) - end if - - if (.not. allocated(sfc_name2)) then - !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) - allocate(sfc_name3(0:nvar3+nvar3mp)) - allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then - allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) - elseif (Model%lsm == Model%lsm_ruc) then - allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar3)) - endif - sfc_var2 = -9999.0_r8 - sfc_var3 = -9999.0_r8 - if (Model%lsm == Model%lsm_noahmp) then - allocate(sfc_var3sn(nx,ny,-2:0,4:6)) - allocate(sfc_var3eq(nx,ny,1:4,7:7)) - allocate(sfc_var3zn(nx,ny,-2:4,8:8)) - - sfc_var3sn = -9999.0_r8 - sfc_var3eq = -9999.0_r8 - sfc_var3zn = -9999.0_r8 - endif - call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar2m,.true.) - end if - - if(Model%lkm>0) then - if(Model%iopt_lake==Model%iopt_lake_flake ) then - if(Model%me==0) then - if(size(sfc_name2)/=nvar_before_lake+10) then -3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar_before_lake+10=",I0) - write(0,3814) size(sfc_name2),nvar_before_lake+10 - endif - endif - else if(Model%iopt_lake==Model%iopt_lake_clm) then - ! Tell clm_lake to register all of its fields - call clm_lake%register_fields(Sfc_restart) - endif - endif - - if(Model%rrfs_sd) then - call rrfs_sd_data%register_fields - endif - - !--- 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)) == 'snodi' .or. trim(sfc_name2(num)) == 'weasdi' & - .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' .or. trim(sfc_name2(num)) == 'emis_ice' & - .or. trim(sfc_name2(num)) == 'sncovr_ice' ) 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) - 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) 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(:,:,:) - 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) - 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) - call register_restart_field(Sfc_restart, sfc_name3(num), var3_p1, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/),& - &is_optional=.not.mand) - enddo - - 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 - - !Flake - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - mand = .false. - do num = nvar_before_lake+1,nvar_before_lake+nvar2l - 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 - - ! Tell clm_lake to copy Sfcprop data to its internal temporary arrays. - if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then - call clm_lake%copy_to_temporaries(Model,Sfcprop,Atm_block) - endif - - if(Model%rrfs_sd) then - call rrfs_sd_data%copy_to_temporaries(Model,Sfcprop,Atm_block) - endif - -!$omp parallel do default(shared) private(i, j, nb, ix, nt, ii1, jj1, lsoil, k, ice) - block_loop: do nb = 1, Atm_block%nblks - allocate(ii1(Atm_block%blksz(nb))) - allocate(jj1(Atm_block%blksz(nb))) - ii1=Atm_block%index(nb)%ii - isc + 1 - jj1=Atm_block%index(nb)%jj - jsc + 1 - - nt=0 - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%slmsk) !--- slmsk - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfco) !--- tsfc (tsea in sfc file) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasd) !--- weasd (sheleg in sfc file) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tg3) !--- tg3 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorl) !--- zorl - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alvsf) !--- alvsf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alvwf) !--- alvwf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alnsf) !--- alnsf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alnwf) !--- alnwf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%facsf) !--- facsf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%facwf) !--- facwf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%vfrac) !--- vfrac - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canopy)!--- canopy - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%f10m) !--- f10m - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t2m) !--- t2m - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%q2m) !--- q2m - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%vtype) !--- vtype - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stype) !--- stype - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%uustar)!--- uustar - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ffmm) !--- ffmm - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ffhh) !--- ffhh - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%hice) !--- hice - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fice) !--- fice - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tisfc) !--- tisfc - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tprcp) !--- tprcp - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%srflag)!--- srflag - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowd) !--- snowd (snwdph in the file) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%shdmin)!--- shdmin - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%shdmax)!--- shdmax - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%slope) !--- slope - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snoalb)!--- snoalb - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sncovr) !--- sncovr - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snodl) !--- snodl (snowd on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasdl) !--- weasdl (weasd on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfc) !--- tsfc composite - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfcl) !--- tsfcl (temp on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorlw) !--- zorl (zorl on water) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorll) !--- zorll (zorl on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorli) !--- zorli (zorl on ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirvis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirnir_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifvis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifnir_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%emis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%emis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sncovr_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snodi) !--- snodi (snowd on ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasdi) !--- weasdi (weasd on ice) - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirvis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifvis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirnir_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifnir_ice) -! sfc_var2(i,j,53) = Sfcprop(nb)%sfalb_ice(ix) - endif - if (Model%cplwav) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorlwav) !--- zorlwav (zorl from wav) - endif - !--- NSSTM variables - if (Model%nstf_name(1) > 0) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tref) !--- nsstm tref - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%z_c) !--- nsstm z_c - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_0) !--- nsstm c_0 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_d) !--- nsstm c_d - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%w_0) !--- nsstm w_0 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%w_d) !--- nsstm w_d - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xt) !--- nsstm xt - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xs) !--- nsstm xs - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xu) !--- nsstm xu - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xv) !--- nsstm xv - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xz) !--- nsstm xz - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zm) !--- nsstm zm - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xtts) !--- nsstm xtts - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xzts) !--- nsstm xzts - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%d_conv) !--- nsstm d_conv - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ifd) !--- nsstm ifd - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%dt_cool)!--- nsstm dt_cool - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qrain) !--- nsstm qrain - endif - - if (Model%lsm == Model%lsm_ruc) then - !--- Extra RUC variables - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wetness) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%clw_surf_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%clw_surf_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qwv_surf_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qwv_surf_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsnow_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsnow_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowfallac_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowfallac_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_lnd_bck) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_ice) - if (Model%rdlai) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - endif - else if (Model%lsm == Model%lsm_noahmp) then - !--- Extra Noah MP variables - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tvxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tgxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canicexy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canliqxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%eahxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tahxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%cmxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%chxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fwetxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sneqvoxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alboldxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qsnowxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wslakexy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zwtxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%waxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wtxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%lfmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%rtmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%woodxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stblcpxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fastcpxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xsaixy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%taussxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%smcwtdxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%deeprechxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%rechxy) - endif -! Flake - if(Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%T_snow) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%T_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%h_ML) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_ML) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_mnw) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%h_talb) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_talb) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_bot1) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t_bot2) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_t) - endif - do k = 1,Model%kice - do ix = 1, Atm_block%blksz(nb) - ice=Sfcprop(nb)%tiice(ix,k) - if(ice 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 - jsc = Atm_block%jsc - jec = Atm_block%jec - npz = Atm_block%npz - nx = (iec - isc + 1) - ny = (jec - jsc + 1) - - nvar2d = GFS_Restart%num2d - 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)) - allocate (phy_var3(nx,ny,npz,nvar3d)) - phy_var2 = zero - phy_var3 = zero - - 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) - 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, ignore_checksum=ignore_rst_cksum) - 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) - do num = 1,nvar2d - do nb = 1,Atm_block%nblks - 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 - GFS_Restart%data(nb,num)%var2p(ix) = phy_var2(i,j,num) - enddo - enddo - enddo - !-- if restart from init time, reset accumulated diag fields - if( Model%phour < 1.e-7) then - do num = fdiag,ldiag -!$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1,Atm_block%nblks - 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 - GFS_Restart%data(nb,num)%var2p(ix) = zero - enddo - enddo - enddo - endif - do num = 1,nvar3d -!$omp parallel do default(shared) private(i, j, k, nb, ix) - do nb = 1,Atm_block%nblks - do k=1,npz - 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 - GFS_Restart%data(nb,num)%var3p(ix,k) = phy_var3(i,j,k,num) - enddo - enddo - enddo - enddo - - end subroutine phys_restart_read - - -!---------------------------------------------------------------------- -! phys_restart_write -!---------------------------------------------------------------------- -! routine to write out GFS surface restarts via the GFDL FMS restart -! subsystem. -! takes an optional argument to append timestamps for intermediate -! restarts. -! -! calls: register_restart_field, save_restart -!---------------------------------------------------------------------- - subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) - !--- interface variable definitions - type(GFS_restart_type), intent(in) :: GFS_Restart - type(block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(in) :: Model - type(domain2d), intent(in) :: fv_domain - character(len=32), optional, intent(in) :: timestamp - !--- local variables - integer :: i, j, k, nb, ix, num - integer :: isc, iec, jsc, jec, npz, nx, ny - integer :: id_restart - 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 - jsc = Atm_block%jsc - jec = Atm_block%jec - npz = Atm_block%npz - nx = (iec - isc + 1) - ny = (jec - jsc + 1) - nvar2d = GFS_Restart%num2d - nvar3d = GFS_Restart%num3d - - !--- 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 - 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) - 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) - enddo - enddo - enddo - !--- 3D variables -!$omp parallel do default(shared) private(i, j, k, num, nb, ix) - do num = 1,nvar3d - do nb = 1,Atm_block%nblks - do k=1,npz - 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) - enddo - enddo - enddo - enddo - - call write_restart(Phy_restart) - call close_file(Phy_restart) - - end subroutine phys_restart_write - -!------------------------------------------------------------------------- -!--- gfdl_diag_register --- -!------------------------------------------------------------------------- -! creates and populates a data type which is then used to "register" -! GFS physics diagnostic variables with the GFDL FMS diagnostic manager. -! includes short & long names, units, conversion factors, etc. -! there is no copying of data, but instead a clever use of pointers. -! calls a GFDL FMS routine to register diagnositcs and compare against -! the diag_table to determine what variables are to be output. -! -! calls: register_diag_field -!------------------------------------------------------------------------- - subroutine fv3gfs_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) - use physcons, only: con_g -!--- subroutine interface variable definitions - type(GFS_externaldiag_type), intent(inout) :: Diag(:) - type(time_type), intent(in) :: Time - type (block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(in) :: Model - real(kind=kind_phys), intent(in) :: xlon(:,:) - real(kind=kind_phys), intent(in) :: xlat(:,:) - integer, dimension(4), intent(in) :: axes -!--- local variables - integer :: idx, nrgst_bl, nrgst_nb, nrgst_vctbl - - isco = Atm_block%isc - ieco = Atm_block%iec - jsco = Atm_block%jsc - jeco = Atm_block%jec - levo = model%levs - fhzero = nint(Model%fhzero) -! ncld = Model%ncld - ncld = Model%imp_physics - nsoil = Model%lsoil - dtp = Model%dtp - imp_physics = Model%imp_physics - landsfcmdl = Model%lsm -! print *,'in fv3gfs_diag_register,ncld=',Model%ncld,Model%lsoil,Model%imp_physics, & -! ' dtp=',dtp,' landsfcmdl=',Model%lsm -! -!save lon/lat for vector interpolation - allocate(lon(isco:ieco,jsco:jeco)) - allocate(lat(isco:ieco,jsco:jeco)) - lon = xlon - lat = xlat - - do idx = 1,DIAG_SIZE - if (trim(Diag(idx)%name) == '') exit - tot_diag_idx = idx - enddo - - if (tot_diag_idx == DIAG_SIZE) then - call mpp_error(fatal, 'FV3GFS_io::fv3gfs_diag_register - need to increase parameter DIAG_SIZE') - endif - - allocate(nstt(tot_diag_idx), nstt_vctbl(tot_diag_idx)) - nstt = 0 - nstt_vctbl = 0 - nrgst_bl = 0 - nrgst_nb = 0 - nrgst_vctbl = 0 - num_axes_phys = 2 - do idx = 1,tot_diag_idx - if (diag(idx)%axes == -99) then - call mpp_error(fatal, 'gfs_driver::gfs_diag_register - attempt to register an undefined variable') - endif - Diag(idx)%id = register_diag_field (trim(Diag(idx)%mod_name), trim(Diag(idx)%name), & - axes(1:Diag(idx)%axes), Time, trim(Diag(idx)%desc), & - trim(Diag(idx)%unit), missing_value=real(missing_value)) - if(Diag(idx)%id > 0) then - if (Diag(idx)%axes == 2) then - if( index(trim(Diag(idx)%intpl_method),'bilinear') > 0 ) then - nrgst_bl = nrgst_bl + 1 - nstt(idx) = nrgst_bl - else if (trim(Diag(idx)%intpl_method) == 'nearest_stod' ) then - nrgst_nb = nrgst_nb + 1 - nstt(idx) = nrgst_nb - endif - if(trim(Diag(idx)%intpl_method) == 'vector_bilinear') then - if(Diag(idx)%name(1:1) == 'v' .or. Diag(idx)%name(1:1) == 'V') then - nrgst_vctbl = nrgst_vctbl + 1 - nstt_vctbl(idx) = nrgst_vctbl -! print *,'in phy_setup, vector_bilinear, name=', trim(Diag(idx)%name),' nstt_vctbl=', nstt_vctbl(idx), 'idx=',idx - endif - endif - else if (diag(idx)%axes == 3) then - if( index(trim(diag(idx)%intpl_method),'bilinear') > 0 ) then - nstt(idx) = nrgst_bl + 1 - nrgst_bl = nrgst_bl + levo - else if (trim(diag(idx)%intpl_method) == 'nearest_stod' ) then - nstt(idx) = nrgst_nb + 1 - nrgst_nb = nrgst_nb + levo - endif - if(trim(diag(idx)%intpl_method) == 'vector_bilinear') then - if(diag(idx)%name(1:1) == 'v' .or. diag(idx)%name(1:1) == 'V') then - nstt_vctbl(idx) = nrgst_vctbl + 1 - nrgst_vctbl = nrgst_vctbl + levo -! print *,'in phy_setup, vector_bilinear, name=', trim(diag(idx)%name),' nstt_vctbl=', nstt_vctbl(idx), 'idx=',idx - endif - endif - num_axes_phys = 3 - endif - endif - - enddo - - total_outputlevel = nrgst_bl + nrgst_nb - allocate(buffer_phys_bl(isco:ieco,jsco:jeco,nrgst_bl)) - allocate(buffer_phys_nb(isco:ieco,jsco:jeco,nrgst_nb)) - allocate(buffer_phys_windvect(3,isco:ieco,jsco:jeco,nrgst_vctbl)) - buffer_phys_bl = zero - buffer_phys_nb = zero - buffer_phys_windvect = zero - if(mpp_pe() == mpp_root_pe()) print *,'in fv3gfs_diag_register, nrgst_bl=',nrgst_bl,' nrgst_nb=',nrgst_nb, & - ' nrgst_vctbl=',nrgst_vctbl, 'isco=',isco,ieco,'jsco=',jsco,jeco,' num_axes_phys=', num_axes_phys - - end subroutine fv3gfs_diag_register -!------------------------------------------------------------------------- - - -!------------------------------------------------------------------------- -!--- gfs_diag_output --- -!------------------------------------------------------------------------- -! routine to transfer the diagnostic data to the gfdl fms diagnostic -! manager for eventual output to the history files. -! -! calls: send_data -!------------------------------------------------------------------------- - subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & - dt, time_int, time_intfull, time_radsw, time_radlw) -!--- subroutine interface variable definitions - type(time_type), intent(in) :: time - type(GFS_externaldiag_type), intent(in) :: diag(:) - type (block_control_type), intent(in) :: atm_block - integer, intent(in) :: nx, ny, levs, ntcw, ntoz - real(kind=kind_phys), intent(in) :: dt - real(kind=kind_phys), intent(in) :: time_int - real(kind=kind_phys), intent(in) :: time_intfull - real(kind=kind_phys), intent(in) :: time_radsw - real(kind=kind_phys), intent(in) :: time_radlw -!--- local variables - integer :: i, j, k, idx, nblks, nb, ix, ii, jj - integer :: is_in, js_in, isc, jsc - character(len=2) :: xtra -#ifdef CCPP_32BIT - real, dimension(nx*ny) :: var2p - real, dimension(nx*ny,levs) :: var3p - real, dimension(nx,ny) :: var2 - real, dimension(nx,ny,levs) :: var3 -#else - real(kind=kind_phys), dimension(nx*ny) :: var2p - real(kind=kind_phys), dimension(nx*ny,levs) :: var3p - real(kind=kind_phys), dimension(nx,ny) :: var2 - real(kind=kind_phys), dimension(nx,ny,levs) :: var3 -#endif - real(kind=kind_phys) :: rdt, rtime_int, rtime_intfull, lcnvfac - real(kind=kind_phys) :: rtime_radsw, rtime_radlw - logical :: used - - nblks = atm_block%nblks - rdt = one/dt - rtime_int = one/time_int - rtime_intfull = one/time_intfull - rtime_radsw = one/time_radsw - rtime_radlw = one/time_radlw - - isc = atm_block%isc - jsc = atm_block%jsc - is_in = atm_block%isc - js_in = atm_block%jsc - -! if(mpp_pe()==mpp_root_pe())print *,'in,fv3gfs_io. time avg, time_int=',time_int - do idx = 1,tot_diag_idx - if (diag(idx)%id > 0) then - lcnvfac = diag(idx)%cnvfac - if (diag(idx)%time_avg) then - if ( trim(diag(idx)%time_avg_kind) == 'full' ) then - lcnvfac = lcnvfac*rtime_intfull -! if(mpp_pe()==mpp_root_pe())print *,'in,fv3gfs_io. full time avg, field=',trim(Diag(idx)%name),' time=',time_intfull - else if ( trim(diag(idx)%time_avg_kind) == 'rad_lw' ) then - lcnvfac = lcnvfac*min(rtime_radlw,rtime_int) -! if(mpp_pe()==mpp_root_pe())print *,'in,fv3gfs_io. rad longwave avg, field=',trim(Diag(idx)%name),' time=',time_radlw - else if ( trim(diag(idx)%time_avg_kind) == 'rad_sw' ) then - lcnvfac = lcnvfac*min(rtime_radsw,rtime_int) -! if(mpp_pe()==mpp_root_pe())print *,'in,fv3gfs_io. rad shortwave avg, field=',trim(Diag(idx)%name),' time=',time_radsw - else if ( trim(diag(idx)%time_avg_kind) == 'rad_swlw_min' ) then - lcnvfac = lcnvfac*min(max(rtime_radsw,rtime_radlw),rtime_int) -! if(mpp_pe()==mpp_root_pe())print *,'in,fv3gfs_io. rad swlw min avg, field=',trim(Diag(idx)%name),' time=',time_radlw,time_radsw,time_int - else - lcnvfac = lcnvfac*rtime_int - endif - endif - if (diag(idx)%axes == 2) then - ! 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 - 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 - 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 - 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 - 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 - 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) - enddo - enddo - 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)*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) -! if(trim(Diag(idx)%name) == 'totprcp_ave' ) print *,'in gfs_io, totprcp=',Diag(idx)%data(1)%var2(1:3), & -! ' lcnvfac=', lcnvfac - elseif (Diag(idx)%axes == 3) then - !--- - !--- skipping other 3D variables with the following else statement - !--- -! if(mpp_pe()==mpp_root_pe())print *,'in,fv3gfs_io. 3D fields, idx=',idx,'varname=',trim(diag(idx)%name), & -! 'lcnvfac=',lcnvfac, 'levo=',levo,'nx=',nx,'ny=',ny - do k=1, levo - 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(mpp_pe()==mpp_root_pe())print *,'in,fv3gfs_io,sze(Diag(idx)%data(nb)%var3)=', & -! size(Diag(idx)%data(nb)%var3,1),size(Diag(idx)%data(nb)%var3,2) - var3(i,j,k) = Diag(idx)%data(nb)%var3(ix,levo-k+1)*lcnvfac - enddo - enddo - enddo - call store_data3D(Diag(idx)%id, var3, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) -#ifdef JUNK - else - !--- temperature tendency - if (trim(Diag(idx)%name) == 'dtemp_dt') then - var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%tgrs(1:ngptc,levs:1:-1), (/nx,ny,levs/)) - var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gt0(1:ngptc,levs:1:-1), (/nx,ny,levs/)) & - - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) - endif - !--- horizontal wind component tendency - if (trim(Diag(idx)%name) == 'du_dt') then - var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%ugrs(1:ngptc,levs:1:-1), (/nx,ny,levs/)) - var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gu0(1:ngptc,levs:1:-1), (/nx,ny,levs/)) & - - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) - endif - !--- meridional wind component tendency - if (trim(Diag(idx)%name) == 'dv_dt') then - var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%vgrs(1:ngptc,levs:1:-1), (/nx,ny,levs/)) - var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gv0(1:ngptc,levs:1:-1), (/nx,ny,levs/)) & - - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) - endif - !--- specific humidity tendency - if (trim(Diag(idx)%name) == 'dsphum_dt') then - var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%qgrs(1:ngptc,levs:1:-1,1:1), (/nx,ny,levs/)) - var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gq0(1:ngptc,levs:1:-1,1:1), (/nx,ny,levs/)) & - - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) - endif - !--- cloud water mixing ration tendency - if (trim(Diag(idx)%name) == 'dclwmr_dt') then - var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%qgrs(1:ngptc,levs:1:-1,ntcw:ntcw), (/nx,ny,levs/)) - var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gq0(1:ngptc,levs:1:-1,ntcw:ntcw), (/nx,ny,levs/)) & - - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) - endif - !--- ozone mixing ration tendency -#ifdef MULTI_GASES - if (trim(Diag(idx)%name) == 'dspo3_dt') then -#else - if (trim(Diag(idx)%name) == 'do3mr_dt') then -#endif - var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%qgrs(1:ngptc,levs:1:-1,ntoz:ntoz), (/nx,ny,levs/)) - var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gq0(1:ngptc,levs:1:-1,ntoz:ntoz), (/nx,ny,levs/)) & - - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) - endif -#endif - endif - endif - enddo - - - end subroutine fv3gfs_diag_output -! -!------------------------------------------------------------------------- - subroutine store_data(id, work, Time, idx, intpl_method, fldname) - integer, intent(in) :: id - integer, intent(in) :: idx -#ifdef CCPP_32BIT - real, intent(in) :: work(:,:) -#else - real(kind=kind_phys), intent(in) :: work(ieco-isco+1,jeco-jsco+1) -#endif - type(time_type), intent(in) :: Time - character(*), intent(in) :: intpl_method - character(*), intent(in) :: fldname -! - real(kind=kind_phys) :: sinlat, sinlon, coslon - integer k,j,i,kb,nv,i1,j1 - logical used -! - if( id > 0 ) then - if( use_wrtgridcomp_output ) then - if( trim(intpl_method) == 'bilinear') then -!$omp parallel do default(shared) private(i,j) - do j= jsco,jeco - do i= isco,ieco - buffer_phys_bl(i,j,nstt(idx)) = work(i-isco+1,j-jsco+1) - enddo - enddo - else if(trim(intpl_method) == 'nearest_stod') then -!$omp parallel do default(shared) private(i,j) - do j= jsco,jeco - do i= isco,ieco - buffer_phys_nb(i,j,nstt(idx)) = work(i-isco+1,j-jsco+1) - enddo - enddo - else if(trim(intpl_method) == 'vector_bilinear') then -!first save the data -!$omp parallel do default(shared) private(i,j) - do j= jsco,jeco - do i= isco,ieco - buffer_phys_bl(i,j,nstt(idx)) = work(i-isco+1,j-jsco+1) - enddo - enddo - if( fldname(1:1) == 'u' .or. fldname(1:1) == 'U') then - if(.not.allocated(uwork)) allocate(uwork(isco:ieco,jsco:jeco)) -!$omp parallel do default(shared) private(i,j) - do j= jsco,jeco - do i= isco,ieco - uwork(i,j) = work(i-isco+1,j-jsco+1) - enddo - enddo - uwindname = fldname - uwork_set = .true. - endif - if( fldname(1:1) == 'v' .or. fldname(1:1) == 'V') then -!set up wind vector - if( uwork_set .and. trim(uwindname(2:)) == trim(fldname(2:))) then - nv = nstt_vctbl(idx) -!$omp parallel do default(shared) private(i,j,i1,j1,sinlat,sinlon,coslon) - do j= jsco,jeco - j1 = j-jsco+1 - do i= isco,ieco - i1 = i-isco+1 - sinlat = sin(lat(i,j)) - sinlon = sin(lon(i,j)) - coslon = cos(lon(i,j)) - buffer_phys_windvect(1,i,j,nv) = uwork(i,j)*coslon - work(i1,j1)*sinlat*sinlon - buffer_phys_windvect(2,i,j,nv) = uwork(i,j)*sinlon + work(i1,j1)*sinlat*coslon - buffer_phys_windvect(3,i,j,nv) = work(i1,j1)*cos(lat(i,j)) - enddo - enddo - endif - uwork = zero - uwindname = '' - uwork_set = .false. - endif - - endif - else - used = send_data(id, work, Time) - endif - endif -! - end subroutine store_data -! -!------------------------------------------------------------------------- -! - subroutine store_data3D(id, work, Time, idx, intpl_method, fldname) - integer, intent(in) :: id - integer, intent(in) :: idx -#ifdef CCPP_32BIT - real, intent(in) :: work(:,:,:) -#else - real(kind=kind_phys), intent(in) :: work(ieco-isco+1,jeco-jsco+1,levo) -#endif - type(time_type), intent(in) :: Time - character(*), intent(in) :: intpl_method - character(*), intent(in) :: fldname -! - real(kind=kind_phys), allocatable, dimension(:,:) :: sinlon, coslon, sinlat, coslat - integer k,j,i,kb,nv,i1,j1 - logical used -! - if( id > 0 ) then - if( use_wrtgridcomp_output ) then - if( trim(intpl_method) == 'bilinear') then -!$omp parallel do default(shared) private(i,j,k) - do k= 1,levo - do j= jsco,jeco - do i= isco,ieco - buffer_phys_bl(i,j,nstt(idx)+k-1) = work(i-isco+1,j-jsco+1,k) - enddo - enddo - enddo - else if(trim(intpl_method) == 'nearest_stod') then -!$omp parallel do default(shared) private(i,j,k) - do k= 1,levo - do j= jsco,jeco - do i= isco,ieco - buffer_phys_nb(i,j,nstt(idx)+k-1) = work(i-isco+1,j-jsco+1,k) - enddo - enddo - enddo - else if(trim(intpl_method) == 'vector_bilinear') then -!first save the data -!$omp parallel do default(shared) private(i,j,k) - do k= 1,levo - do j= jsco,jeco - do i= isco,ieco - buffer_phys_bl(i,j,nstt(idx)+k-1) = work(i-isco+1,j-jsco+1,k) - enddo - enddo - enddo - if( fldname(1:1) == 'u' .or. fldname(1:1) == 'U') then - if(.not.allocated(uwork3d)) allocate(uwork3d(isco:ieco,jsco:jeco,levo)) -!$omp parallel do default(shared) private(i,j,k) - do k= 1, levo - do j= jsco,jeco - do i= isco,ieco - uwork3d(i,j,k) = work(i-isco+1,j-jsco+1,k) - enddo - enddo - enddo - uwindname = fldname - uwork_set = .true. - endif - if( fldname(1:1) == 'v' .or. fldname(1:1) == 'V') then -!set up wind vector - if( uwork_set .and. trim(uwindname(2:)) == trim(fldname(2:))) then - allocate (sinlon(isco:ieco,jsco:jeco), coslon(isco:ieco,jsco:jeco), & - sinlat(isco:ieco,jsco:jeco), coslat(isco:ieco,jsco:jeco)) -!$omp parallel do default(shared) private(i,j) - do j= jsco,jeco - do i= isco,ieco - sinlon(i,j) = sin(lon(i,j)) - coslon(i,j) = cos(lon(i,j)) - sinlat(i,j) = sin(lat(i,j)) - coslat(i,j) = cos(lat(i,j)) - enddo - enddo -!$omp parallel do default(shared) private(i,j,k,nv,i1,j1) - do k= 1, levo - nv = nstt_vctbl(idx)+k-1 - do j= jsco,jeco - j1 = j-jsco+1 - do i= isco,ieco - i1 = i-isco+1 - buffer_phys_windvect(1,i,j,nv) = uwork3d(i,j,k)*coslon(i,j) & - - work(i1,j1,k)*sinlat(i,j)*sinlon(i,j) - buffer_phys_windvect(2,i,j,nv) = uwork3d(i,j,k)*sinlon(i,j) & - + work(i1,j1,k)*sinlat(i,j)*coslon(i,j) - buffer_phys_windvect(3,i,j,nv) = work(i1,j1,k)*coslat(i,j) - enddo - enddo - enddo - deallocate (sinlon, coslon, sinlat, coslat) - endif - uwork3d = zero - uwindname = '' - uwork_set = .false. - endif - - endif - else - used = send_data(id, work, Time) - endif - endif -! - end subroutine store_data3D -! -!------------------------------------------------------------------------- -! -#ifdef use_WRTCOMP - - subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys, rc) -! -!------------------------------------------------------------- -!*** set esmf bundle for phys output fields -!------------------------------------------------------------ -! - use esmf - use diag_data_mod, ONLY: diag_atttype -! - implicit none -! - type(GFS_externaldiag_type),intent(in) :: Diag(:) - integer, intent(in) :: axes(:) - type(ESMF_FieldBundle),intent(inout) :: phys_bundle(:) - type(ESMF_Grid),intent(inout) :: fcst_grid - logical,intent(in) :: quilting - integer, intent(in) :: nbdlphys - integer,intent(out) :: rc - -! -!*** local variables - integer i, j, k, n, idx, ibdl, nbdl - integer id, axis_length, direction, edges, axis_typ - integer num_attributes, num_field_dyn - integer currdate(6) - character(2) axis_id - character(255) :: units, long_name, cart_name, axis_direct, edgesS - character(128) :: output_name, physbdl_name, outputfile1 - logical :: lput2physbdl, loutputfile, l2dvector - type(domain1d) :: Domain - type(domainUG) :: DomainU - type(ESMF_Field) :: field - real,dimension(:),allocatable :: axis_data - character(128),dimension(:), allocatable :: bdl_intplmethod, outputfile - type(diag_atttype),dimension(:),allocatable :: attributes - real(4),dimension(:,:),pointer :: dataPtr2d -! - logical isPresent - integer udimCount - character(80),dimension(:),allocatable :: udimList -! -!------------------------------------------------------------ -!--- use wrte grid component for output - use_wrtgridcomp_output = quilting -! if(mpp_pe()==mpp_root_pe())print *,'in fv_phys bundle,use_wrtgridcomp_output=',use_wrtgridcomp_output, & -! print *,'in fv_phys bundle,use_wrtgridcomp_output=',use_wrtgridcomp_output, & -! 'isco=',isco,ieco,'jsco=',jsco,jeco,'tot_diag_idx=',tot_diag_idx -! -!------------------------------------------------------------ -!*** add attributes to the bundle such as subdomain limtis, -!*** axes, output time, etc -!------------------------------------------------------------ -! - allocate(bdl_intplmethod(nbdlphys), outputfile(nbdlphys)) - if(mpp_pe()==mpp_root_pe()) print *,'in fv_phys bundle,nbdl=',nbdlphys - do ibdl = 1, nbdlphys - loutputfile = .false. - call ESMF_FieldBundleGet(phys_bundle(ibdl), name=physbdl_name,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - idx = index(physbdl_name,'_bilinear') - if(idx > 0) then - outputfile(ibdl) = physbdl_name(1:idx-1) - bdl_intplmethod(ibdl) = 'bilinear' - loutputfile = .true. - endif - idx = index(physbdl_name,'_nearest_stod') - if(idx > 0) then - outputfile(ibdl) = physbdl_name(1:idx-1) - bdl_intplmethod(ibdl) = 'nearest_stod' - loutputfile = .true. - endif - if( .not. loutputfile) then - outputfile(ibdl) = 'phy' - bdl_intplmethod(ibdl) = 'nearest_stod' - endif -! print *,'in fv_phys bundle,i=',ibdl,'outputfile=',trim(outputfile(ibdl)), & -! 'bdl_intplmethod=',trim(bdl_intplmethod(ibdl)) - - call ESMF_AttributeAdd(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & - attrList=(/"fhzero ", "ncld ", "nsoil ",& - "imp_physics", "dtp ", "landsfcmdl "/), rc=rc) - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & - name="fhzero", value=fhzero, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & - name="ncld", value=ncld, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & - name="nsoil", value=nsoil, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & - name="imp_physics", value=imp_physics, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & - name="dtp", value=dtp, rc=rc) -! print *,'in fcst gfdl diag, dtp=',dtp,' ibdl=',ibdl - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & - name="landsfcmdl", value=landsfcmdl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -!end ibdl - enddo -! -!*** get axis names - allocate(axis_name(num_axes_phys)) - do id = 1,num_axes_phys - call get_diag_axis_name( axes(id), axis_name(id)) - enddo - isPresent = .false. - if( num_axes_phys>2 ) then - allocate(axis_name_vert(num_axes_phys-2)) - do id=3,num_axes_phys - axis_name_vert(id-2) = axis_name(id) - enddo -! - call ESMF_AttributeGet(fcst_grid, convention="NetCDF", purpose="FV3", & - name="vertical_dim_labels", isPresent=isPresent, & - itemCount=udimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (isPresent .and. (udimCount>num_axes_phys-2) ) then - allocate(udimList(udimCount)) - call ESMF_AttributeGet(fcst_grid, convention="NetCDF", purpose="FV3", & - name="vertical_dim_labels", valueList=udimList, rc=rc) -! if(mpp_pe()==mpp_root_pe()) print *,'in fv3gfsio, vertical -! list=',udimList(1:udimCount),'rc=',rc - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - else - - if(mpp_pe()==mpp_root_pe()) print *,'in fv_dyn bundle,axis_name_vert=',axis_name_vert - call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & - attrList=(/"vertical_dim_labels"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & - name="vertical_dim_labels", valueList=axis_name_vert, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - deallocate(axis_name_vert) - endif - -!*** add attributes - if(allocated(all_axes)) deallocate(all_axes) - allocate(all_axes(num_axes_phys)) - all_axes(1:num_axes_phys) = axes(1:num_axes_phys) - if (.not. isPresent .or. (udimCount2 ) then -! if(mpp_pe()==mpp_root_pe()) print *,' in dyn add grid, axis_name=', & -! trim(axis_name(id)),'axis_data=',axis_data - if(trim(edgesS)/='') then - call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & - attrList=(/trim(axis_name(id)),trim(axis_name(id))//":long_name", & - trim(axis_name(id))//":units", trim(axis_name(id))//":cartesian_axis", & - trim(axis_name(id))//":positive", trim(axis_name(id))//":edges"/), rc=rc) - else - call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & - attrList=(/trim(axis_name(id)),trim(axis_name(id))//":long_name", & - trim(axis_name(id))//":units", trim(axis_name(id))//":cartesian_axis", & - trim(axis_name(id))//":positive"/), rc=rc) - endif - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & - name=trim(axis_name(id)), valueList=axis_data, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & - name=trim(axis_name(id))//":long_name", value=trim(long_name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & - name=trim(axis_name(id))//":units", value=trim(units), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & - name=trim(axis_name(id))//":cartesian_axis", value=trim(cart_name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if(direction > 0) then - axis_direct = "up" - else - axis_direct = "down" - endif - call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & - name=trim(axis_name(id))//":positive", value=trim(axis_direct), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if(trim(edgesS)/='') then - call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & - name=trim(axis_name(id))//":edges", value=trim(edgesS), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - - endif -! - deallocate(axis_data) - enddo - endif -! print *,'in setup fieldbundle_phys, num_axes_phys=',num_axes_phys,'tot_diag_idx=',tot_diag_idx, & -! 'nbdlphys=',nbdlphys -! -!----------------------------------------------------------------------------------------- -!*** add esmf fields -! - do idx= 1,tot_diag_idx - - lput2physbdl = .false. - do ibdl = 1, nbdlphys - - if( index(trim(Diag(idx)%intpl_method),trim(bdl_intplmethod(ibdl))) > 0) then - lput2physbdl = .true. - if( Diag(idx)%id > 0 ) then - call find_output_name(trim(Diag(idx)%mod_name),trim(Diag(idx)%name),output_name) - -!add origin field - call add_field_to_phybundle(trim(output_name),trim(Diag(idx)%desc),trim(Diag(idx)%unit), "time: point", & - axes(1:Diag(idx)%axes), fcst_grid, nstt(idx), phys_bundle(ibdl), outputfile(ibdl), & - bdl_intplmethod(ibdl), rcd=rc) -! if( mpp_pe() == mpp_root_pe()) print *,'phys, add field,',trim(Diag(idx)%name),'idx=',idx,'ibdl=',ibdl -! - if( index(trim(Diag(idx)%intpl_method), "vector") > 0) then - l2dvector = .true. - if (nstt_vctbl(idx) > 0) then - output_name = 'wind'//trim(output_name)//'vector' - outputfile1 = 'none' - call add_field_to_phybundle(trim(output_name),trim(Diag(idx)%desc),trim(Diag(idx)%unit), "time: point", & - axes(1:Diag(idx)%axes), fcst_grid, nstt_vctbl(idx),phys_bundle(ibdl), outputfile1, & - bdl_intplmethod(ibdl),l2dvector=l2dvector, rcd=rc) -! if( mpp_pe() == mpp_root_pe()) print *,'in phys, add vector field,',trim(Diag(idx)%name),' idx=',idx,' ibdl=',ibdl - endif - endif - - endif - endif - enddo - if( .not. lput2physbdl ) then - if( mpp_pe() == mpp_root_pe()) print *,'WARNING: not matching interpolation method, field ',trim(Diag(idx)%name), & - ' is not added to phys bundle ' - endif - - enddo - deallocate(axis_name) - deallocate(all_axes) - - end subroutine fv_phys_bundle_setup -! -!----------------------------------------------------------------------------------------- - subroutine add_field_to_phybundle(var_name,long_name,units,cell_methods, axes,phys_grid, & - kstt,phys_bundle,output_file,intpl_method,range,l2dvector,rcd) -! - use esmf -! - implicit none - - character(*), intent(in) :: var_name, long_name, units, cell_methods - character(*), intent(in) :: output_file, intpl_method - integer, intent(in) :: axes(:) - type(esmf_grid), intent(in) :: phys_grid - integer, intent(in) :: kstt - type(esmf_fieldbundle),intent(inout) :: phys_bundle - real, intent(in), optional :: range(2) - logical, intent(in), optional :: l2dvector - integer, intent(out), optional :: rcd -! -!*** local variable - type(ESMF_Field) :: field - type(ESMF_DataCopy_Flag) :: copyflag=ESMF_DATACOPY_REFERENCE - integer rc, i, j, idx - real(4),dimension(:,:),pointer :: temp_r2d - real(4),dimension(:,:,:),pointer :: temp_r3d - logical :: l2dvector_local -! - ! fix for non-standard compilers (e.g. PGI) - l2dvector_local = .false. - if (present(l2dvector)) then - if (l2dvector) then - l2dvector_local = .true. - end if - end if -! -!*** create esmf field - if (l2dvector_local .and. size(axes)==2) then - temp_r3d => buffer_phys_windvect(1:3,isco:ieco,jsco:jeco,kstt) -! if( mpp_root_pe() == 0) print *,'phys, create wind vector esmf field' - call ESMF_LogWrite('bf create winde vector esmf field '//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -!datacopyflag=ESMF_DATACOPY_VALUE, & - field = ESMF_FieldCreate(phys_grid, temp_r3d, datacopyflag=ESMF_DATACOPY_REFERENCE, & - gridToFieldMap=(/2,3/), ungriddedLBound=(/1/), ungriddedUBound=(/3/), & - name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) - - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite('af winde vector esmf field create '//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) - - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"output_file"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='output_file',value=trim(output_file),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_LogWrite('before winde vector esmf field add output_file', ESMF_LOGMSG_INFO, rc=rc) - -! if( mpp_root_pe() == 0)print *,'phys, aftercreate wind vector esmf field' - call ESMF_FieldBundleAdd(phys_bundle,(/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - if( present(rcd)) rcd=rc - call ESMF_LogWrite('aft winde vector esmf field add to fieldbundle'//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) - return - else if( trim(intpl_method) == 'nearest_stod' ) then - if(size(axes) == 2) then - temp_r2d => buffer_phys_nb(isco:ieco,jsco:jeco,kstt) - field = ESMF_FieldCreate(phys_grid, temp_r2d, datacopyflag=copyflag, & - name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - else if(size(axes) == 3) then - temp_r3d => buffer_phys_nb(isco:ieco,jsco:jeco,kstt:kstt+levo-1) - field = ESMF_FieldCreate(phys_grid, temp_r3d, datacopyflag=copyflag, & - name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - if( mpp_pe() == mpp_root_pe()) print *,'add 3D field to after nearest_stod, fld=', trim(var_name) - endif - else if( trim(intpl_method) == 'bilinear' ) then - if(size(axes) == 2) then - temp_r2d => buffer_phys_bl(isco:ieco,jsco:jeco,kstt) - field = ESMF_FieldCreate(phys_grid, temp_r2d, datacopyflag=copyflag, & - name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - else if(size(axes) == 3) then - temp_r3d => buffer_phys_bl(isco:ieco,jsco:jeco,kstt:kstt+levo-1) - field = ESMF_FieldCreate(phys_grid, temp_r3d, datacopyflag=copyflag, & - name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - if( mpp_pe() == mpp_root_pe()) print *,'add field to after bilinear, fld=', trim(var_name) - endif - endif -! -!*** add field attributes - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"long_name"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='long_name',value=trim(long_name),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"units"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='units',value=trim(units),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"missing_value"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='missing_value',value=real(missing_value,kind=4),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"_FillValue"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='_FillValue',value=real(missing_value,kind=4),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"cell_methods"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='cell_methods',value=trim(cell_methods),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) -! - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"output_file"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name='output_file',value=trim(output_file),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - -! -!*** add vertical coord attribute: - if( size(axes) > 2) then - do i=3,size(axes) - idx=0 - do j=1,size(all_axes) - if (axes(i)==all_axes(j)) then - idx=j - exit - endif - enddo - if (idx>0) then - call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & - attrList=(/"ESMF:ungridded_dim_labels"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name="ESMF:ungridded_dim_labels", valueList=(/trim(axis_name(idx))/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - enddo - endif - -!*** add field into bundle - call ESMF_FieldBundleAdd(phys_bundle,(/field/), rc=rc) - if( present(rcd)) rcd=rc -! - call ESMF_LogWrite('phys field add to fieldbundle '//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) - - end subroutine add_field_to_phybundle -! -! - subroutine find_output_name(module_name,field_name,output_name) - character(*), intent(in) :: module_name - character(*), intent(in) :: field_name - character(*), intent(out) :: output_name -! - integer i,in_num, out_num - integer tile_count -! - tile_count = 1 - in_num = find_input_field(module_name, field_name, tile_count) -! - output_name = '' - do i=1, max_output_fields - if(output_fields(i)%input_field == in_num) then - output_name = output_fields(i)%output_name - exit - endif - enddo - if(output_name == '') then - print *,'Error, cant find out put name' - endif - - end subroutine find_output_name -#endif -!------------------------------------------------------------------------- - -end module FV3GFS_io_mod diff --git a/io/FV3GFS_restart_io.F90 b/io/FV3GFS_restart_io.F90 deleted file mode 100644 index da641c04e..000000000 --- a/io/FV3GFS_restart_io.F90 +++ /dev/null @@ -1,920 +0,0 @@ -module FV3GFS_restart_io_mod - - use esmf - use block_control_mod, only: block_control_type - use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys - use GFS_restart, only: GFS_restart_type - - implicit none - private - - real(kind_phys), parameter:: zero = 0.0, one = 1.0 - integer, parameter :: r8 = kind_phys - - integer :: nvar2d, nvar3d, npz - real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: phy_var2 - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: phy_var3 - character(len=32),dimension(:),allocatable :: phy_var2_names, phy_var3_names - - integer :: nvar2m, nvar2o, nvar3, nvar2r, nvar2mp, nvar3mp - real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: sfc_var2 - real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: sfc_var3ice - real(kind=kind_phys), allocatable, target, dimension(:,:,:,:) :: sfc_var3, sfc_var3sn,sfc_var3eq,sfc_var3zn - character(len=32),allocatable,dimension(:) :: sfc_name2, sfc_name3 - - type(ESMF_FieldBundle) :: phy_bundle, sfc_bundle - - public FV3GFS_restart_register - - public fv_phy_restart_output - public fv_phy_restart_bundle_setup - - public fv_sfc_restart_output - public fv_sfc_restart_bundle_setup - - interface copy_from_GFS_Data - module procedure copy_from_GFS_Data_2d_phys2phys, & - copy_from_GFS_Data_3d_phys2phys, & - copy_from_GFS_Data_2d_int2phys, & - copy_from_GFS_Data_3d_int2phys, & - copy_from_GFS_Data_2d_stack_phys2phys - end interface - - contains - - subroutine FV3GFS_restart_register (Sfcprop, GFS_restart, Atm_block, Model) - - ! this subroutine must allocate all data buffers and set the variable names - ! for both 'phy' and 'sfc' restart bundles - - implicit none - - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(GFS_restart_type), intent(in) :: GFS_Restart - type(block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(in) :: Model - - integer :: isc, iec, jsc, jec, nx, ny - integer :: num - - isc = Atm_block%isc - iec = Atm_block%iec - jsc = Atm_block%jsc - jec = Atm_block%jec - npz = Atm_block%npz - nx = (iec - isc + 1) - ny = (jec - jsc + 1) - - !--------------- phy - nvar2d = GFS_Restart%num2d - nvar3d = GFS_Restart%num3d - - allocate (phy_var2(nx,ny,nvar2d), phy_var2_names(nvar2d)) - allocate (phy_var3(nx,ny,npz,nvar3d), phy_var3_names(nvar3d)) - phy_var2 = zero - phy_var3 = zero - do num = 1,nvar2d - phy_var2_names(num) = trim(GFS_Restart%name2d(num)) - enddo - do num = 1,nvar3d - phy_var3_names(num) = trim(GFS_Restart%name3d(num)) - enddo - - !--------------- sfc - nvar2m = 48 - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - nvar2m = nvar2m + 4 -! nvar2m = nvar2m + 5 - endif - if (Model%cplwav) nvar2m = nvar2m + 1 - nvar2o = 18 - if (Model%lsm == Model%lsm_ruc) then - if (Model%rdlai) then - nvar2r = 13 - else - nvar2r = 12 - endif - nvar3 = 5 - else - nvar2r = 0 - nvar3 = 3 - endif - nvar2mp = 0 - nvar3mp = 0 - if (Model%lsm == Model%lsm_noahmp) then - nvar2mp = 29 - nvar3mp = 5 - endif - - !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) - allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r)) - allocate(sfc_name3(0:nvar3+nvar3mp)) - allocate(sfc_var3ice(nx,ny,Model%kice)) - - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then - allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) - elseif (Model%lsm == Model%lsm_ruc) then - allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar3)) - endif - - sfc_var2 = -9999.0_r8 - sfc_var3 = -9999.0_r8 - sfc_var3ice= -9999.0_r8 - - if (Model%lsm == Model%lsm_noahmp) then - allocate(sfc_var3sn(nx,ny,-2:0,4:6)) - allocate(sfc_var3eq(nx,ny,1:4,7:7)) - allocate(sfc_var3zn(nx,ny,-2:4,8:8)) - - sfc_var3sn = -9999.0_r8 - sfc_var3eq = -9999.0_r8 - sfc_var3zn = -9999.0_r8 - endif - - call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar2m,.true.) - - sfc_name3(0) = 'tiice' - - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then - 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 - sfc_name3(1) = 'tslb' - sfc_name3(2) = 'smois' - sfc_name3(3) = 'sh2o' - sfc_name3(4) = 'smfr' - sfc_name3(5) = 'flfr' - end if - - end subroutine FV3GFS_restart_register - - subroutine fv_phy_restart_output(GFS_Restart, Atm_block) - - implicit none - - type(GFS_restart_type), intent(in) :: GFS_Restart - type(block_control_type), intent(in) :: Atm_block - -!*** local variables - integer :: i, j, k, n - integer :: nb, ix, num - integer :: isc, iec, jsc, jec, npz, nx, ny - integer(8) :: rchk - - isc = Atm_block%isc - iec = Atm_block%iec - jsc = Atm_block%jsc - jec = Atm_block%jec - npz = Atm_block%npz - nx = (iec - isc + 1) - ny = (jec - jsc + 1) - - !--- register the restart fields - if (.not. allocated(phy_var2)) then - write(0,*)'phy_var2 must be allocated' - endif - if (.not. allocated(phy_var3)) then - write(0,*)'phy_var3 must be allocated' - endif - - !--- 2D variables - do num = 1,nvar2d - do nb = 1,Atm_block%nblks - 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) - enddo - enddo - enddo - - !--- 3D variables - do num = 1,nvar3d - do nb = 1,Atm_block%nblks - do k=1,npz - 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) - enddo - enddo - enddo - enddo - - end subroutine fv_phy_restart_output - - subroutine fv_sfc_restart_output(Sfcprop, Atm_block, Model) - !--- interface variable definitions - implicit none - - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(block_control_type), intent(in) :: Atm_block - type(GFS_control_type), intent(in) :: Model - - integer :: i, j, k, nb, ix, lsoil, num, nt - integer :: isc, iec, jsc, jec, npz, nx, ny - integer, allocatable :: ii1(:), jj1(:) - real(kind_phys) :: ice - integer :: is, ie - - isc = Atm_block%isc - iec = Atm_block%iec - jsc = Atm_block%jsc - jec = Atm_block%jec - npz = Atm_block%npz - nx = (iec - isc + 1) - ny = (jec - jsc + 1) - -!$omp parallel do default(shared) private(i, j, nb, ix, nt, ii1, jj1, lsoil, k, ice) - block_loop: do nb = 1, Atm_block%nblks - allocate(ii1(Atm_block%blksz(nb))) - allocate(jj1(Atm_block%blksz(nb))) - ii1=Atm_block%index(nb)%ii - isc + 1 - jj1=Atm_block%index(nb)%jj - jsc + 1 - - nt=0 - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%slmsk) !--- slmsk - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfco) !--- tsfc (tsea in sfc file) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasd) !--- weasd (sheleg in sfc file) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tg3) !--- tg3 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorl) !--- zorl - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alvsf) !--- alvsf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alvwf) !--- alvwf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alnsf) !--- alnsf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alnwf) !--- alnwf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%facsf) !--- facsf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%facwf) !--- facwf - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%vfrac) !--- vfrac - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canopy)!--- canopy - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%f10m) !--- f10m - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%t2m) !--- t2m - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%q2m) !--- q2m - - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%vtype) !--- vtype - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stype) !--- stype - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%uustar)!--- uustar - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ffmm) !--- ffmm - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ffhh) !--- ffhh - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%hice) !--- hice - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fice) !--- fice - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tisfc) !--- tisfc - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tprcp) !--- tprcp - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%srflag)!--- srflag - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowd) !--- snowd (snwdph in the file) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%shdmin)!--- shdmin - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%shdmax)!--- shdmax - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%slope) !--- slope - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snoalb)!--- snoalb - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sncovr) !--- sncovr - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snodl) !--- snodl (snowd on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasdl) !--- weasdl (weasd on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfc) !--- tsfc composite - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsfcl) !--- tsfcl (temp on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorlw) !--- zorl (zorl on water) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorll) !--- zorll (zorl on land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorli) !--- zorli (zorl on ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirvis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirnir_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifvis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifnir_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%emis_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%emis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sncovr_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snodi) !--- snodi (snowd on ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%weasdi) !--- weasdi (weasd on ice) - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirvis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifvis_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdirnir_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%albdifnir_ice) -! sfc_var2(i,j,53) = Sfcprop(nb)%sfalb_ice(ix) - endif - if (Model%cplwav) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorlwav) !--- zorlwav (zorl from wav) - endif - !--- NSSTM variables - if (Model%nstf_name(1) > 0) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tref) !--- nsstm tref - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%z_c) !--- nsstm z_c - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_0) !--- nsstm c_0 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%c_d) !--- nsstm c_d - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%w_0) !--- nsstm w_0 - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%w_d) !--- nsstm w_d - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xt) !--- nsstm xt - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xs) !--- nsstm xs - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xu) !--- nsstm xu - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xv) !--- nsstm xv - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xz) !--- nsstm xz - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zm) !--- nsstm zm - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xtts) !--- nsstm xtts - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xzts) !--- nsstm xzts - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%d_conv) !--- nsstm d_conv - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%ifd) !--- nsstm ifd - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%dt_cool)!--- nsstm dt_cool - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qrain) !--- nsstm qrain - - ! FIXME convert negative zero (-0.0) to zero (0.0) - do j=1,ny - do i=1,nx - if(sfc_var2(i,j,nt) == 0.0) sfc_var2(i,j,nt) = 0.0 - end do - end do - endif - - if (Model%lsm == Model%lsm_ruc) then - !--- Extra RUC variables - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wetness) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%clw_surf_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%clw_surf_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qwv_surf_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qwv_surf_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsnow_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tsnow_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowfallac_land) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowfallac_ice) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_lnd) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_lnd_bck) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_ice) - if (Model%rdlai) then - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - endif - else if (Model%lsm == Model%lsm_noahmp) then - !--- Extra Noah MP variables - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tvxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tgxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canicexy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%canliqxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%eahxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%tahxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%cmxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%chxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fwetxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sneqvoxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%alboldxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qsnowxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wslakexy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zwtxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%waxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%wtxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%lfmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%rtmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stmassxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%woodxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%stblcpxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%fastcpxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xsaixy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%taussxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%smcwtdxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%deeprechxy) - call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%rechxy) - endif - - do k = 1,Model%kice - do ix = 1, Atm_block%blksz(nb) - ice=Sfcprop(nb)%tiice(ix,k) - if(ice phy_var2(:,:,num) - call create_2d_field_and_add_to_bundle(temp_r2d, trim(phy_var2_names(num)), trim(outputfile), grid, bundle) - enddo - - do num = 1,nvar3d - temp_r3d => phy_var3(:,:,:,num) - call create_3d_field_and_add_to_bundle(temp_r3d, trim(phy_var3_names(num)), "zaxis_1", npz, trim(outputfile), grid, bundle) - enddo - - end subroutine fv_phy_restart_bundle_setup - - subroutine fv_sfc_restart_bundle_setup(bundle, grid, Model, rc) -! -!------------------------------------------------------------- -!*** set esmf bundle for sfc restart fields -!------------------------------------------------------------ -! - use esmf - - implicit none - - type(ESMF_FieldBundle),intent(inout) :: bundle - type(ESMF_Grid),intent(inout) :: grid - type(GFS_control_type), intent(in) :: Model - integer,intent(out) :: rc - -!*** local variables - integer i, j, k, n - character(128) :: sfcbdl_name - type(ESMF_Field) :: field - character(128) :: outputfile - real(kind_phys),dimension(:,:),pointer :: temp_r2d - real(kind_phys),dimension(:,:,:),pointer :: temp_r3d - - integer :: num - - if (.not. allocated(sfc_var2)) then - write(0,*)'ERROR sfc_var2, NOT allocated' - endif - if (.not. allocated(sfc_var3)) then - write(0,*)'ERROR sfc_var3 NOT allocated' - endif - - sfc_bundle = bundle - - call ESMF_FieldBundleGet(bundle, name=sfcbdl_name,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - outputfile = trim(sfcbdl_name) - -!*** add esmf fields - - do num = 1,nvar2m - temp_r2d => sfc_var2(:,:,num) - call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc_name2(num)), outputfile, grid, bundle) - enddo - - if (Model%nstf_name(1) > 0) then - do num = nvar2m+1,nvar2m+nvar2o - temp_r2d => sfc_var2(:,:,num) - call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc_name2(num)), outputfile, grid, bundle) - enddo - endif - - if (Model%lsm == Model%lsm_ruc) then ! nvar2mp =0 - do num = nvar2m+nvar2o+1, nvar2m+nvar2o+nvar2r - temp_r2d => sfc_var2(:,:,num) - call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc_name2(num)), outputfile, grid, bundle) - enddo - else if (Model%lsm == Model%lsm_noahmp) then ! nvar2r =0 - do num = nvar2m+nvar2o+1,nvar2m+nvar2o+nvar2mp - temp_r2d => sfc_var2(:,:,num) - call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc_name2(num)), outputfile, grid, bundle) - enddo - endif - - temp_r3d => sfc_var3ice(:,:,:) - call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc_name3(0)), "zaxis_1", Model%kice, trim(outputfile), grid, bundle) - - if(Model%lsm == Model%lsm_ruc) then - do num = 1,nvar3 - temp_r3d => sfc_var3(:,:,:,num) - call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc_name3(num)), "zaxis_1", Model%kice, trim(outputfile), grid, bundle) - enddo - else - do num = 1,nvar3 - temp_r3d => sfc_var3(:,:,:,num) - call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc_name3(num)), "zaxis_2", Model%lsoil, trim(outputfile), grid, bundle) - enddo - endif - - if (Model%lsm == Model%lsm_noahmp) then - do num = nvar3+1,nvar3+3 - temp_r3d => sfc_var3sn(:,:,:,num) - call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc_name3(num)), "zaxis_3", 3, trim(outputfile), grid, bundle) - enddo - - temp_r3d => sfc_var3eq(:,:,:,7) - call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc_name3(7)), "zaxis_2", Model%lsoil, trim(outputfile), grid, bundle) - - temp_r3d => sfc_var3zn(:,:,:,8) - call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc_name3(8)), "zaxis_4", 7, trim(outputfile), grid, bundle) - endif ! lsm = lsm_noahmp - - end subroutine fv_sfc_restart_bundle_setup - - subroutine create_2d_field_and_add_to_bundle(temp_r2d, field_name, outputfile, grid, bundle) - - use esmf - - implicit none - - real(kind_phys), dimension(:,:), pointer, intent(in) :: temp_r2d - character(len=*), intent(in) :: field_name - character(len=*), intent(in) :: outputfile - type(ESMF_Grid), intent(in) :: grid - type(ESMF_FieldBundle), intent(inout) :: bundle - - type(ESMF_Field) :: field - - integer :: rc, i - - field = ESMF_FieldCreate(grid, temp_r2d, datacopyflag=ESMF_DATACOPY_REFERENCE, & - name=trim(field_name), indexFlag=ESMF_INDEX_DELOCAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", name='output_file', value=trim(outputfile), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_FieldBundleAdd(bundle, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - end subroutine create_2d_field_and_add_to_bundle - - subroutine create_3d_field_and_add_to_bundle(temp_r3d, field_name, axis_name, num_levels, outputfile, grid, bundle) - - use esmf - - implicit none - - real(kind_phys), dimension(:,:,:), pointer, intent(in) :: temp_r3d - character(len=*), intent(in) :: field_name - character(len=*), intent(in) :: axis_name - integer, intent(in) :: num_levels - character(len=*), intent(in) :: outputfile - type(ESMF_Grid), intent(in) :: grid - type(ESMF_FieldBundle), intent(inout) :: bundle - - type(ESMF_Field) :: field - - integer :: rc, i - - field = ESMF_FieldCreate(grid, temp_r3d, datacopyflag=ESMF_DATACOPY_REFERENCE, & - name=trim(field_name), indexFlag=ESMF_INDEX_DELOCAL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", name='output_file', value=trim(outputfile), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - call add_zaxis_to_field(field, axis_name, num_levels) - - call ESMF_FieldBundleAdd(bundle, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - end subroutine create_3d_field_and_add_to_bundle - - subroutine add_zaxis_to_field(field, axis_name, num_levels) - - use esmf - - implicit none - - type(ESMF_Field), intent(inout) :: field - character(len=*), intent(in) :: axis_name - integer, intent(in) :: num_levels - - real(kind_phys), allocatable, dimension(:) :: buffer - integer :: rc, i - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & - name="ESMF:ungridded_dim_labels", valueList=(/trim(axis_name)/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - allocate( buffer(num_levels) ) - do i=1, num_levels - buffer(i)=i - end do - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3-dim", & - name=trim(axis_name), valueList=buffer, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - deallocate(buffer) - - call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3-dim", & - name=trim(axis_name)//"cartesian_axis", value="Z", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - end subroutine add_zaxis_to_field - - pure subroutine fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,warm_start) - implicit none - type(GFS_control_type), intent(in) :: Model - integer, intent(in) :: nvar_s2m - character(len=32),intent(out) :: sfc_name2(:), sfc_name3(:) - logical, intent(in) :: warm_start - integer :: nt - - !--- names of the 2D variables to save - nt=0 - nt=nt+1 ; sfc_name2(nt) = 'slmsk' - nt=nt+1 ; sfc_name2(nt) = 'tsea' !tsfc - nt=nt+1 ; sfc_name2(nt) = 'sheleg' !weasd - nt=nt+1 ; sfc_name2(nt) = 'tg3' - nt=nt+1 ; sfc_name2(nt) = 'zorl' - nt=nt+1 ; sfc_name2(nt) = 'alvsf' - nt=nt+1 ; sfc_name2(nt) = 'alvwf' - nt=nt+1 ; sfc_name2(nt) = 'alnsf' - nt=nt+1 ; sfc_name2(nt) = 'alnwf' - nt=nt+1 ; sfc_name2(nt) = 'facsf' - nt=nt+1 ; sfc_name2(nt) = 'facwf' - nt=nt+1 ; sfc_name2(nt) = 'vfrac' - nt=nt+1 ; sfc_name2(nt) = 'canopy' - nt=nt+1 ; sfc_name2(nt) = 'f10m' - nt=nt+1 ; sfc_name2(nt) = 't2m' - nt=nt+1 ; sfc_name2(nt) = 'q2m' - nt=nt+1 ; sfc_name2(nt) = 'vtype' - nt=nt+1 ; sfc_name2(nt) = 'stype' - nt=nt+1 ; sfc_name2(nt) = 'uustar' - nt=nt+1 ; sfc_name2(nt) = 'ffmm' - nt=nt+1 ; sfc_name2(nt) = 'ffhh' - nt=nt+1 ; sfc_name2(nt) = 'hice' - nt=nt+1 ; sfc_name2(nt) = 'fice' - nt=nt+1 ; sfc_name2(nt) = 'tisfc' - nt=nt+1 ; sfc_name2(nt) = 'tprcp' - nt=nt+1 ; sfc_name2(nt) = 'srflag' - nt=nt+1 ; sfc_name2(nt) = 'snwdph' !snowd - nt=nt+1 ; sfc_name2(nt) = 'shdmin' - nt=nt+1 ; sfc_name2(nt) = 'shdmax' - nt=nt+1 ; sfc_name2(nt) = 'slope' - nt=nt+1 ; sfc_name2(nt) = 'snoalb' - !--- variables below here are optional - nt=nt+1 ; sfc_name2(nt) = 'sncovr' - nt=nt+1 ; sfc_name2(nt) = 'snodl' !snowd on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'weasdl'!weasd on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'tsfc' !tsfc composite - nt=nt+1 ; sfc_name2(nt) = 'tsfcl' !temp on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'zorlw' !zorl on water portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'zorll' !zorl on land portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'zorli' !zorl on ice portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'albdirvis_lnd' - nt=nt+1 ; sfc_name2(nt) = 'albdirnir_lnd' - nt=nt+1 ; sfc_name2(nt) = 'albdifvis_lnd' - nt=nt+1 ; sfc_name2(nt) = 'albdifnir_lnd' - nt=nt+1 ; sfc_name2(nt) = 'emis_lnd' - nt=nt+1 ; sfc_name2(nt) = 'emis_ice' - nt=nt+1 ; sfc_name2(nt) = 'sncovr_ice' - nt=nt+1 ; sfc_name2(nt) = 'snodi' ! snowd on ice portion of a cell - nt=nt+1 ; sfc_name2(nt) = 'weasdi'! weasd on ice portion of a cell - - if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - nt=nt+1 ; sfc_name2(nt) = 'albdirvis_ice' - nt=nt+1 ; sfc_name2(nt) = 'albdifvis_ice' - nt=nt+1 ; sfc_name2(nt) = 'albdirnir_ice' - nt=nt+1 ; sfc_name2(nt) = 'albdifnir_ice' -! nt=nt+1 ; sfc_name2(nt) = 'sfalb_ice' - endif - - if(Model%cplwav) then - sfc_name2(nvar_s2m) = 'zorlwav' !zorl from wave component - endif - - nt = nvar_s2m ! next variable will be at nvar_s2m - - !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) - nt=nt+1 ; sfc_name2(nt) = 'tref' - nt=nt+1 ; sfc_name2(nt) = 'z_c' - nt=nt+1 ; sfc_name2(nt) = 'c_0' - nt=nt+1 ; sfc_name2(nt) = 'c_d' - nt=nt+1 ; sfc_name2(nt) = 'w_0' - nt=nt+1 ; sfc_name2(nt) = 'w_d' - nt=nt+1 ; sfc_name2(nt) = 'xt' - nt=nt+1 ; sfc_name2(nt) = 'xs' - nt=nt+1 ; sfc_name2(nt) = 'xu' - nt=nt+1 ; sfc_name2(nt) = 'xv' - nt=nt+1 ; sfc_name2(nt) = 'xz' - nt=nt+1 ; sfc_name2(nt) = 'zm' - nt=nt+1 ; sfc_name2(nt) = 'xtts' - nt=nt+1 ; sfc_name2(nt) = 'xzts' - nt=nt+1 ; sfc_name2(nt) = 'd_conv' - nt=nt+1 ; sfc_name2(nt) = 'ifd' - nt=nt+1 ; sfc_name2(nt) = 'dt_cool' - nt=nt+1 ; sfc_name2(nt) = 'qrain' -! -! Only needed when Noah MP LSM is used - 29 2D -! - if (Model%lsm == Model%lsm_noahmp) then - nt=nt+1 ; sfc_name2(nt) = 'snowxy' - nt=nt+1 ; sfc_name2(nt) = 'tvxy' - nt=nt+1 ; sfc_name2(nt) = 'tgxy' - nt=nt+1 ; sfc_name2(nt) = 'canicexy' - nt=nt+1 ; sfc_name2(nt) = 'canliqxy' - nt=nt+1 ; sfc_name2(nt) = 'eahxy' - nt=nt+1 ; sfc_name2(nt) = 'tahxy' - nt=nt+1 ; sfc_name2(nt) = 'cmxy' - nt=nt+1 ; sfc_name2(nt) = 'chxy' - nt=nt+1 ; sfc_name2(nt) = 'fwetxy' - nt=nt+1 ; sfc_name2(nt) = 'sneqvoxy' - nt=nt+1 ; sfc_name2(nt) = 'alboldxy' - nt=nt+1 ; sfc_name2(nt) = 'qsnowxy' - nt=nt+1 ; sfc_name2(nt) = 'wslakexy' - nt=nt+1 ; sfc_name2(nt) = 'zwtxy' - nt=nt+1 ; sfc_name2(nt) = 'waxy' - nt=nt+1 ; sfc_name2(nt) = 'wtxy' - nt=nt+1 ; sfc_name2(nt) = 'lfmassxy' - nt=nt+1 ; sfc_name2(nt) = 'rtmassxy' - nt=nt+1 ; sfc_name2(nt) = 'stmassxy' - nt=nt+1 ; sfc_name2(nt) = 'woodxy' - nt=nt+1 ; sfc_name2(nt) = 'stblcpxy' - nt=nt+1 ; sfc_name2(nt) = 'fastcpxy' - nt=nt+1 ; sfc_name2(nt) = 'xsaixy' - nt=nt+1 ; sfc_name2(nt) = 'xlaixy' - nt=nt+1 ; sfc_name2(nt) = 'taussxy' - nt=nt+1 ; sfc_name2(nt) = 'smcwtdxy' - nt=nt+1 ; sfc_name2(nt) = 'deeprechxy' - nt=nt+1 ; sfc_name2(nt) = 'rechxy' - else if (Model%lsm == Model%lsm_ruc .and. warm_start) then - nt=nt+1 ; sfc_name2(nt) = 'wetness' - nt=nt+1 ; sfc_name2(nt) = 'clw_surf_land' - nt=nt+1 ; sfc_name2(nt) = 'clw_surf_ice' - nt=nt+1 ; sfc_name2(nt) = 'qwv_surf_land' - nt=nt+1 ; sfc_name2(nt) = 'qwv_surf_ice' - nt=nt+1 ; sfc_name2(nt) = 'tsnow_land' - nt=nt+1 ; sfc_name2(nt) = 'tsnow_ice' - nt=nt+1 ; sfc_name2(nt) = 'snowfall_acc_land' - nt=nt+1 ; sfc_name2(nt) = 'snowfall_acc_ice' - nt=nt+1 ; sfc_name2(nt) = 'sfalb_lnd' - nt=nt+1 ; sfc_name2(nt) = 'sfalb_lnd_bck' - nt=nt+1 ; sfc_name2(nt) = 'sfalb_ice' - if (Model%rdlai) then - nt=nt+1 ; sfc_name2(nt) = 'lai' - endif - else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then - nt=nt+1 ; sfc_name2(nt) = 'lai' - endif - end subroutine fill_sfcprop_names - - pure subroutine copy_from_GFS_Data_2d_phys2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(in) :: var_block(:) - real(kind=kind_phys), intent(out) :: var2d(:,:,:) - integer ix - - nt=nt+1 - do ix=1,size(var_block) - var2d(ii1(ix),jj1(ix),nt) = var_block(ix) - enddo - end subroutine copy_from_GFS_Data_2d_phys2phys - - pure subroutine copy_from_GFS_Data_3d_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(in) :: var_block(:,:) - real(kind=kind_phys), intent(out) :: var3d(:,:,:,:) - integer ix, k - - nt=nt+1 - do k=lbound(var_block,2),ubound(var_block,2) - do ix=1,size(var_block,1) - var3d(ii1(ix),jj1(ix),k,nt) = var_block(ix,k) - enddo - enddo - end subroutine copy_from_GFS_Data_3d_phys2phys - - pure subroutine copy_from_GFS_Data_2d_int2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc, var_block(:) - integer, intent(inout) :: nt - real(kind=kind_phys), intent(out) :: var2d(:,:,:) - integer ix - - nt=nt+1 - do ix=1,size(var_block) - var2d(ii1(ix),jj1(ix),nt) = var_block(ix) - enddo - end subroutine copy_from_GFS_Data_2d_int2phys - - pure subroutine copy_from_GFS_Data_2d_stack_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - ! For copying phy_f2d and phy_fctd - implicit none - integer, intent(in) :: ii1(:), jj1(:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(in) :: var_block(:,:) - real(kind=kind_phys), intent(out) :: var3d(:,:,:) - integer ix, k - - nt=nt+1 - do k=lbound(var_block,2),ubound(var_block,2) - do ix=1,size(var_block,1) - var3d(ii1(ix),jj1(ix),nt) = var_block(ix,k) - enddo - enddo - end subroutine copy_from_GFS_Data_2d_stack_phys2phys - - pure subroutine copy_from_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) - implicit none - integer, intent(in) :: ii1(:), jj1(:), var_block(:,:), isc, jsc - integer, intent(inout) :: nt - real(kind=kind_phys), intent(out) :: var3d(:,:,:,:) - integer ix, k - - nt=nt+1 - do k=lbound(var_block,2),ubound(var_block,2) - do ix=1,size(var_block,1) - var3d(ii1(ix),jj1(ix),k,nt) = real(var_block(ix,k),kind_phys) - enddo - enddo - end subroutine copy_from_GFS_Data_3d_int2phys - -end module FV3GFS_restart_io_mod diff --git a/io/clm_lake_io.F90 b/io/clm_lake_io.F90 deleted file mode 100644 index 6a47f3ab6..000000000 --- a/io/clm_lake_io.F90 +++ /dev/null @@ -1,432 +0,0 @@ -module clm_lake_io - use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, & - GFS_data_type, kind_phys - use GFS_restart, only: GFS_restart_type - use GFS_diagnostics, only: GFS_externaldiag_type - use block_control_mod, only: block_control_type - 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 - - implicit none - - type clm_lake_data_type - ! The clm_lake_data_type derived type is a class that stores - ! temporary arrays used to read or write CLM Lake model restart - ! and axis variables. It can safely be declared and unused, but - ! you should only call these routines if the CLM Lake Model was - ! (or will be) used by this execution of the FV3. It is the - ! responsibility of the caller to ensure the necessary data is in - ! Sfc_restart, Sfcprop, and Model. - - ! All 2D variables needed for a restart - real(kind_phys), pointer, private, dimension(:,:) :: & - T_snow=>null(), T_ice=>null(), & - lake_snl2d=>null(), lake_h2osno2d=>null(), lake_tsfc=>null(), clm_lakedepth=>null(), & - lake_savedtke12d=>null(), lake_sndpth2d=>null(), clm_lake_initialized=>null() - - ! All 3D variables needed for a restart - real(kind_phys), pointer, private, dimension(:,:,:) :: & - lake_z3d=>null(), lake_dz3d=>null(), lake_soil_watsat3d=>null(), & - lake_csol3d=>null(), lake_soil_tkmg3d=>null(), lake_soil_tkdry3d=>null(), & - lake_soil_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & - lake_snow_zi3d=>null(), lake_h2osoi_vol3d=>null(), lake_h2osoi_liq3d=>null(), & - lake_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & - lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() - - contains - - ! register_axes calls registers_axis on Sfc_restart for all required axes - procedure, public :: register_axes => clm_lake_register_axes - - ! allocate_data allocates all of the pointers in this object - procedure, public :: allocate_data => clm_lake_allocate_data - - ! register_fields calls register_field on Sfc_restart for all CLM Lake model restart variables - procedure, public :: register_fields => clm_lake_register_fields - - ! deallocate_data deallocates all pointers, allowing this object to be used repeatedly. - ! It is safe to call deallocate_data if no data has been allocated. - procedure, public :: deallocate_data => clm_lake_deallocate_data - - ! write_axes writes variables to Sfc_restart, with the name of - ! each axis, containing the appropriate information - procedure, public :: write_axes => clm_lake_write_axes - - ! copy_to_temporaries copies from Sfcprop to internal pointers (declared above) - procedure, public :: copy_to_temporaries => clm_lake_copy_to_temporaries - - ! copy_to_temporaries copies from internal pointers (declared above) to Sfcprop - procedure, public :: copy_from_temporaries => clm_lake_copy_from_temporaries - - ! A fortran 2003 compliant compiler will call clm_lake_final - ! automatically when an object of this type goes out of - ! scope. This will deallocate any arrays via a call to - ! deallocate_data. It is safe to call this routine if no data has - ! been allocated. - final :: clm_lake_final - end type clm_lake_data_type - - CONTAINS - subroutine clm_lake_allocate_data(data,Model) - ! Deallocate all data, and reallocate to the size specified in Model - implicit none - class(clm_lake_data_type) :: data - type(GFS_control_type), intent(in) :: Model - - integer :: nx, ny - call data%deallocate_data - - nx=Model%nx - ny=Model%ny - - allocate(data%T_snow(nx,ny)) - allocate(data%T_ice(nx,ny)) - allocate(data%lake_snl2d(nx,ny)) - allocate(data%lake_h2osno2d(nx,ny)) - allocate(data%lake_tsfc(nx,ny)) - allocate(data%lake_savedtke12d(nx,ny)) - allocate(data%lake_sndpth2d(nx,ny)) - allocate(data%clm_lakedepth(nx,ny)) - allocate(data%clm_lake_initialized(nx,ny)) - - allocate(data%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_soil_watsat3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_soil_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_soil_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_soil_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) - allocate(data%lake_h2osoi_vol3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_h2osoi_liq3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_h2osoi_ice3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_clay3d(nx,ny,Model%nlevsoil_clm_lake)) - allocate(data%lake_sand3d(nx,ny,Model%nlevsoil_clm_lake)) - end subroutine clm_lake_allocate_data - - subroutine clm_lake_register_axes(data,Model,Sfc_restart) - ! Register all five axes needed by CLM Lake restart data - implicit none - class(clm_lake_data_type) :: data - type(GFS_control_type), intent(in) :: Model - type(FmsNetcdfDomainFile_t) :: Sfc_restart - call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) - - call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) - - call register_axis(Sfc_restart, 'levsnow_clm_lake', dimension_length=Model%nlevsnow_clm_lake) - - call register_axis(Sfc_restart, 'levsnowsoil_clm_lake', dimension_length=Model%nlevsnowsoil_clm_lake) - - call register_axis(Sfc_restart, 'levsnowsoil1_clm_lake', dimension_length=Model%nlevsnowsoil1_clm_lake) - end subroutine clm_lake_register_axes - - subroutine clm_lake_write_axes(data, Model, Sfc_restart) - ! Create variables with the name name as each clm_lake axis, and - ! fill the variable with the appropriate indices - implicit none - class(clm_lake_data_type) :: data - type(GFS_control_type), intent(in) :: Model - type(FmsNetcdfDomainFile_t) :: Sfc_restart - real(kind_phys) :: levlake_clm_lake(Model%nlevlake_clm_lake) - real(kind_phys) :: levsoil_clm_lake(Model%nlevsoil_clm_lake) - real(kind_phys) :: levsnow_clm_lake(Model%nlevsnow_clm_lake) - real(kind_phys) :: levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake) - real(kind_phys) :: levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake) - integer :: i - call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsoil_clm_lake', 'double', (/'levsoil_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsnow_clm_lake', 'double', (/'levsnow_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsnow_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsnowsoil_clm_lake', 'double', (/'levsnowsoil_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', 'double', (/'levsnowsoil1_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - do i=1,Model%nlevlake_clm_lake - levlake_clm_lake(i) = i - enddo - do i=1,Model%nlevsoil_clm_lake - levsoil_clm_lake(i) = i - enddo - do i=1,Model%nlevsnow_clm_lake - levsnow_clm_lake(i) = i - enddo - do i=-Model%nlevsnow_clm_lake,Model%nlevsoil_clm_lake - levsnowsoil_clm_lake(i+Model%nlevsnow_clm_lake+1) = i - enddo - do i=-Model%nlevsnow_clm_lake+1,Model%nlevsoil_clm_lake - levsnowsoil1_clm_lake(i+Model%nlevsnow_clm_lake) = i - enddo - - call write_data(Sfc_restart, 'levlake_clm_lake', levlake_clm_lake) - call write_data(Sfc_restart, 'levsoil_clm_lake', levsoil_clm_lake) - call write_data(Sfc_restart, 'levsnow_clm_lake', levsnow_clm_lake) - call write_data(Sfc_restart, 'levsnowsoil_clm_lake', levsnowsoil_clm_lake) - call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', levsnowsoil1_clm_lake) - end subroutine clm_lake_write_axes - - subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) - ! Copies from Sfcprop variables to the corresponding data temporary variables. - ! Terrible things will happen if you don't call data%allocate_data first. - implicit none - class(clm_lake_data_type) :: data - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(GFS_control_type), intent(in) :: Model - type(block_control_type), intent(in) :: Atm_block - - integer :: nb, ix, isc, jsc, i, j - isc = Model%isc - jsc = Model%jsc - - ! Copy data to temporary arrays - -!$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1, Atm_block%nblks - 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 - - data%T_snow(i,j) = Sfcprop(nb)%T_snow(ix) - data%T_ice(i,j) = Sfcprop(nb)%T_ice(ix) - data%lake_snl2d(i,j) = Sfcprop(nb)%lake_snl2d(ix) - data%lake_h2osno2d(i,j) = Sfcprop(nb)%lake_h2osno2d(ix) - data%lake_tsfc(i,j) = Sfcprop(nb)%lake_tsfc(ix) - data%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) - data%lake_sndpth2d(i,j) = Sfcprop(nb)%lake_sndpth2d(ix) - data%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) - data%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) - - data%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) - data%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) - data%lake_soil_watsat3d(i,j,:) = Sfcprop(nb)%lake_soil_watsat3d(ix,:) - data%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) - data%lake_soil_tkmg3d(i,j,:) = Sfcprop(nb)%lake_soil_tkmg3d(ix,:) - data%lake_soil_tkdry3d(i,j,:) = Sfcprop(nb)%lake_soil_tkdry3d(ix,:) - data%lake_soil_tksatu3d(i,j,:) = Sfcprop(nb)%lake_soil_tksatu3d(ix,:) - data%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) - data%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) - data%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) - data%lake_h2osoi_vol3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_vol3d(ix,:) - data%lake_h2osoi_liq3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_liq3d(ix,:) - data%lake_h2osoi_ice3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_ice3d(ix,:) - data%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) - data%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) - data%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) - data%lake_clay3d(i,j,:) = Sfcprop(nb)%lake_clay3d(ix,:) - data%lake_sand3d(i,j,:) = Sfcprop(nb)%lake_sand3d(ix,:) - enddo - enddo - end subroutine clm_lake_copy_to_temporaries - - subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) - ! Copies from data temporary variables to the corresponding Sfcprop variables. - ! Terrible things will happen if you don't call data%allocate_data first. - implicit none - class(clm_lake_data_type) :: data - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(GFS_control_type), intent(in) :: Model - type(block_control_type), intent(in) :: Atm_block - - integer :: nb, ix, isc, jsc, i, j - isc = Model%isc - jsc = Model%jsc - - ! Copy data to temporary arrays - -!$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1, Atm_block%nblks - 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 - - Sfcprop(nb)%T_snow(ix) = data%T_snow(i,j) - Sfcprop(nb)%T_ice(ix) = data%T_ice(i,j) - Sfcprop(nb)%lake_snl2d(ix) = data%lake_snl2d(i,j) - Sfcprop(nb)%lake_h2osno2d(ix) = data%lake_h2osno2d(i,j) - Sfcprop(nb)%lake_tsfc(ix) = data%lake_tsfc(i,j) - Sfcprop(nb)%lake_savedtke12d(ix) = data%lake_savedtke12d(i,j) - Sfcprop(nb)%lake_sndpth2d(ix) = data%lake_sndpth2d(i,j) - Sfcprop(nb)%clm_lakedepth(ix) = data%clm_lakedepth(i,j) - Sfcprop(nb)%clm_lake_initialized(ix) = data%clm_lake_initialized(i,j) - - Sfcprop(nb)%lake_z3d(ix,:) = data%lake_z3d(i,j,:) - Sfcprop(nb)%lake_dz3d(ix,:) = data%lake_dz3d(i,j,:) - Sfcprop(nb)%lake_soil_watsat3d(ix,:) = data%lake_soil_watsat3d(i,j,:) - Sfcprop(nb)%lake_csol3d(ix,:) = data%lake_csol3d(i,j,:) - Sfcprop(nb)%lake_soil_tkmg3d(ix,:) = data%lake_soil_tkmg3d(i,j,:) - Sfcprop(nb)%lake_soil_tkdry3d(ix,:) = data%lake_soil_tkdry3d(i,j,:) - Sfcprop(nb)%lake_soil_tksatu3d(ix,:) = data%lake_soil_tksatu3d(i,j,:) - Sfcprop(nb)%lake_snow_z3d(ix,:) = data%lake_snow_z3d(i,j,:) - Sfcprop(nb)%lake_snow_dz3d(ix,:) = data%lake_snow_dz3d(i,j,:) - Sfcprop(nb)%lake_snow_zi3d(ix,:) = data%lake_snow_zi3d(i,j,:) - Sfcprop(nb)%lake_h2osoi_vol3d(ix,:) = data%lake_h2osoi_vol3d(i,j,:) - Sfcprop(nb)%lake_h2osoi_liq3d(ix,:) = data%lake_h2osoi_liq3d(i,j,:) - Sfcprop(nb)%lake_h2osoi_ice3d(ix,:) = data%lake_h2osoi_ice3d(i,j,:) - Sfcprop(nb)%lake_t_soisno3d(ix,:) = data%lake_t_soisno3d(i,j,:) - Sfcprop(nb)%lake_t_lake3d(ix,:) = data%lake_t_lake3d(i,j,:) - Sfcprop(nb)%lake_icefrac3d(ix,:) = data%lake_icefrac3d(i,j,:) - Sfcprop(nb)%lake_clay3d(ix,:) = data%lake_clay3d(i,j,:) - Sfcprop(nb)%lake_sand3d(ix,:) = data%lake_sand3d(i,j,:) - enddo - enddo - end subroutine clm_lake_copy_from_temporaries - - subroutine clm_lake_register_fields(data, Sfc_restart) - ! Registers all restart fields needed by the CLM Lake Model. - ! Terrible things will happen if you don't call data%allocate_data - ! and data%register_axes first. - implicit none - class(clm_lake_data_type) :: data - type(FmsNetcdfDomainFile_t) :: Sfc_restart - - ! Register 2D fields - call register_restart_field(Sfc_restart, 'T_snow', data%T_snow, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'T_ice', data%T_ice, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_snl2d', data%lake_snl2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_h2osno2d', data%lake_h2osno2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_tsfc', data%lake_tsfc, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_savedtke12d', data%lake_savedtke12d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_sndpth2d', data%lake_sndpth2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'clm_lakedepth', data%clm_lakedepth, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'clm_lake_initialized', data%clm_lake_initialized, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - - ! Register 3D fields - call register_restart_field(Sfc_restart, 'lake_z3d', data%lake_z3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_dz3d', data%lake_dz3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_watsat3d', data%lake_soil_watsat3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_csol3d', data%lake_csol3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tkmg3d', data%lake_soil_tkmg3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tkdry3d', data%lake_soil_tkdry3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tksatu3d', data%lake_soil_tksatu3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_snow_z3d', data%lake_snow_z3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_snow_dz3d', data%lake_snow_dz3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_snow_zi3d', data%lake_snow_zi3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_h2osoi_vol3d', data%lake_h2osoi_vol3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_h2osoi_liq3d', data%lake_h2osoi_liq3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_h2osoi_ice3d', data%lake_h2osoi_ice3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_soisno3d', data%lake_t_soisno3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_lake3d', data%lake_t_lake3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_icefrac3d', data%lake_icefrac3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_clay3d', data%lake_clay3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_sand3d', data%lake_sand3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) - end subroutine clm_lake_register_fields - - subroutine clm_lake_final(data) - ! Final routine for clm_lake_data_type, called automatically when - ! an object of that type goes out of scope. This is simply a - ! wrapper around data%deallocate_data(). - implicit none - type(clm_lake_data_type) :: data - call clm_lake_deallocate_data(data) - end subroutine clm_lake_final - - subroutine clm_lake_deallocate_data(data) - ! Deallocates all data used, and nullifies the pointers. The data - ! object can safely be used again after this call. This is also - ! the implementation of the clm_lake_data_type final routine. - implicit none - class(clm_lake_data_type) :: data - - ! Deallocate and nullify any associated pointers - - ! This #define reduces code length by a lot -#define IF_ASSOC_DEALLOC_NULL(var) \ - if(associated(data%var)) then ; \ - deallocate(data%var) ; \ - nullify(data%var) ; \ - endif - - IF_ASSOC_DEALLOC_NULL(T_snow) - IF_ASSOC_DEALLOC_NULL(T_ice) - IF_ASSOC_DEALLOC_NULL(lake_snl2d) - IF_ASSOC_DEALLOC_NULL(lake_h2osno2d) - IF_ASSOC_DEALLOC_NULL(lake_tsfc) - IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) - IF_ASSOC_DEALLOC_NULL(lake_sndpth2d) - IF_ASSOC_DEALLOC_NULL(clm_lakedepth) - IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) - - IF_ASSOC_DEALLOC_NULL(lake_z3d) - IF_ASSOC_DEALLOC_NULL(lake_dz3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_watsat3d) - IF_ASSOC_DEALLOC_NULL(lake_csol3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tkmg3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tkdry3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tksatu3d) - IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) - IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) - IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) - IF_ASSOC_DEALLOC_NULL(lake_h2osoi_vol3d) - IF_ASSOC_DEALLOC_NULL(lake_h2osoi_liq3d) - IF_ASSOC_DEALLOC_NULL(lake_h2osoi_ice3d) - IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) - IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) - IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) - IF_ASSOC_DEALLOC_NULL(lake_clay3d) - IF_ASSOC_DEALLOC_NULL(lake_sand3d) - -#undef IF_ASSOC_DEALLOC_NULL - end subroutine clm_lake_deallocate_data - -end module clm_lake_io diff --git a/io/fv3atm_clm_lake_io.F90 b/io/fv3atm_clm_lake_io.F90 new file mode 100644 index 000000000..5c61a26be --- /dev/null +++ b/io/fv3atm_clm_lake_io.F90 @@ -0,0 +1,521 @@ +!> \file fv3atm_clm_lake_io.F90 +!! This code reads and writes restart files for the CLM Lake Model. The source code of +!! that model can be found in CCPP. Only the fv3atm_restart_io.F90 should ever access +!! these routines. +!! +!! The CLM Lake Model has its own restart code due to its five alternative vertical +!! levels, which don't match the five found in the other surface fields. For the sake +!! of code simplicity, a dedicated file was a better implementation. + +module fv3atm_clm_lake_io + use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys + use block_control_mod, only: block_control_type + use fms2_io_mod, only: FmsNetcdfDomainFile_t, register_axis, & + register_restart_field, write_data, & + register_variable_attribute, register_field + use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & + create_3d_field_and_add_to_bundle + + implicit none + + private + public :: clm_lake_data_type, clm_lake_register_axes, clm_lake_allocate_data, & + clm_lake_register_fields, clm_lake_deallocate_data, clm_lake_write_axes, & + clm_lake_copy_from_grid, clm_lake_copy_to_grid, clm_lake_bundle_fields, & + clm_lake_final + + !>\defgroup CLM Lake Model restart public interface + !> @{ + + !>@ The clm_lake_data_type derived type is a class that stores + !! temporary arrays used to read or write CLM Lake model restart + !! and axis variables. It can safely be declared and unused, but + !! you should only call these routines if the CLM Lake Model was + !! (or will be) used by this execution of the FV3. It is the + !! responsibility of the caller to ensure the necessary data is in + !! Sfc_restart, Sfcprop, and Model. + type clm_lake_data_type + ! All 2D variables needed for a restart + real(kind_phys), pointer, private, dimension(:,:) :: & + T_snow=>null(), T_ice=>null(), & + lake_snl2d=>null(), lake_h2osno2d=>null(), lake_tsfc=>null(), clm_lakedepth=>null(), & + lake_savedtke12d=>null(), lake_sndpth2d=>null(), clm_lake_initialized=>null() + + ! All 3D variables needed for a restart + real(kind_phys), pointer, private, dimension(:,:,:) :: & + lake_z3d=>null(), lake_dz3d=>null(), lake_soil_watsat3d=>null(), & + lake_csol3d=>null(), lake_soil_tkmg3d=>null(), lake_soil_tkdry3d=>null(), & + lake_soil_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & + lake_snow_zi3d=>null(), lake_h2osoi_vol3d=>null(), lake_h2osoi_liq3d=>null(), & + lake_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & + lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() + + ! Axis indices in 1-based array, containing non-1-based indices + real(kind_phys), pointer, private, dimension(:) :: & + levlake_clm_lake, levsoil_clm_lake, levsnowsoil_clm_lake, & + levsnowsoil1_clm_lake + contains + + ! register_axes calls registers_axis on Sfc_restart for all required axes + procedure, public :: register_axes => clm_lake_register_axes + + ! allocate_data allocates all of the pointers in this object + procedure, public :: allocate_data => clm_lake_allocate_data + + ! register_fields calls register_field on Sfc_restart for all CLM Lake model restart variables + procedure, public :: register_fields => clm_lake_register_fields + + ! deallocate_data deallocates all pointers, allowing this object to be used repeatedly. + ! It is safe to call deallocate_data if no data has been allocated. + procedure, public :: deallocate_data => clm_lake_deallocate_data + + ! write_axes writes variables to Sfc_restart, with the name of + ! each axis, containing the appropriate information + procedure, public :: write_axes => clm_lake_write_axes + + ! copy_from_grid copies from Sfcprop to internal pointers (declared above) + procedure, public :: copy_from_grid => clm_lake_copy_from_grid + + ! copy_from_grid copies from internal pointers (declared above) to Sfcprop + procedure, public :: copy_to_grid => clm_lake_copy_to_grid + + ! send field bundles in restart quilt server + procedure, public :: bundle_fields => clm_lake_bundle_fields + + ! A fortran 2003 compliant compiler will call clm_lake_final + ! automatically when an object of this type goes out of + ! scope. This will deallocate any arrays via a call to + ! deallocate_data. It is safe to call this routine if no data has + ! been allocated. + final :: clm_lake_final + end type clm_lake_data_type + +CONTAINS + + !>@ This subroutine is clm_lake%alocate_data. It deallocates all + !! data, and reallocate to the size specified in Model + subroutine clm_lake_allocate_data(clm_lake,Model) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_control_type), intent(in) :: Model + + integer :: nx, ny, i + call clm_lake%deallocate_data + + nx=Model%nx + ny=Model%ny + + allocate(clm_lake%T_snow(nx,ny)) + allocate(clm_lake%T_ice(nx,ny)) + allocate(clm_lake%lake_snl2d(nx,ny)) + allocate(clm_lake%lake_h2osno2d(nx,ny)) + allocate(clm_lake%lake_tsfc(nx,ny)) + allocate(clm_lake%lake_savedtke12d(nx,ny)) + allocate(clm_lake%lake_sndpth2d(nx,ny)) + allocate(clm_lake%clm_lakedepth(nx,ny)) + allocate(clm_lake%clm_lake_initialized(nx,ny)) + + allocate(clm_lake%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_soil_watsat3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_soil_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_soil_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_soil_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(clm_lake%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(clm_lake%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) + allocate(clm_lake%lake_h2osoi_vol3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(clm_lake%lake_h2osoi_liq3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(clm_lake%lake_h2osoi_ice3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(clm_lake%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(clm_lake%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(clm_lake%lake_clay3d(nx,ny,Model%nlevsoil_clm_lake)) + allocate(clm_lake%lake_sand3d(nx,ny,Model%nlevsoil_clm_lake)) + + allocate(clm_lake%levlake_clm_lake(Model%nlevlake_clm_lake)) + allocate(clm_lake%levsoil_clm_lake(Model%nlevsoil_clm_lake)) + allocate(clm_lake%levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake)) + allocate(clm_lake%levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake)) + + do i=1,Model%nlevlake_clm_lake + clm_lake%levlake_clm_lake(i) = i + enddo + do i=1,Model%nlevsoil_clm_lake + clm_lake%levsoil_clm_lake(i) = i + enddo + do i=-Model%nlevsnow_clm_lake,Model%nlevsoil_clm_lake + clm_lake%levsnowsoil_clm_lake(i+Model%nlevsnow_clm_lake+1) = i + enddo + do i=-Model%nlevsnow_clm_lake+1,Model%nlevsoil_clm_lake + clm_lake%levsnowsoil1_clm_lake(i+Model%nlevsnow_clm_lake) = i + enddo + end subroutine clm_lake_allocate_data + + !>@ This is clm_lake%register_axes. It registers all five axes needed + !! by CLM Lake restart data. + subroutine clm_lake_register_axes(clm_lake,Model,Sfc_restart) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + + call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) + call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) + call register_axis(Sfc_restart, 'levsnowsoil_clm_lake', dimension_length=Model%nlevsnowsoil_clm_lake) + call register_axis(Sfc_restart, 'levsnowsoil1_clm_lake', dimension_length=Model%nlevsnowsoil1_clm_lake) + end subroutine clm_lake_register_axes + + !>@ This is clm_lake%write_axes. It creates variables with the name + !! name as each clm_lake axis, and fills the variable with the + !! appropriate indices + subroutine clm_lake_write_axes(clm_lake, Model, Sfc_restart) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + integer :: i + call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsoil_clm_lake', 'double', (/'levsoil_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnowsoil_clm_lake', 'double', (/'levsnowsoil_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', 'double', (/'levsnowsoil1_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call write_data(Sfc_restart, 'levlake_clm_lake', clm_lake%levlake_clm_lake) + call write_data(Sfc_restart, 'levsoil_clm_lake', clm_lake%levsoil_clm_lake) + call write_data(Sfc_restart, 'levsnowsoil_clm_lake', clm_lake%levsnowsoil_clm_lake) + call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', clm_lake%levsnowsoil1_clm_lake) + end subroutine clm_lake_write_axes + + !>@ This is clm_lake%copy_from_grid. It copies from Sfcprop + !! variables to the corresponding data temporary variables. + !! Terrible things will happen if you don't call + !! clm_lake%allocate_data first. + subroutine clm_lake_copy_from_grid(clm_lake, Model, Atm_block, Sfcprop) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + 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 + + clm_lake%T_snow(i,j) = Sfcprop(nb)%T_snow(ix) + clm_lake%T_ice(i,j) = Sfcprop(nb)%T_ice(ix) + clm_lake%lake_snl2d(i,j) = Sfcprop(nb)%lake_snl2d(ix) + clm_lake%lake_h2osno2d(i,j) = Sfcprop(nb)%lake_h2osno2d(ix) + clm_lake%lake_tsfc(i,j) = Sfcprop(nb)%lake_tsfc(ix) + clm_lake%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) + clm_lake%lake_sndpth2d(i,j) = Sfcprop(nb)%lake_sndpth2d(ix) + clm_lake%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) + clm_lake%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) + + clm_lake%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) + clm_lake%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) + clm_lake%lake_soil_watsat3d(i,j,:) = Sfcprop(nb)%lake_soil_watsat3d(ix,:) + clm_lake%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) + clm_lake%lake_soil_tkmg3d(i,j,:) = Sfcprop(nb)%lake_soil_tkmg3d(ix,:) + clm_lake%lake_soil_tkdry3d(i,j,:) = Sfcprop(nb)%lake_soil_tkdry3d(ix,:) + clm_lake%lake_soil_tksatu3d(i,j,:) = Sfcprop(nb)%lake_soil_tksatu3d(ix,:) + clm_lake%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) + clm_lake%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) + clm_lake%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) + clm_lake%lake_h2osoi_vol3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_vol3d(ix,:) + clm_lake%lake_h2osoi_liq3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_liq3d(ix,:) + clm_lake%lake_h2osoi_ice3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_ice3d(ix,:) + clm_lake%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) + clm_lake%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) + clm_lake%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) + clm_lake%lake_clay3d(i,j,:) = Sfcprop(nb)%lake_clay3d(ix,:) + clm_lake%lake_sand3d(i,j,:) = Sfcprop(nb)%lake_sand3d(ix,:) + enddo + enddo + end subroutine clm_lake_copy_from_grid + + !>@ This is clm_lake%copy_to_grid. It copies from data temporary + !! variables to the corresponding Sfcprop variables. Terrible + !! things will happen if you don't call data%allocate_data first. + subroutine clm_lake_copy_to_grid(clm_lake, Model, Atm_block, Sfcprop) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + 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 + + Sfcprop(nb)%T_snow(ix) = clm_lake%T_snow(i,j) + Sfcprop(nb)%T_ice(ix) = clm_lake%T_ice(i,j) + Sfcprop(nb)%lake_snl2d(ix) = clm_lake%lake_snl2d(i,j) + Sfcprop(nb)%lake_h2osno2d(ix) = clm_lake%lake_h2osno2d(i,j) + Sfcprop(nb)%lake_tsfc(ix) = clm_lake%lake_tsfc(i,j) + Sfcprop(nb)%lake_savedtke12d(ix) = clm_lake%lake_savedtke12d(i,j) + Sfcprop(nb)%lake_sndpth2d(ix) = clm_lake%lake_sndpth2d(i,j) + Sfcprop(nb)%clm_lakedepth(ix) = clm_lake%clm_lakedepth(i,j) + Sfcprop(nb)%clm_lake_initialized(ix) = clm_lake%clm_lake_initialized(i,j) + + Sfcprop(nb)%lake_z3d(ix,:) = clm_lake%lake_z3d(i,j,:) + Sfcprop(nb)%lake_dz3d(ix,:) = clm_lake%lake_dz3d(i,j,:) + Sfcprop(nb)%lake_soil_watsat3d(ix,:) = clm_lake%lake_soil_watsat3d(i,j,:) + Sfcprop(nb)%lake_csol3d(ix,:) = clm_lake%lake_csol3d(i,j,:) + Sfcprop(nb)%lake_soil_tkmg3d(ix,:) = clm_lake%lake_soil_tkmg3d(i,j,:) + Sfcprop(nb)%lake_soil_tkdry3d(ix,:) = clm_lake%lake_soil_tkdry3d(i,j,:) + Sfcprop(nb)%lake_soil_tksatu3d(ix,:) = clm_lake%lake_soil_tksatu3d(i,j,:) + Sfcprop(nb)%lake_snow_z3d(ix,:) = clm_lake%lake_snow_z3d(i,j,:) + Sfcprop(nb)%lake_snow_dz3d(ix,:) = clm_lake%lake_snow_dz3d(i,j,:) + Sfcprop(nb)%lake_snow_zi3d(ix,:) = clm_lake%lake_snow_zi3d(i,j,:) + Sfcprop(nb)%lake_h2osoi_vol3d(ix,:) = clm_lake%lake_h2osoi_vol3d(i,j,:) + Sfcprop(nb)%lake_h2osoi_liq3d(ix,:) = clm_lake%lake_h2osoi_liq3d(i,j,:) + Sfcprop(nb)%lake_h2osoi_ice3d(ix,:) = clm_lake%lake_h2osoi_ice3d(i,j,:) + Sfcprop(nb)%lake_t_soisno3d(ix,:) = clm_lake%lake_t_soisno3d(i,j,:) + Sfcprop(nb)%lake_t_lake3d(ix,:) = clm_lake%lake_t_lake3d(i,j,:) + Sfcprop(nb)%lake_icefrac3d(ix,:) = clm_lake%lake_icefrac3d(i,j,:) + Sfcprop(nb)%lake_clay3d(ix,:) = clm_lake%lake_clay3d(i,j,:) + Sfcprop(nb)%lake_sand3d(ix,:) = clm_lake%lake_sand3d(i,j,:) + enddo + enddo + end subroutine clm_lake_copy_to_grid + + !>@ This is clm_lake%register_fields, and it is only used in the + !! non-quilt restart. It registers all restart fields needed by the + !! CLM Lake Model. Terrible things will happen if you don't call + !! clm_lake%allocate_data and clm_lake%register_axes first. + subroutine clm_lake_register_fields(clm_lake, Sfc_restart) + implicit none + class(clm_lake_data_type) :: clm_lake + type(FmsNetcdfDomainFile_t) :: Sfc_restart + + ! Register 2D fields + call register_restart_field(Sfc_restart, 'T_snow', clm_lake%T_snow, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'T_ice', clm_lake%T_ice, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_snl2d', clm_lake%lake_snl2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_h2osno2d', clm_lake%lake_h2osno2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_tsfc', clm_lake%lake_tsfc, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_savedtke12d', clm_lake%lake_savedtke12d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_sndpth2d', clm_lake%lake_sndpth2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'clm_lakedepth', clm_lake%clm_lakedepth, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'clm_lake_initialized', clm_lake%clm_lake_initialized, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + + ! Register 3D fields + call register_restart_field(Sfc_restart, 'lake_z3d', clm_lake%lake_z3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_dz3d', clm_lake%lake_dz3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_soil_watsat3d', clm_lake%lake_soil_watsat3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_csol3d', clm_lake%lake_csol3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_soil_tkmg3d', clm_lake%lake_soil_tkmg3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_soil_tkdry3d', clm_lake%lake_soil_tkdry3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_soil_tksatu3d', clm_lake%lake_soil_tksatu3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_z3d', clm_lake%lake_snow_z3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_dz3d', clm_lake%lake_snow_dz3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_zi3d', clm_lake%lake_snow_zi3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_h2osoi_vol3d', clm_lake%lake_h2osoi_vol3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_h2osoi_liq3d', clm_lake%lake_h2osoi_liq3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_h2osoi_ice3d', clm_lake%lake_h2osoi_ice3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_soisno3d', clm_lake%lake_t_soisno3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_lake3d', clm_lake%lake_t_lake3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_icefrac3d', clm_lake%lake_icefrac3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_clay3d', clm_lake%lake_clay3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_sand3d', clm_lake%lake_sand3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) + end subroutine clm_lake_register_fields + + !>@ This is clm_lake%bundle_fields, and it is only used in the + !! quilt restart. It bundles all fields needed by the CLM Lake + !! Model, which makes them available to ESMF for restart I/O. + !! Terrible things will happen if you don't call + !! clm_lake%allocate_data and clm_lake%register_axes first. + subroutine clm_lake_bundle_fields(clm_lake, bundle, grid, Model, outputfile) + use esmf + use GFS_typedefs, only: GFS_control_type + implicit none + class(Clm_lake_data_type) :: clm_lake + type(ESMF_FieldBundle),intent(inout) :: bundle + type(ESMF_Grid),intent(inout) :: grid + type(GFS_control_type), intent(in) :: Model + character(*), intent(in) :: outputfile + + real(kind_phys),dimension(:,:),pointer :: temp_r2d + real(kind_phys),dimension(:,:,:),pointer :: temp_r3d + integer :: num + + ! Register 2D fields + call create_2d_field_and_add_to_bundle(clm_lake%T_snow, "T_snow", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%T_ice, 'T_ice', trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%lake_snl2d, "lake_snl2d", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%lake_h2osno2d, "lake_h2osno2d", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%lake_tsfc, "lake_tsfc", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%lake_savedtke12d, "lake_savedtke12d", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%lake_sndpth2d, "lake_sndpth2d", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%clm_lakedepth, "clm_lakedepth", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%clm_lake_initialized, "clm_lake_initialized", trim(outputfile), grid, bundle) + + ! Register 3D fields + call create_3d_field_and_add_to_bundle(clm_lake%lake_z3d, 'lake_z3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_dz3d, 'lake_dz3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_watsat3d, 'lake_soil_watsat3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_csol3d, 'lake_csol3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tkmg3d, 'lake_soil_tkmg3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tkdry3d, 'lake_soil_tkdry3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tksatu3d, 'lake_soil_tksatu3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_snow_z3d, 'lake_snow_z3d', 'levsnowsoil1_clm_lake', & + clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_snow_dz3d, 'lake_snow_dz3d', 'levsnowsoil1_clm_lake', & + clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_snow_zi3d, 'lake_snow_zi3d', 'levsnowsoil_clm_lake', & + clm_lake%levsnowsoil_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_h2osoi_vol3d, 'lake_h2osoi_vol3d', 'levsnowsoil1_clm_lake', & + clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_h2osoi_liq3d, 'lake_h2osoi_liq3d', 'levsnowsoil1_clm_lake', & + clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_h2osoi_ice3d, 'lake_h2osoi_ice3d', 'levsnowsoil1_clm_lake', & + clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_t_soisno3d, 'lake_t_soisno3d', 'levsnowsoil1_clm_lake', & + clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_t_lake3d, 'lake_t_lake3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_icefrac3d, 'lake_icefrac3d', 'levlake_clm_lake', & + clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_clay3d, 'lake_clay3d', 'levsoil_clm_lake', & + clm_lake%levsoil_clm_lake, trim(outputfile), grid, bundle) + call create_3d_field_and_add_to_bundle(clm_lake%lake_sand3d, 'lake_sand3d', 'levsoil_clm_lake', & + clm_lake%levsoil_clm_lake, trim(outputfile), grid, bundle) + + end subroutine Clm_lake_bundle_fields + + !>@ Final routine (destructor) for the clm_lake_data_type, called + !! automatically when an object of that type goes out of scope. This + !! is simply a wrapper around clm_lake%deallocate_data(). + subroutine clm_lake_final(clm_lake) + implicit none + type(clm_lake_data_type) :: clm_lake + call clm_lake_deallocate_data(clm_lake) + end subroutine clm_lake_final + + !>@ This is clm_lake%deallocate_data. It deallocates all data used, + !! and nullifies the pointers. The clm_lake object can safely be + !! used again after this call. This is also the implementation of + !! the clm_lake_data_type final routine. + subroutine clm_lake_deallocate_data(clm_lake) + implicit none + class(clm_lake_data_type) :: clm_lake + + ! Deallocate and nullify any associated pointers + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(clm_lake%var)) then ; \ + deallocate(clm_lake%var) ; \ + nullify(clm_lake%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(T_snow) + IF_ASSOC_DEALLOC_NULL(T_ice) + IF_ASSOC_DEALLOC_NULL(lake_snl2d) + IF_ASSOC_DEALLOC_NULL(lake_h2osno2d) + IF_ASSOC_DEALLOC_NULL(lake_tsfc) + IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) + IF_ASSOC_DEALLOC_NULL(lake_sndpth2d) + IF_ASSOC_DEALLOC_NULL(clm_lakedepth) + IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) + + IF_ASSOC_DEALLOC_NULL(lake_z3d) + IF_ASSOC_DEALLOC_NULL(lake_dz3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_watsat3d) + IF_ASSOC_DEALLOC_NULL(lake_csol3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_tkmg3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_tkdry3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_tksatu3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) + IF_ASSOC_DEALLOC_NULL(lake_h2osoi_vol3d) + IF_ASSOC_DEALLOC_NULL(lake_h2osoi_liq3d) + IF_ASSOC_DEALLOC_NULL(lake_h2osoi_ice3d) + IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) + IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) + IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) + IF_ASSOC_DEALLOC_NULL(lake_clay3d) + IF_ASSOC_DEALLOC_NULL(lake_sand3d) + +#undef IF_ASSOC_DEALLOC_NULL + end subroutine clm_lake_deallocate_data + +end module fv3atm_clm_lake_io +!> @} diff --git a/io/fv3atm_common_io.F90 b/io/fv3atm_common_io.F90 new file mode 100644 index 000000000..1143f23ac --- /dev/null +++ b/io/fv3atm_common_io.F90 @@ -0,0 +1,518 @@ +!> \file fv3atm_common_io.F90 +!! A set of routines commonly accessed by other io/fv3atm +!! modules. This should not be accessed by other code. Most of the +!! routines in this file copy data between x-y-z arrays and +!! block-decomposed (nb-ix-z) atmosphere arrays. + +module fv3atm_common_io + use GFS_typedefs, only: kind_phys + + implicit none + private + + public :: copy_from_GFS_Data, copy_to_GFS_Data + public :: copy_from_GFS_Data_2d_phys2phys, copy_from_GFS_Data_3d_phys2phys, & + copy_from_GFS_Data_2d_int2phys, copy_from_GFS_Data_3d_int2phys, & + copy_from_GFS_Data_2d_stack_phys2phys, copy_to_GFS_Data_3d_slice_phys2phys, & + copy_to_GFS_Data_2d_phys2phys, copy_to_GFS_Data_3d_phys2phys, & + copy_to_GFS_Data_2d_int2phys, copy_to_GFS_Data_3d_int2phys + + public :: GFS_data_transfer + public :: GFS_data_transfer_2d_phys2phys, & + GFS_data_transfer_3d_phys2phys, & + GFS_data_transfer_2d_int2phys, & + GFS_data_transfer_3d_int2phys, & + GFS_data_transfer_3d_slice_phys2phys, & + GFS_data_transfer_2d_stack_phys2phys + + public :: create_2d_field_and_add_to_bundle + public :: create_3d_field_and_add_to_bundle + public :: add_zaxis_to_field + + public :: get_nx_ny_from_atm + + !>\defgroup fv3atm_common_io FV3ATM Common I/O Utilities Module + !> @{ + + !>@ These subroutines copy data from x-y-z arrays to nb-ix-z grid arrays. + !! \section copy_from_GFS_Data interface + !! There are different combinations of decomposition, copy methods, + !! and datatypes. All are combined together into copy_from_GFS_Data + !! for convenience + interface copy_from_GFS_Data + module procedure copy_from_GFS_Data_2d_phys2phys, & + copy_from_GFS_Data_3d_phys2phys, & + copy_from_GFS_Data_2d_int2phys, & + copy_from_GFS_Data_3d_int2phys, & + copy_from_GFS_Data_3d_slice_phys2phys, & + copy_from_GFS_Data_2d_stack_phys2phys + end interface copy_from_GFS_Data + + !>@ These subroutines copy data from nb-ix-z grid arrays to x-y-z arrays. + !! \section copy_to_GFS_Data interface + !! There are different combinations of decomposition, copy methods, + !! and datatypes. All are combined together into copy_to_GFS_Data + !! for convenience + interface copy_to_GFS_Data + module procedure copy_to_GFS_Data_2d_phys2phys, & + copy_to_GFS_Data_3d_phys2phys, & + copy_to_GFS_Data_2d_int2phys, & + copy_to_GFS_Data_3d_int2phys, & + copy_to_GFS_Data_3d_slice_phys2phys, & + copy_to_GFS_Data_2d_stack_phys2phys + end interface copy_to_GFS_Data + + !>@brief These subroutines copy data in either direction between nb-ix-z grid arrays and x-y-z arrays. + !> \section GFS_data_transfer interface functions. + !! This interface allows a single subroutine to handle both reading + !! and writing restart files. The direction is controled by the "to" + !! argument (first argument) which is true when copying from x-y-z + !! arrays to nb-ix-z arrays. + !! There are different combinations of decomposition, copy methods, + !! and datatypes. All are combined together into copy_to_GFS_Data + !! for convenience + interface GFS_data_transfer + module procedure GFS_data_transfer_2d_phys2phys, & + GFS_data_transfer_3d_phys2phys, & + GFS_data_transfer_2d_int2phys, & + GFS_data_transfer_3d_int2phys, & + GFS_data_transfer_3d_slice_phys2phys, & + GFS_data_transfer_2d_stack_phys2phys + end interface GFS_data_transfer + +contains + + !>@brief Convenience function to get the x and y dimensions of the grid from Atm_block + pure subroutine get_nx_ny_from_atm(Atm_block, nx, ny) + use block_control_mod, only: block_control_type + implicit none + type(block_control_type), intent(in) :: Atm_block + integer, intent(out), optional :: nx, ny + integer :: isc, iec, jsc, jec + if(present(nx)) then + isc = Atm_block%isc + iec = Atm_block%iec + nx = (iec - isc + 1) + end if + if(present(ny)) then + jsc = Atm_block%jsc + jec = Atm_block%jec + ny = (jec - jsc + 1) + endif + end subroutine get_nx_ny_from_atm + + !>@brief copies from the ix-indexed var_block to the 2d x-y real(kind_phys) var2d array + pure subroutine copy_from_GFS_Data_2d_phys2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(in) :: var_block(:) + real(kind=kind_phys), intent(out) :: var2d(:,:,:) + integer ix + + nt=nt+1 + do ix=1,size(var_block) + var2d(ii1(ix),jj1(ix),nt) = var_block(ix) + enddo + end subroutine copy_from_GFS_Data_2d_phys2phys + + !>@brief copies from the ix-k-indexed var_block to the 3d x-y-z real(kind_phys) var3d array + pure subroutine copy_from_GFS_Data_3d_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(in) :: var_block(:,:) + real(kind=kind_phys), intent(out) :: var3d(:,:,:,:) + integer ix, k + + nt=nt+1 + do k=lbound(var_block,2),ubound(var_block,2) + do ix=1,size(var_block,1) + var3d(ii1(ix),jj1(ix),k,nt) = var_block(ix,k) + enddo + enddo + end subroutine copy_from_GFS_Data_3d_phys2phys + + !>@brief copies from the ix-k-indexed var_block to the 3d x-y-z integer var2d array + pure subroutine copy_from_GFS_Data_2d_int2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc, var_block(:) + integer, intent(inout) :: nt + real(kind=kind_phys), intent(out) :: var2d(:,:,:) + integer ix + + nt=nt+1 + do ix=1,size(var_block) + var2d(ii1(ix),jj1(ix),nt) = var_block(ix) + enddo + end subroutine copy_from_GFS_Data_2d_int2phys + + !>@brief copies a range of levels from the ix-k-indexed var_block to the x-y real(kind_phys) var3d array + pure subroutine copy_from_GFS_Data_2d_stack_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + ! For copying phy_f2d and phy_fctd + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(in) :: var_block(:,:) + real(kind=kind_phys), intent(out) :: var3d(:,:,:) + integer ix, k + + nt=nt+1 + do k=lbound(var_block,2),ubound(var_block,2) + do ix=1,size(var_block,1) + var3d(ii1(ix),jj1(ix),nt) = var_block(ix,k) + enddo + enddo + end subroutine copy_from_GFS_Data_2d_stack_phys2phys + + !>@brief copies from the ix-k-indexed var_block to the x-y integer var3d array + pure subroutine copy_from_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), var_block(:,:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(out) :: var3d(:,:,:,:) + integer ix, k + + nt=nt+1 + do k=lbound(var_block,2),ubound(var_block,2) + do ix=1,size(var_block,1) + var3d(ii1(ix),jj1(ix),k,nt) = real(var_block(ix,k),kind_phys) + enddo + enddo + end subroutine copy_from_GFS_Data_3d_int2phys + + !>@brief copies a range of levels from from the ix-k-indexed var_block to the x-y-z real(kind_phys) var3d array + pure subroutine copy_from_GFS_Data_3d_slice_phys2phys(ii1,jj1,isc,jsc,nt,k1,k2,var3d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc, k1, k2 + integer, intent(inout) :: nt + real(kind=kind_phys), intent(in) :: var_block(:,:) + real(kind=kind_phys), intent(out) :: var3d(:,:,:,:) + integer ix, k + + nt=nt+1 + do k=k1,k2 + do ix=1,size(var_block,1) + var3d(ii1(ix),jj1(ix),k,nt) = var_block(ix,k) + enddo + enddo + end subroutine copy_from_GFS_Data_3d_slice_phys2phys + + !>@brief copies from x-y real(kind_phys) var2d array to the ix-indexed var_block array + pure subroutine copy_to_GFS_Data_2d_phys2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(out) :: var_block(:) + real(kind=kind_phys), intent(in) :: var2d(:,:,:) + integer ix + + nt=nt+1 + do ix=1,size(var_block) + var_block(ix) = var2d(ii1(ix),jj1(ix),nt) + enddo + end subroutine copy_to_GFS_Data_2d_phys2phys + + !>@brief copies from x-y-z real(kind_phys) var3d array to the ix-k-indexed var_block array + pure subroutine copy_to_GFS_Data_3d_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(out) :: var_block(:,:) + real(kind=kind_phys), intent(in) :: var3d(:,:,:,:) + integer ix, k + + nt=nt+1 + do k=lbound(var_block,2),ubound(var_block,2) + do ix=1,size(var_block,1) + var_block(ix,k) = var3d(ii1(ix),jj1(ix),k,nt) + enddo + enddo + end subroutine copy_to_GFS_Data_3d_phys2phys + + !>@brief copies from x-y-z real(kind_phys) var3d array to the ix-k-indexed var_block array + pure subroutine copy_to_GFS_Data_2d_stack_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + ! For copying phy_f2d and phy_fctd + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(out) :: var_block(:,:) + real(kind=kind_phys), intent(in) :: var3d(:,:,:) + integer ix, k + + nt=nt+1 + do k=lbound(var_block,2),ubound(var_block,2) + do ix=1,size(var_block,1) + var_block(ix,k) = var3d(ii1(ix),jj1(ix),nt) + enddo + enddo + end subroutine copy_to_GFS_Data_2d_stack_phys2phys + + !>@brief copies a range of levels from the x-y-z real(kind_phys) var3d array to the ix-k-indexed var_block array + pure subroutine copy_to_GFS_Data_3d_slice_phys2phys(ii1,jj1,isc,jsc,nt,k1,k2,var3d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc, k1, k2 + integer, intent(inout) :: nt + real(kind=kind_phys), intent(out) :: var_block(:,:) + real(kind=kind_phys), intent(in) :: var3d(:,:,:,:) + integer ix, k + + nt=nt+1 + do k=k1,k2 + do ix=1,size(var_block,1) + var_block(ix,k) = var3d(ii1(ix),jj1(ix),k,nt) + enddo + enddo + end subroutine copy_to_GFS_Data_3d_slice_phys2phys + + !>@brief copies from x-y integer var2d array to the ix-indexed var_block array + pure subroutine copy_to_GFS_Data_2d_int2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + integer, intent(out) :: var_block(:) + real(kind=kind_phys), intent(in) :: var2d(:,:,:) + integer ix + + nt=nt+1 + do ix=1,size(var_block) + var_block(ix) = int(var2d(ii1(ix),jj1(ix),nt)) + enddo + end subroutine copy_to_GFS_Data_2d_int2phys + + !>@brief copies from x-y-z integer var3d array to the ix-k-indexed var_block array + pure subroutine copy_to_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + implicit none + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + integer, intent(out) :: var_block(:,:) + real(kind=kind_phys), intent(in) :: var3d(:,:,:,:) + integer ix + + nt=nt+1 + do ix=1,size(var_block,1) + var_block(ix,:) = int(var3d(ii1(ix),jj1(ix),:,nt)) + enddo + end subroutine copy_to_GFS_Data_3d_int2phys + + !>@brief copies between the ix-indexed var_block array and x-y real(kind_phys) var2d array. + !> \section GFS_data_transfer_2d_phys2phys subroutine from the GFS_data_transfer interface + !! This is a wrapper around copy_to_GFS_Data and copy_from_GFS_Data routines. + !! If to=true, then data is copied to var_block (the GFS_Data structures) but if + !! to=false, it is copied from the var_block arrays. This allows the same subroutine + !! to both read and write, preventing error-prone code duplication. + pure subroutine GFS_data_transfer_2d_phys2phys(to,ii1,jj1,isc,jsc,nt,var2d,var_block) + implicit none + logical, intent(in) :: to + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(inout) :: var_block(:) + real(kind=kind_phys), intent(inout) :: var2d(:,:,:) + + if(to) then + call copy_to_GFS_Data_2d_phys2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + else + call copy_from_GFS_Data_2d_phys2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + end if + end subroutine GFS_data_transfer_2d_phys2phys + + !>@brief copies between the ix-k-indexed var_block array and x-y-z real(kind_phys) var3d array. + !> \section GFS_data_transfer_3d_phys2phys subroutine from the GFS_data_transfer interface + !! This is a wrapper around copy_to_GFS_Data and copy_from_GFS_Data routines. + !! If to=true, then data is copied to var_block (the GFS_Data structures) but if + !! to=false, it is copied from the var_block arrays. This allows the same subroutine + !! to both read and write, preventing error-prone code duplication. + pure subroutine GFS_data_transfer_3d_phys2phys(to,ii1,jj1,isc,jsc,nt,var3d,var_block) + implicit none + logical, intent(in) :: to + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(inout) :: var_block(:,:) + real(kind=kind_phys), intent(inout) :: var3d(:,:,:,:) + + if(to) then + call copy_to_GFS_Data_3d_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + else + call copy_from_GFS_Data_3d_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + endif + end subroutine GFS_data_transfer_3d_phys2phys + + !>@brief copies a range of levels between the ix-k-indexed var_block array and x-y-z real(kind_phys) var3d array. + !> \section GFS_data_transfer_3d_slice_phys2phys subroutine from the GFS_data_transfer interface + !! This is a wrapper around copy_to_GFS_Data and copy_from_GFS_Data routines. + !! If to=true, then data is copied to var_block (the GFS_Data structures) but if + !! to=false, it is copied from the var_block arrays. This allows the same subroutine + !! to both read and write, preventing error-prone code duplication. + pure subroutine GFS_data_transfer_3d_slice_phys2phys(to,ii1,jj1,isc,jsc,nt,k1,k2,var3d,var_block) + implicit none + logical, intent(in) :: to + integer, intent(in) :: ii1(:), jj1(:), isc, jsc, k1, k2 + integer, intent(inout) :: nt + real(kind=kind_phys), intent(inout) :: var_block(:,:) + real(kind=kind_phys), intent(inout) :: var3d(:,:,:,:) + + if(to) then + call copy_to_GFS_Data_3d_slice_phys2phys(ii1,jj1,isc,jsc,nt,k1,k2,var3d,var_block) + else + call copy_from_GFS_Data_3d_slice_phys2phys(ii1,jj1,isc,jsc,nt,k1,k2,var3d,var_block) + endif + end subroutine GFS_data_transfer_3d_slice_phys2phys + + !>@brief copies between the ix-indexed var_block array and x-y integer var2d array. + !> \section GFS_data_transfer_2d_int2phys subroutine from the GFS_data_transfer interface + !! This is a wrapper around copy_to_GFS_Data and copy_from_GFS_Data routines. + !! If to=true, then data is copied to var_block (the GFS_Data structures) but if + !! to=false, it is copied from the var_block arrays. This allows the same subroutine + !! to both read and write, preventing error-prone code duplication. + pure subroutine GFS_data_transfer_2d_int2phys(to,ii1,jj1,isc,jsc,nt,var2d,var_block) + implicit none + logical, intent(in) :: to + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + integer, intent(inout) :: var_block(:) + real(kind=kind_phys), intent(inout) :: var2d(:,:,:) + + if(to) then + call copy_to_GFS_Data_2d_int2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + else + call copy_from_GFS_Data_2d_int2phys(ii1,jj1,isc,jsc,nt,var2d,var_block) + endif + end subroutine GFS_data_transfer_2d_int2phys + + !>@brief copies between the ix-k-indexed var_block array and x-y-z integer var3d array. + !> \section GFS_data_transfer_3d_int2phys subroutine from the GFS_data_transfer interface + !! This is a wrapper around copy_to_GFS_Data and copy_from_GFS_Data routines. + !! If to=true, then data is copied to var_block (the GFS_Data structures) but if + !! to=false, it is copied from the var_block arrays. This allows the same subroutine + !! to both read and write, preventing error-prone code duplication. + pure subroutine GFS_data_transfer_3d_int2phys(to,ii1,jj1,isc,jsc,nt,var3d,var_block) + implicit none + logical, intent(in) :: to + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + integer, intent(inout) :: var_block(:,:) + real(kind=kind_phys), intent(inout) :: var3d(:,:,:,:) + + if(to) then + call copy_to_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + else + call copy_from_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + endif + end subroutine GFS_data_transfer_3d_int2phys + + !>@brief copies a range of levels between the ix-k-indexed var_block array and x-y-z real(kind_phys) var3d array. + !> \section GFS_Data_transfer_2d_stack_phys2phys subroutine from the GFS_data_transfer interface + !! This is a wrapper around copy_to_GFS_Data and copy_from_GFS_Data routines. + !! If to=true, then data is copied to var_block (the GFS_Data structures) but if + !! to=false, it is copied from the var_block arrays. This allows the same subroutine + !! to both read and write, preventing error-prone code duplication. + pure subroutine GFS_Data_transfer_2d_stack_phys2phys(to,ii1,jj1,isc,jsc,nt,var3d,var_block) + ! For copying phy_f2d and phy_fctd + implicit none + logical, intent(in) :: to + integer, intent(in) :: ii1(:), jj1(:), isc, jsc + integer, intent(inout) :: nt + real(kind=kind_phys), intent(inout) :: var_block(:,:) + real(kind=kind_phys), intent(inout) :: var3d(:,:,:) + integer ix, k + + if(to) then + call copy_to_GFS_data_2d_stack_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + else + call copy_from_GFS_data_2d_stack_phys2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) + end if + end subroutine GFS_Data_transfer_2d_stack_phys2phys + + !>@brief adds a 2D restart array to an ESMF bundle for quilting restarts. + subroutine create_2d_field_and_add_to_bundle(temp_r2d, field_name, outputfile, grid, bundle) + + use esmf + + implicit none + + real(kind_phys), dimension(:,:), pointer, intent(in) :: temp_r2d + character(len=*), intent(in) :: field_name + character(len=*), intent(in) :: outputfile + type(ESMF_Grid), intent(in) :: grid + type(ESMF_FieldBundle), intent(inout) :: bundle + + type(ESMF_Field) :: field + + integer :: rc, i + + field = ESMF_FieldCreate(grid, temp_r2d, datacopyflag=ESMF_DATACOPY_REFERENCE, & + name=trim(field_name), indexFlag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", name='output_file', value=trim(outputfile), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_FieldBundleAdd(bundle, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + end subroutine create_2d_field_and_add_to_bundle + + !>@brief adds a 3D restart array and its vertical axis to an ESMF bundle for quilting restarts. + subroutine create_3d_field_and_add_to_bundle(temp_r3d, field_name, axis_name, axis_values, outputfile, grid, bundle) + + use esmf + + implicit none + + real(kind_phys), dimension(:,:,:), pointer, intent(in) :: temp_r3d + character(len=*), intent(in) :: field_name + character(len=*), intent(in) :: axis_name + real(kind_phys), dimension(:), intent(in) :: axis_values + character(len=*), intent(in) :: outputfile + type(ESMF_Grid), intent(in) :: grid + type(ESMF_FieldBundle), intent(inout) :: bundle + + type(ESMF_Field) :: field + + integer :: rc, i + + field = ESMF_FieldCreate(grid, temp_r3d, datacopyflag=ESMF_DATACOPY_REFERENCE, & + name=trim(field_name), indexFlag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__, file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", name='output_file', value=trim(outputfile), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call add_zaxis_to_field(field, axis_name, axis_values) + + call ESMF_FieldBundleAdd(bundle, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + end subroutine create_3d_field_and_add_to_bundle + + !>@brief adds a vertical axis to an ESMF bundle for quilting restarts. + subroutine add_zaxis_to_field(field, axis_name, axis_values) + + use esmf + + implicit none + + type(ESMF_Field), intent(inout) :: field + character(len=*), intent(in) :: axis_name + real(kind_phys), dimension(:), intent(in) :: axis_values + + integer :: rc + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name="ESMF:ungridded_dim_labels", valueList=(/trim(axis_name)/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3-dim", & + name=trim(axis_name), valueList=axis_values, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3-dim", & + name=trim(axis_name)//"cartesian_axis", value="Z", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine add_zaxis_to_field + +end module fv3atm_common_io +!> @} diff --git a/io/fv3atm_history_io.F90 b/io/fv3atm_history_io.F90 new file mode 100644 index 000000000..7c73fe296 --- /dev/null +++ b/io/fv3atm_history_io.F90 @@ -0,0 +1,1184 @@ +!> \file fv3atm_history_io.F90 +!! This file defines routines used to output atmosphere diagnostic +!! (history) data from the physics and surface fields, both for quilt +!! and non-quilt output. +module fv3atm_history_io_mod + + ! + !--- FMS/GFDL modules + use block_control_mod, only: block_control_type + use mpp_mod, only: mpp_error, mpp_pe, mpp_root_pe, FATAL + use mpp_domains_mod, only: domain1d, domainUG + use time_manager_mod, only: time_type + use diag_manager_mod, only: register_diag_field, send_data + use diag_axis_mod, only: get_axis_global_length, get_diag_axis, & + get_diag_axis_name + use diag_data_mod, only: output_fields, max_output_fields + use diag_util_mod, only: find_input_field + use constants_mod, only: grav, rdgas + ! + !--- GFS_typedefs + use GFS_typedefs, only: GFS_control_type, kind_phys + use GFS_diagnostics, only: GFS_externaldiag_type + + ! + !----------------------------------------------------------------------- + implicit none + private + + !--- public interfaces --- + public fv3atm_diag_register, fv3atm_diag_output +#ifdef use_WRTCOMP + public fv_phys_bundle_setup +#endif + + !>\defgroup fv3atm_history_io_mod FV3ATM History I/O Module + !> @{ + + !>@ The maximum allowed number of diagnostic fields that can be defined in any given model run. + !! This does not include rrfs-sd or clm lake, which have their own data structures. + integer, parameter, public :: DIAG_SIZE = 800 + + real, parameter :: missing_value = 9.99e20_kind_phys + real, parameter :: stndrd_atmos_ps = 101325.0_kind_phys + real, parameter :: stndrd_atmos_lapse = 0.0065_kind_phys + real, parameter :: drythresh = 1.e-4_kind_phys + real, parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys + + !>@ Storage type for temporary data during output of diagnostic (history) files + type history_type + integer :: tot_diag_idx = 0 + + integer :: isco=0,ieco=0,jsco=0,jeco=0,levo=0,num_axes_phys=0 + integer :: fhzero=0, ncld=0, nsoil=0, imp_physics=0, landsfcmdl=0 + real(4) :: dtp=0 + integer,dimension(:), pointer :: nstt => null() + integer,dimension(:), pointer :: nstt_vctbl => null() + integer,dimension(:), pointer :: all_axes => null() + character(20),dimension(:), pointer :: axis_name => null() + real(4), dimension(:,:,:), pointer :: buffer_phys_bl => null() + real(4), dimension(:,:,:), pointer :: buffer_phys_nb => null() + real(4), dimension(:,:,:,:), pointer :: buffer_phys_windvect => null() + real(kind=kind_phys),dimension(:,:),pointer :: lon => null() + real(kind=kind_phys),dimension(:,:),pointer :: lat => null() + real(kind=kind_phys),dimension(:,:),pointer :: uwork => null() + real(kind=kind_phys),dimension(:,:,:),pointer:: uwork3d => null() + logical :: uwork_set = .false. + character(128) :: uwindname = "(noname)" + + !--- miscellaneous other variables + logical :: use_wrtgridcomp_output = .FALSE. + contains + procedure :: register => history_type_register + procedure :: output => history_type_output + procedure :: store_data => history_type_store_data + procedure :: store_data3D => history_type_store_data3D +#ifdef use_WRTCOMP + procedure :: bundle_setup => history_type_bundle_setup + procedure :: add_field_to_phybundle => history_type_add_field_to_phybundle + procedure :: find_output_name => history_type_find_output_name +#endif + end type history_type + + !>@ This shared_history_data instance of history_type is shared between all calls to public module subroutines. + type(history_type) :: shared_history_data + +CONTAINS + + !>@brief Registers diagnostic variables with the FMS diagnostic manager. + !> \section fv3atm_diag_register subroutine + !! Creates and populates a data type which is then used to "register" + !! diagnostic variables with the GFDL FMS diagnostic manager. + !! includes short & long names, units, conversion factors, etc. + !! there is no copying of data, but instead a clever use of pointers. + !! calls a GFDL FMS routine to register diagnositcs and compare against + !! the diag_table to determine what variables are to be output. + subroutine fv3atm_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) + use physcons, only: con_g + implicit none + !--- subroutine interface variable definitions + type(GFS_externaldiag_type), intent(inout) :: Diag(:) + type(time_type), intent(in) :: Time + type (block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + real(kind=kind_phys), intent(in) :: xlon(:,:) + real(kind=kind_phys), intent(in) :: xlat(:,:) + integer, dimension(4), intent(in) :: axes + + call shared_history_data%register(Diag, Time, Atm_block, Model, xlon, xlat, axes) + end subroutine fv3atm_diag_register + + !>@brief Transfers diagnostic data to the FMS diagnostic manager + !> \section fv3atm_diag_output subroutine + !! This routine transfers diagnostic data to the FMS diagnostic + !! manager for eventual output to the history files. + subroutine fv3atm_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & + dt, time_int, time_intfull, time_radsw, time_radlw) + !--- subroutine interface variable definitions + type(time_type), intent(in) :: time + type(GFS_externaldiag_type), intent(in) :: diag(:) + type (block_control_type), intent(in) :: atm_block + integer, intent(in) :: nx, ny, levs, ntcw, ntoz + real(kind=kind_phys), intent(in) :: dt + real(kind=kind_phys), intent(in) :: time_int + real(kind=kind_phys), intent(in) :: time_intfull + real(kind=kind_phys), intent(in) :: time_radsw + real(kind=kind_phys), intent(in) :: time_radlw + + call shared_history_data%output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & + dt, time_int, time_intfull, time_radsw, time_radlw) + + end subroutine fv3atm_diag_output + +#ifdef use_WRTCOMP + !>@brief Sets up the ESMF bundle to use for quilt diagnostic output + !> \section fv_phys_bundle_setup subroutine + !! This part of the write component (quilt) sets up the ESMF bundles + !! to use for writing diagnostic output. It is only defined when the + !! write component is enabled at compile time. + subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys, rc) + ! + !------------------------------------------------------------- + !*** set esmf bundle for phys output fields + !------------------------------------------------------------ + ! + use esmf + use diag_data_mod, ONLY: diag_atttype + ! + implicit none + ! + type(GFS_externaldiag_type),intent(in) :: Diag(:) + integer, intent(in) :: axes(:) + type(ESMF_FieldBundle),intent(inout) :: phys_bundle(:) + type(ESMF_Grid),intent(inout) :: fcst_grid + logical,intent(in) :: quilting + integer, intent(in) :: nbdlphys + integer,intent(out) :: rc + + call shared_history_data%bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys, rc) + end subroutine fv_phys_bundle_setup +#endif + + !>@brief Private implementation of fv3atm_diag_register. Do not call directly. + !> \section history_type%register procedure + !! This is the history_type%register procedure, which provides the internal + !! implementation of fv3atm_diag_register. Do not call this directly. + subroutine history_type_register(hist, Diag, Time, Atm_block, Model, xlon, xlat, axes) + use physcons, only: con_g + implicit none + !--- subroutine interface variable definitions + class(history_type) :: hist + type(GFS_externaldiag_type), intent(inout) :: Diag(:) + type(time_type), intent(in) :: Time + type (block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + real(kind=kind_phys), intent(in) :: xlon(:,:) + real(kind=kind_phys), intent(in) :: xlat(:,:) + integer, dimension(4), intent(in) :: axes + !--- local variables + integer :: idx, nrgst_bl, nrgst_nb, nrgst_vctbl + + hist%isco = Atm_block%isc + hist%ieco = Atm_block%iec + hist%jsco = Atm_block%jsc + hist%jeco = Atm_block%jec + hist%levo = model%levs + hist%fhzero = nint(Model%fhzero) + ! hist%ncld = Model%ncld + hist%ncld = Model%imp_physics + hist%nsoil = Model%lsoil + hist%dtp = Model%dtp + hist%imp_physics = Model%imp_physics + hist%landsfcmdl = Model%lsm + ! print *,'in fv3atm_diag_register,hist%ncld=',Model%ncld,Model%lsoil,Model%imp_physics, & + ! ' hist%dtp=',hist%dtp,' hist%landsfcmdl=',Model%lsm + ! + !save lon/lat for vector interpolation + allocate(hist%lon(hist%isco:hist%ieco,hist%jsco:hist%jeco)) + allocate(hist%lat(hist%isco:hist%ieco,hist%jsco:hist%jeco)) + hist%lon = xlon + hist%lat = xlat + + do idx = 1,DIAG_SIZE + if (trim(Diag(idx)%name) == '') exit + hist%tot_diag_idx = idx + enddo + + if (hist%tot_diag_idx == DIAG_SIZE) then + call mpp_error(fatal, 'fv3atm_io::fv3atm_diag_register - need to increase parameter DIAG_SIZE') + endif + + allocate(hist%nstt(hist%tot_diag_idx), hist%nstt_vctbl(hist%tot_diag_idx)) + hist%nstt = 0 + hist%nstt_vctbl = 0 + nrgst_bl = 0 + nrgst_nb = 0 + nrgst_vctbl = 0 + hist%num_axes_phys = 2 + do idx = 1,hist%tot_diag_idx + if (diag(idx)%axes == -99) then + call mpp_error(fatal, 'gfs_driver::gfs_diag_register - attempt to register an undefined variable') + endif + Diag(idx)%id = register_diag_field (trim(Diag(idx)%mod_name), trim(Diag(idx)%name), & + axes(1:Diag(idx)%axes), Time, trim(Diag(idx)%desc), & + trim(Diag(idx)%unit), missing_value=real(missing_value)) + if(Diag(idx)%id > 0) then + if (Diag(idx)%axes == 2) then + if( index(trim(Diag(idx)%intpl_method),'bilinear') > 0 ) then + nrgst_bl = nrgst_bl + 1 + hist%nstt(idx) = nrgst_bl + else if (trim(Diag(idx)%intpl_method) == 'nearest_stod' ) then + nrgst_nb = nrgst_nb + 1 + hist%nstt(idx) = nrgst_nb + endif + if(trim(Diag(idx)%intpl_method) == 'vector_bilinear') then + if(Diag(idx)%name(1:1) == 'v' .or. Diag(idx)%name(1:1) == 'V') then + nrgst_vctbl = nrgst_vctbl + 1 + hist%nstt_vctbl(idx) = nrgst_vctbl + ! print *,'in phy_setup, vector_bilinear, name=', trim(Diag(idx)%name),' nstt_vctbl=', hist%nstt_vctbl(idx), 'idx=',idx + endif + endif + else if (diag(idx)%axes == 3) then + if( index(trim(diag(idx)%intpl_method),'bilinear') > 0 ) then + hist%nstt(idx) = nrgst_bl + 1 + nrgst_bl = nrgst_bl + hist%levo + else if (trim(diag(idx)%intpl_method) == 'nearest_stod' ) then + hist%nstt(idx) = nrgst_nb + 1 + nrgst_nb = nrgst_nb + hist%levo + endif + if(trim(diag(idx)%intpl_method) == 'vector_bilinear') then + if(diag(idx)%name(1:1) == 'v' .or. diag(idx)%name(1:1) == 'V') then + hist%nstt_vctbl(idx) = nrgst_vctbl + 1 + nrgst_vctbl = nrgst_vctbl + hist%levo + ! print *,'in phy_setup, vector_bilinear, name=', trim(diag(idx)%name),' nstt_vctbl=', hist%nstt_vctbl(idx), 'idx=',idx + endif + endif + hist%num_axes_phys = 3 + endif + endif + + enddo + + allocate(hist%buffer_phys_bl(hist%isco:hist%ieco,hist%jsco:hist%jeco,nrgst_bl)) + allocate(hist%buffer_phys_nb(hist%isco:hist%ieco,hist%jsco:hist%jeco,nrgst_nb)) + allocate(hist%buffer_phys_windvect(3,hist%isco:hist%ieco,hist%jsco:hist%jeco,nrgst_vctbl)) + hist%buffer_phys_bl = zero + hist%buffer_phys_nb = zero + hist%buffer_phys_windvect = zero + if(mpp_pe() == mpp_root_pe()) print *,'in fv3atm_diag_register, nrgst_bl=',nrgst_bl,' nrgst_nb=',nrgst_nb, & + ' nrgst_vctbl=',nrgst_vctbl, 'hist%isco=',hist%isco,hist%ieco,'hist%jsco=',hist%jsco,hist%jeco,' hist%num_axes_phys=', hist%num_axes_phys + + end subroutine history_type_register + + !>@brief Internal implementation of fv3atm_diag_output + !> \section history_type%output procedure + !! This is history_type%output, which provides the internal + !! implementation of the public fv3atm_diag_output routine. Never + !! call this directly. + subroutine history_type_output(hist, time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & + dt, time_int, time_intfull, time_radsw, time_radlw) + !--- subroutine interface variable definitions + class(history_type) :: hist + type(time_type), intent(in) :: time + type(GFS_externaldiag_type), intent(in) :: diag(:) + type (block_control_type), intent(in) :: atm_block + integer, intent(in) :: nx, ny, levs, ntcw, ntoz + real(kind=kind_phys), intent(in) :: dt + real(kind=kind_phys), intent(in) :: time_int + real(kind=kind_phys), intent(in) :: time_intfull + real(kind=kind_phys), intent(in) :: time_radsw + real(kind=kind_phys), intent(in) :: time_radlw + !--- local variables + integer :: i, j, k, idx, nb, ix, ii, jj + character(len=2) :: xtra +#ifdef CCPP_32BIT + real, dimension(nx,ny) :: var2 + real, dimension(nx,ny,levs) :: var3 +#else + real(kind=kind_phys), dimension(nx,ny) :: var2 + real(kind=kind_phys), dimension(nx,ny,levs) :: var3 +#endif + real(kind=kind_phys) :: rtime_int, rtime_intfull, lcnvfac + real(kind=kind_phys) :: rtime_radsw, rtime_radlw + + rtime_int = one/time_int + rtime_intfull = one/time_intfull + rtime_radsw = one/time_radsw + rtime_radlw = one/time_radlw + + ! if(mpp_pe()==mpp_root_pe())print *,'in,fv3atm_io. time avg, time_int=',time_int + history_loop: do idx = 1,hist%tot_diag_idx + has_id: if (diag(idx)%id > 0) then + lcnvfac = diag(idx)%cnvfac + if (diag(idx)%time_avg) then + if ( trim(diag(idx)%time_avg_kind) == 'full' ) then + lcnvfac = lcnvfac*rtime_intfull + ! if(mpp_pe()==mpp_root_pe())print *,'in,fv3atm_io. full time avg, field=',trim(Diag(idx)%name),' time=',time_intfull + else if ( trim(diag(idx)%time_avg_kind) == 'rad_lw' ) then + lcnvfac = lcnvfac*min(rtime_radlw,rtime_int) + ! if(mpp_pe()==mpp_root_pe())print *,'in,fv3atm_io. rad longwave avg, field=',trim(Diag(idx)%name),' time=',time_radlw + else if ( trim(diag(idx)%time_avg_kind) == 'rad_sw' ) then + lcnvfac = lcnvfac*min(rtime_radsw,rtime_int) + ! if(mpp_pe()==mpp_root_pe())print *,'in,fv3atm_io. rad shortwave avg, field=',trim(Diag(idx)%name),' time=',time_radsw + else if ( trim(diag(idx)%time_avg_kind) == 'rad_swlw_min' ) then + lcnvfac = lcnvfac*min(max(rtime_radsw,rtime_radlw),rtime_int) + ! if(mpp_pe()==mpp_root_pe())print *,'in,fv3atm_io. rad swlw min avg, field=',trim(Diag(idx)%name),' time=',time_radlw,time_radsw,time_int + else + lcnvfac = lcnvfac*rtime_int + endif + endif + if_2d: if (diag(idx)%axes == 2) then + ! 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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 + call hist%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_mask: 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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 + 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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 + 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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 + 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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 + 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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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) + enddo + enddo + elseif (trim(Diag(idx)%mask) == 'pseudo_ps') then + if ( hist%use_wrtgridcomp_output ) then + do j = 1, ny + jj = j + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%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 if_mask + 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 hist%store_data(Diag(idx)%id, var2, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) + ! if(trim(Diag(idx)%name) == 'totprcp_ave' ) print *,'in gfs_io, totprcp=',Diag(idx)%data(1)%var2(1:3), & + ! ' lcnvfac=', lcnvfac + elseif (Diag(idx)%axes == 3) then + !--- + !--- skipping other 3D variables with the following else statement + !--- + ! if(mpp_pe()==mpp_root_pe())print *,'in,fv3atm_io. 3D fields, idx=',idx,'varname=',trim(diag(idx)%name), & + ! 'lcnvfac=',lcnvfac, 'hist%levo=',hist%levo,'nx=',nx,'ny=',ny + do k=1, hist%levo + do j = 1, ny + jj = j + Atm_block%jsc -1 + do i = 1, nx + ii = i + Atm_block%isc -1 + nb = Atm_block%blkno(ii,jj) + ix = Atm_block%ixp(ii,jj) + ! if(mpp_pe()==mpp_root_pe())print *,'in,fv3atm_io,sze(Diag(idx)%data(nb)%var3)=', & + ! size(Diag(idx)%data(nb)%var3,1),size(Diag(idx)%data(nb)%var3,2) + var3(i,j,k) = Diag(idx)%data(nb)%var3(ix,hist%levo-k+1)*lcnvfac + enddo + enddo + enddo + call hist%store_data3D(Diag(idx)%id, var3, Time, idx, Diag(idx)%intpl_method, Diag(idx)%name) + endif if_2d + endif has_id + end do history_loop + end subroutine history_type_output + + !>@brief Part of the internal implementation of history_type_output (history_type%output) + !> \section history_type%store_data procedure + !! This routine copies data from an x-y array to internal buffers for later output. + !! Never call this subroutine directly; call fv3atm_diag_output instead. + subroutine history_type_store_data(hist,id, work, Time, idx, intpl_method, fldname) + implicit none + class(history_type) :: hist + integer, intent(in) :: id + integer, intent(in) :: idx +#ifdef CCPP_32BIT + real, intent(in) :: work(:,:) +#else + real(kind=kind_phys), intent(in) :: work(hist%ieco-hist%isco+1,hist%jeco-hist%jsco+1) +#endif + type(time_type), intent(in) :: Time + character(*), intent(in) :: intpl_method + character(*), intent(in) :: fldname + ! + real(kind=kind_phys) :: sinlat, sinlon, coslon + integer j,i,nv,i1,j1 + logical used + ! + if_has_id: if( id > 0 ) then + if_gridcomp: if( hist%use_wrtgridcomp_output ) then + if_interp: if( trim(intpl_method) == 'bilinear') then + !$omp parallel do default(shared) private(i,j) + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%buffer_phys_bl(i,j,hist%nstt(idx)) = work(i-hist%isco+1,j-hist%jsco+1) + enddo + enddo + else if(trim(intpl_method) == 'nearest_stod') then + !$omp parallel do default(shared) private(i,j) + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%buffer_phys_nb(i,j,hist%nstt(idx)) = work(i-hist%isco+1,j-hist%jsco+1) + enddo + enddo + else if(trim(intpl_method) == 'vector_bilinear') then + !first save the data + !$omp parallel do default(shared) private(i,j) + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%buffer_phys_bl(i,j,hist%nstt(idx)) = work(i-hist%isco+1,j-hist%jsco+1) + enddo + enddo + if_u_wind: if( fldname(1:1) == 'u' .or. fldname(1:1) == 'U') then + if(.not.associated(hist%uwork)) allocate(hist%uwork(hist%isco:hist%ieco,hist%jsco:hist%jeco)) + !$omp parallel do default(shared) private(i,j) + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%uwork(i,j) = work(i-hist%isco+1,j-hist%jsco+1) + enddo + enddo + hist%uwindname = fldname + hist%uwork_set = .true. + endif if_u_wind + if_v_wind: if( fldname(1:1) == 'v' .or. fldname(1:1) == 'V') then + !set up wind vector + if( hist%uwork_set .and. trim(hist%uwindname(2:)) == trim(fldname(2:))) then + nv = hist%nstt_vctbl(idx) + !$omp parallel do default(shared) private(i,j,i1,j1,sinlat,sinlon,coslon) + do j= hist%jsco,hist%jeco + j1 = j-hist%jsco+1 + do i= hist%isco,hist%ieco + i1 = i-hist%isco+1 + sinlat = sin(hist%lat(i,j)) + sinlon = sin(hist%lon(i,j)) + coslon = cos(hist%lon(i,j)) + hist%buffer_phys_windvect(1,i,j,nv) = hist%uwork(i,j)*coslon - work(i1,j1)*sinlat*sinlon + hist%buffer_phys_windvect(2,i,j,nv) = hist%uwork(i,j)*sinlon + work(i1,j1)*sinlat*coslon + hist%buffer_phys_windvect(3,i,j,nv) = work(i1,j1)*cos(hist%lat(i,j)) + enddo + enddo + endif + hist%uwork = zero + hist%uwindname = '' + hist%uwork_set = .false. + endif if_v_wind + + endif if_interp + else + used = send_data(id, work, Time) + endif if_gridcomp + endif if_has_id + ! + end subroutine history_type_store_data + + !>@brief Part of the internal implementation of history_type_output (history_type%output) + !> \section history_type%store_data3D procedure + !! This routine copies data from an x-y-z array to internal buffers for later output. + !! Never call this subroutine directly; call fv3atm_diag_output instead. + subroutine history_type_store_data3D(hist, id, work, Time, idx, intpl_method, fldname) + implicit none + class(history_type) :: hist + integer, intent(in) :: id + integer, intent(in) :: idx +#ifdef CCPP_32BIT + real, intent(in) :: work(:,:,:) +#else + real(kind=kind_phys), intent(in) :: work(hist%ieco-hist%isco+1,hist%jeco-hist%jsco+1,hist%levo) +#endif + type(time_type), intent(in) :: Time + character(*), intent(in) :: intpl_method + character(*), intent(in) :: fldname + ! + real(kind=kind_phys), allocatable, dimension(:,:) :: sinlon, coslon, sinlat, coslat + integer k,j,i,nv,i1,j1 + logical used + ! + if( id > 0 ) then + if( hist%use_wrtgridcomp_output ) then + if( trim(intpl_method) == 'bilinear') then + !$omp parallel do default(shared) private(i,j,k) + do k= 1,hist%levo + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%buffer_phys_bl(i,j,hist%nstt(idx)+k-1) = work(i-hist%isco+1,j-hist%jsco+1,k) + enddo + enddo + enddo + else if(trim(intpl_method) == 'nearest_stod') then + !$omp parallel do default(shared) private(i,j,k) + do k= 1,hist%levo + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%buffer_phys_nb(i,j,hist%nstt(idx)+k-1) = work(i-hist%isco+1,j-hist%jsco+1,k) + enddo + enddo + enddo + else if(trim(intpl_method) == 'vector_bilinear') then + !first save the data + !$omp parallel do default(shared) private(i,j,k) + do k= 1,hist%levo + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%buffer_phys_bl(i,j,hist%nstt(idx)+k-1) = work(i-hist%isco+1,j-hist%jsco+1,k) + enddo + enddo + enddo + if( fldname(1:1) == 'u' .or. fldname(1:1) == 'U') then + if(.not.associated(hist%uwork3d)) allocate(hist%uwork3d(hist%isco:hist%ieco,hist%jsco:hist%jeco,hist%levo)) + !$omp parallel do default(shared) private(i,j,k) + do k= 1, hist%levo + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + hist%uwork3d(i,j,k) = work(i-hist%isco+1,j-hist%jsco+1,k) + enddo + enddo + enddo + hist%uwindname = fldname + hist%uwork_set = .true. + endif + if( fldname(1:1) == 'v' .or. fldname(1:1) == 'V') then + !set up wind vector + if( hist%uwork_set .and. trim(hist%uwindname(2:)) == trim(fldname(2:))) then + allocate (sinlon(hist%isco:hist%ieco,hist%jsco:hist%jeco), coslon(hist%isco:hist%ieco,hist%jsco:hist%jeco), & + sinlat(hist%isco:hist%ieco,hist%jsco:hist%jeco), coslat(hist%isco:hist%ieco,hist%jsco:hist%jeco)) + !$omp parallel do default(shared) private(i,j) + do j= hist%jsco,hist%jeco + do i= hist%isco,hist%ieco + sinlon(i,j) = sin(hist%lon(i,j)) + coslon(i,j) = cos(hist%lon(i,j)) + sinlat(i,j) = sin(hist%lat(i,j)) + coslat(i,j) = cos(hist%lat(i,j)) + enddo + enddo + !$omp parallel do default(shared) private(i,j,k,nv,i1,j1) + do k= 1, hist%levo + nv = hist%nstt_vctbl(idx)+k-1 + do j= hist%jsco,hist%jeco + j1 = j-hist%jsco+1 + do i= hist%isco,hist%ieco + i1 = i-hist%isco+1 + hist%buffer_phys_windvect(1,i,j,nv) = hist%uwork3d(i,j,k)*coslon(i,j) & + - work(i1,j1,k)*sinlat(i,j)*sinlon(i,j) + hist%buffer_phys_windvect(2,i,j,nv) = hist%uwork3d(i,j,k)*sinlon(i,j) & + + work(i1,j1,k)*sinlat(i,j)*coslon(i,j) + hist%buffer_phys_windvect(3,i,j,nv) = work(i1,j1,k)*coslat(i,j) + enddo + enddo + enddo + deallocate (sinlon, coslon, sinlat, coslat) + endif + hist%uwork3d = zero + hist%uwindname = '' + hist%uwork_set = .false. + endif + + endif + else + used = send_data(id, work, Time) + endif + endif + ! + end subroutine history_type_store_data3D + +#ifdef use_WRTCOMP + !>@brief Sets up the ESMF bundle to use for quilt diagnostic output + !> \section history_type%bundle_setup procedure + !! This part of the write component (quilt) sets up the ESMF bundles + !! to use for writing diagnostic output. It is only defined when the + !! write component is enabled at compile time. + + subroutine history_type_bundle_setup(hist, Diag, axes, phys_bundle, fcst_grid, quilting, nbdlphys, rc) + ! set esmf bundle for phys output fields + use esmf + use diag_data_mod, ONLY: diag_atttype + ! + implicit none + ! + class(history_type) :: hist + type(GFS_externaldiag_type),intent(in) :: Diag(:) + integer, intent(in) :: axes(:) + type(ESMF_FieldBundle),intent(inout) :: phys_bundle(:) + type(ESMF_Grid),intent(inout) :: fcst_grid + logical,intent(in) :: quilting + integer, intent(in) :: nbdlphys + integer,intent(out) :: rc + + ! + !*** local variables + integer i, idx, ibdl + integer id, axis_length, direction, edges + integer num_attributes + character(255) :: units, long_name, cart_name, axis_direct, edgesS + character(128) :: output_name, physbdl_name, outputfile1 + logical :: lput2physbdl, loutputfile, l2dvector + type(domain1d) :: Domain + type(domainUG) :: DomainU + real,dimension(:),allocatable :: axis_data + character(128),dimension(:), allocatable :: bdl_intplmethod, outputfile + type(diag_atttype),dimension(:),allocatable :: attributes + ! + logical isPresent + integer udimCount + character(80),dimension(:),allocatable :: udimList + character(20),dimension(:), allocatable :: axis_name_vert + ! + !------------------------------------------------------------ + !--- use wrte grid component for output + hist%use_wrtgridcomp_output = quilting + ! if(mpp_pe()==mpp_root_pe())print *,'in fv_phys bundle,use_wrtgridcomp_output=',hist%use_wrtgridcomp_output, & + ! print *,'in fv_phys bundle,use_wrtgridcomp_output=',hist%use_wrtgridcomp_output, & + ! 'hist%isco=',hist%isco,hist%ieco,'hist%jsco=',hist%jsco,hist%jeco,'hist%tot_diag_idx=',hist%tot_diag_idx + ! + !------------------------------------------------------------ + !*** add attributes to the bundle such as subdomain limtis, + !*** axes, output time, etc + !------------------------------------------------------------ + ! + allocate(bdl_intplmethod(nbdlphys), outputfile(nbdlphys)) + if(mpp_pe()==mpp_root_pe()) print *,'in fv_phys bundle,nbdl=',nbdlphys + do ibdl = 1, nbdlphys + loutputfile = .false. + call ESMF_FieldBundleGet(phys_bundle(ibdl), name=physbdl_name,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + idx = index(physbdl_name,'_bilinear') + if(idx > 0) then + outputfile(ibdl) = physbdl_name(1:idx-1) + bdl_intplmethod(ibdl) = 'bilinear' + loutputfile = .true. + endif + idx = index(physbdl_name,'_nearest_stod') + if(idx > 0) then + outputfile(ibdl) = physbdl_name(1:idx-1) + bdl_intplmethod(ibdl) = 'nearest_stod' + loutputfile = .true. + endif + if( .not. loutputfile) then + outputfile(ibdl) = 'phy' + bdl_intplmethod(ibdl) = 'nearest_stod' + endif + ! print *,'in fv_phys bundle,i=',ibdl,'outputfile=',trim(outputfile(ibdl)), & + ! 'bdl_intplmethod=',trim(bdl_intplmethod(ibdl)) + + call ESMF_AttributeAdd(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & + attrList=(/"fhzero ", "ncld ", "nsoil ",& + "imp_physics", "dtp ", "landsfcmdl "/), rc=rc) + + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & + name="fhzero", value=hist%fhzero, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & + name="ncld", value=hist%ncld, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & + name="nsoil", value=hist%nsoil, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & + name="imp_physics", value=hist%imp_physics, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & + name="dtp", value=hist%dtp, rc=rc) + ! print *,'in fcst gfdl diag, hist%dtp=',hist%dtp,' ibdl=',ibdl + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(phys_bundle(ibdl), convention="NetCDF", purpose="FV3", & + name="landsfcmdl", value=hist%landsfcmdl, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + !end ibdl + enddo + ! + !*** get axis names + allocate(hist%axis_name(hist%num_axes_phys)) + do id = 1,hist%num_axes_phys + call get_diag_axis_name( axes(id), hist%axis_name(id)) + enddo + isPresent = .false. + if( hist%num_axes_phys>2 ) then + allocate(axis_name_vert(hist%num_axes_phys-2)) + do id=3,hist%num_axes_phys + axis_name_vert(id-2) = hist%axis_name(id) + enddo + ! + call ESMF_AttributeGet(fcst_grid, convention="NetCDF", purpose="FV3", & + name="vertical_dim_labels", isPresent=isPresent, & + itemCount=udimCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (isPresent .and. (udimCount>hist%num_axes_phys-2) ) then + allocate(udimList(udimCount)) + call ESMF_AttributeGet(fcst_grid, convention="NetCDF", purpose="FV3", & + name="vertical_dim_labels", valueList=udimList, rc=rc) + ! if(mpp_pe()==mpp_root_pe()) print *,'in fv3atmio, vertical + ! list=',udimList(1:udimCount),'rc=',rc + + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + else + + if(mpp_pe()==mpp_root_pe()) print *,'in fv_dyn bundle,axis_name_vert=',axis_name_vert + call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & + attrList=(/"vertical_dim_labels"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & + name="vertical_dim_labels", valueList=axis_name_vert, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + deallocate(axis_name_vert) + endif + + !*** add attributes + if(associated(hist%all_axes)) then + deallocate(hist%all_axes) + nullify(hist%all_axes) + endif + allocate(hist%all_axes(hist%num_axes_phys)) + hist%all_axes(1:hist%num_axes_phys) = axes(1:hist%num_axes_phys) + if (.not. isPresent .or. (udimCount2 ) then + ! if(mpp_pe()==mpp_root_pe()) print *,' in dyn add grid, axis_name=', & + ! trim(hist%axis_name(id)),'axis_data=',axis_data + if(trim(edgesS)/='') then + call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & + attrList=(/trim(hist%axis_name(id)),trim(hist%axis_name(id))//":long_name", & + trim(hist%axis_name(id))//":units", trim(hist%axis_name(id))//":cartesian_axis", & + trim(hist%axis_name(id))//":positive", trim(hist%axis_name(id))//":edges"/), rc=rc) + else + call ESMF_AttributeAdd(fcst_grid, convention="NetCDF", purpose="FV3", & + attrList=(/trim(hist%axis_name(id)),trim(hist%axis_name(id))//":long_name", & + trim(hist%axis_name(id))//":units", trim(hist%axis_name(id))//":cartesian_axis", & + trim(hist%axis_name(id))//":positive"/), rc=rc) + endif + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & + name=trim(hist%axis_name(id)), valueList=axis_data, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & + name=trim(hist%axis_name(id))//":long_name", value=trim(long_name), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & + name=trim(hist%axis_name(id))//":units", value=trim(units), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & + name=trim(hist%axis_name(id))//":cartesian_axis", value=trim(cart_name), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if(direction > 0) then + axis_direct = "up" + else + axis_direct = "down" + endif + call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & + name=trim(hist%axis_name(id))//":positive", value=trim(axis_direct), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if(trim(edgesS)/='') then + call ESMF_AttributeSet(fcst_grid, convention="NetCDF", purpose="FV3", & + name=trim(hist%axis_name(id))//":edges", value=trim(edgesS), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + endif + ! + deallocate(axis_data) + enddo + endif + ! print *,'in setup fieldbundle_phys, hist%num_axes_phys=',hist%num_axes_phys,'hist%tot_diag_idx=',hist%tot_diag_idx, & + ! 'nbdlphys=',nbdlphys + ! + !----------------------------------------------------------------------------------------- + !*** add esmf fields + ! + do idx= 1,hist%tot_diag_idx + + lput2physbdl = .false. + do ibdl = 1, nbdlphys + + if( index(trim(Diag(idx)%intpl_method),trim(bdl_intplmethod(ibdl))) > 0) then + lput2physbdl = .true. + if( Diag(idx)%id > 0 ) then + call hist%find_output_name(trim(Diag(idx)%mod_name),trim(Diag(idx)%name),output_name) + + !add origin field + call hist%add_field_to_phybundle(trim(output_name),trim(Diag(idx)%desc),trim(Diag(idx)%unit), "time: point", & + axes(1:Diag(idx)%axes), fcst_grid, hist%nstt(idx), phys_bundle(ibdl), outputfile(ibdl), & + bdl_intplmethod(ibdl), rcd=rc) + ! if( mpp_pe() == mpp_root_pe()) print *,'phys, add field,',trim(Diag(idx)%name),'idx=',idx,'ibdl=',ibdl + ! + if( index(trim(Diag(idx)%intpl_method), "vector") > 0) then + l2dvector = .true. + if (hist%nstt_vctbl(idx) > 0) then + output_name = 'wind'//trim(output_name)//'vector' + outputfile1 = 'none' + call hist%add_field_to_phybundle(trim(output_name),trim(Diag(idx)%desc),trim(Diag(idx)%unit), "time: point", & + axes(1:Diag(idx)%axes), fcst_grid, hist%nstt_vctbl(idx),phys_bundle(ibdl), outputfile1, & + bdl_intplmethod(ibdl),l2dvector=l2dvector, rcd=rc) + ! if( mpp_pe() == mpp_root_pe()) print *,'in phys, add vector field,',trim(Diag(idx)%name),' idx=',idx,' ibdl=',ibdl + endif + endif + + endif + endif + enddo + if( .not. lput2physbdl ) then + if( mpp_pe() == mpp_root_pe()) print *,'WARNING: not matching interpolation method, field ',trim(Diag(idx)%name), & + ' is not added to phys bundle ' + endif + + enddo + deallocate(hist%axis_name) + deallocate(hist%all_axes) + nullify(hist%axis_name) + nullify(hist%all_axes) + + end subroutine history_type_bundle_setup + + !>@brief Adds one field to an ESMF field bundle for later output. Internal subroutine; do not call this directly. + !> \section history_type%add_field_to_phybundle procedure + !! This is part of the internal implementation of history_type_bundle_setup (history_type%bundle_setup). + !! It sets attributes for and logs information about a single ESMF field. Do not call this subroutine directly. + !! Call fv_phys_bundle_setup instead. + subroutine history_type_add_field_to_phybundle(hist,var_name,long_name,units,cell_methods, axes,phys_grid, & + kstt,phys_bundle,output_file,intpl_method,range,l2dvector,rcd) + ! + use esmf + ! + implicit none + class(history_type) :: hist + character(*), intent(in) :: var_name, long_name, units, cell_methods + character(*), intent(in) :: output_file, intpl_method + integer, intent(in) :: axes(:) + type(esmf_grid), intent(in) :: phys_grid + integer, intent(in) :: kstt + type(esmf_fieldbundle),intent(inout) :: phys_bundle + real, intent(in), optional :: range(2) + logical, intent(in), optional :: l2dvector + integer, intent(out), optional :: rcd + ! + !*** local variable + type(ESMF_Field) :: field + type(ESMF_DataCopy_Flag) :: copyflag=ESMF_DATACOPY_REFERENCE + integer rc, i, j, idx + real(4),dimension(:,:),pointer :: temp_r2d + real(4),dimension(:,:,:),pointer :: temp_r3d + logical :: l2dvector_local + ! + ! fix for non-standard compilers (e.g. PGI) + l2dvector_local = .false. + if (present(l2dvector)) then + if (l2dvector) then + l2dvector_local = .true. + end if + end if + ! + !*** create esmf field + if (l2dvector_local .and. size(axes)==2) then + temp_r3d => hist%buffer_phys_windvect(1:3,hist%isco:hist%ieco,hist%jsco:hist%jeco,kstt) + ! if( mpp_root_pe() == 0) print *,'phys, create wind vector esmf field' + call ESMF_LogWrite('bf create winde vector esmf field '//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + !datacopyflag=ESMF_DATACOPY_VALUE, & + field = ESMF_FieldCreate(phys_grid, temp_r3d, datacopyflag=ESMF_DATACOPY_REFERENCE, & + gridToFieldMap=(/2,3/), ungriddedLBound=(/1/), ungriddedUBound=(/3/), & + name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) + + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite('af winde vector esmf field create '//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) + + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"output_file"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name='output_file',value=trim(output_file),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_LogWrite('before winde vector esmf field add output_file', ESMF_LOGMSG_INFO, rc=rc) + + ! if( mpp_root_pe() == 0)print *,'phys, aftercreate wind vector esmf field' + call ESMF_FieldBundleAdd(phys_bundle,(/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + if( present(rcd)) rcd=rc + call ESMF_LogWrite('aft winde vector esmf field add to fieldbundle'//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) + return + else if( trim(intpl_method) == 'nearest_stod' ) then + if(size(axes) == 2) then + temp_r2d => hist%buffer_phys_nb(hist%isco:hist%ieco,hist%jsco:hist%jeco,kstt) + field = ESMF_FieldCreate(phys_grid, temp_r2d, datacopyflag=copyflag, & + name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + else if(size(axes) == 3) then + temp_r3d => hist%buffer_phys_nb(hist%isco:hist%ieco,hist%jsco:hist%jeco,kstt:kstt+hist%levo-1) + field = ESMF_FieldCreate(phys_grid, temp_r3d, datacopyflag=copyflag, & + name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + if( mpp_pe() == mpp_root_pe()) print *,'add 3D field to after nearest_stod, fld=', trim(var_name) + endif + else if( trim(intpl_method) == 'bilinear' ) then + if(size(axes) == 2) then + temp_r2d => hist%buffer_phys_bl(hist%isco:hist%ieco,hist%jsco:hist%jeco,kstt) + field = ESMF_FieldCreate(phys_grid, temp_r2d, datacopyflag=copyflag, & + name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + else if(size(axes) == 3) then + temp_r3d => hist%buffer_phys_bl(hist%isco:hist%ieco,hist%jsco:hist%jeco,kstt:kstt+hist%levo-1) + field = ESMF_FieldCreate(phys_grid, temp_r3d, datacopyflag=copyflag, & + name=var_name, indexFlag=ESMF_INDEX_DELOCAL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + if( mpp_pe() == mpp_root_pe()) print *,'add field to after bilinear, fld=', trim(var_name) + endif + endif + ! + !*** add field attributes + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"long_name"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name='long_name',value=trim(long_name),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"units"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name='units',value=trim(units),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"missing_value"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name='missing_value',value=real(missing_value,kind=4),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"_FillValue"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name='_FillValue',value=real(missing_value,kind=4),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"cell_methods"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name='cell_methods',value=trim(cell_methods),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + ! + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"output_file"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name='output_file',value=trim(output_file),rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + ! + !*** add vertical coord attribute: + if( size(axes) > 2) then + do i=3,size(axes) + idx=0 + do j=1,size(hist%all_axes) + if (axes(i)==hist%all_axes(j)) then + idx=j + exit + endif + enddo + if (idx>0) then + call ESMF_AttributeAdd(field, convention="NetCDF", purpose="FV3", & + attrList=(/"ESMF:ungridded_dim_labels"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(field, convention="NetCDF", purpose="FV3", & + name="ESMF:ungridded_dim_labels", valueList=(/trim(hist%axis_name(idx))/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + enddo + endif + + !*** add field into bundle + call ESMF_FieldBundleAdd(phys_bundle,(/field/), rc=rc) + if( present(rcd)) rcd=rc + ! + call ESMF_LogWrite('phys field add to fieldbundle '//trim(var_name), ESMF_LOGMSG_INFO, rc=rc) + + end subroutine history_type_add_field_to_phybundle + + !>@brief Private subroutine to search a field list for a specific name. + !> \section history_type%find_output_name procedure + !! Searches the GFS_Diagnostic-generated field list for a + !! specific name and retrieves the name that should be used for + !! outputting the variable. This is part of the internal + !! implementation of history_type_bundle_setup + !! (history_type%bundle_setup) and should not be called + !! directly. Call fv_phys_bundle_setup instead. + subroutine history_type_find_output_name(hist,module_name,field_name,output_name) + implicit none + class(history_type) :: hist + character(*), intent(in) :: module_name + character(*), intent(in) :: field_name + character(*), intent(out) :: output_name + ! + integer i,in_num + integer tile_count + ! + tile_count = 1 + in_num = find_input_field(module_name, field_name, tile_count) + ! + output_name = '' + do i=1, max_output_fields + if(output_fields(i)%input_field == in_num) then + output_name = output_fields(i)%output_name + exit + endif + enddo + if(output_name == '') then +19 format("Error: can't find output name for model field ",'"',A,'"') + print 19,trim(field_name) + endif + + end subroutine history_type_find_output_name +#endif + !------------------------------------------------------------------------- + +end module fv3atm_history_io_mod +!> @} diff --git a/io/fv3atm_oro_io.F90 b/io/fv3atm_oro_io.F90 new file mode 100644 index 000000000..493cfd4c4 --- /dev/null +++ b/io/fv3atm_oro_io.F90 @@ -0,0 +1,333 @@ +!> \file fv3atm_oro_io.F90 +!! This file defines routines to read orography files for the fv3atm. +module fv3atm_oro_io + + use block_control_mod, only: block_control_type + use fms2_io_mod, only: FmsNetcdfDomainFile_t, & + register_axis, register_restart_field + use fv3atm_common_io, only: get_nx_ny_from_atm + use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys + + implicit none + private + + public :: Oro_io_data_type, Oro_io_register, Oro_io_copy, Oro_io_final + public :: Oro_scale_io_data_type, Oro_scale_io_register, Oro_scale_io_copy, Oro_scale_io_final + + !>\defgroup fv3atm_oro_io FV3ATM Orography I/O Module + !> @{ + !>@ Storage of working arrays for reading orography data. + type Oro_io_data_type + character(len=32), pointer, private, dimension(:) :: name2 => null() + real(kind=kind_phys), pointer, private, dimension(:,:,:) :: var2 => null() + real(kind=kind_phys), pointer, private, dimension(:,:,:) :: var3v => null() + real(kind=kind_phys), pointer, private, dimension(:,:,:) :: var3s => null() + contains + procedure, public :: register => Oro_io_register + procedure, public :: copy => Oro_io_copy + final :: Oro_io_final + end type Oro_io_data_type + + !>@ Storage of working arrays for reading large-scale and small-scale orography data for gravity wave drag schemes. + type Oro_scale_io_data_type + character(len=32), pointer, private, dimension(:) :: name => null() + real(kind=kind_phys), pointer, private, dimension(:,:,:) :: var => null() + contains + procedure, public :: register => Oro_scale_io_register + procedure, public :: copy => Oro_scale_io_copy + final :: Oro_scale_io_final + end type Oro_scale_io_data_type + + !>@ Number of two-dimensional orography fields (excluding large- and small-scale) + integer, parameter :: nvar_oro_2d = 19 + + !>@ Number of large-scale and small-scale orography fields + integer, parameter :: nvar_oro_scale = 10 + +contains + + !>@brief Registers axes and fields for non-quilt restart reading of non-scaled orography variables. + !> \section oro_io_data_type%register procedure + !! Calls FMS restart register functions for axes and + !! variables in the non-scaled orography data. The scaled data is + !! handled by another function. This includes both 2D and 3D fields. + subroutine Oro_io_register(oro, Model, Oro_restart, Atm_block) + implicit none + class(Oro_io_data_type) :: oro + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Oro_restart + type(block_control_type), intent(in) :: Atm_block + + real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() + real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_fr => NULL() + integer :: nx, ny + + integer :: nvar_vegfr, nvar_soilfr, n, num + + call get_nx_ny_from_atm(Atm_block, nx, ny) + + ! This #define reduces code length by a lot +#define WARN_DISASSOCIATE(name) \ + if(associated(name)) then ; \ + write(0,*) 'Internal error. Called oro%register twice. Will try to keep going anyway.' ; \ + deallocate(name); \ + nullify(name) ; \ + endif + + WARN_DISASSOCIATE(oro%name2) + WARN_DISASSOCIATE(oro%var2) + WARN_DISASSOCIATE(oro%var3v) + WARN_DISASSOCIATE(oro%var3s) +#undef WARN_DISASSOCIATE + + nvar_vegfr = Model%nvegcat + nvar_soilfr = Model%nsoilcat + + allocate(oro%name2(nvar_oro_2d)) + allocate(oro%var2(nx,ny,nvar_oro_2d)) + + allocate(oro%var3v(nx,ny,nvar_vegfr)) + allocate(oro%var3s(nx,ny,nvar_soilfr)) + + oro%var2 = -9999._kind_phys + + num = 1 ; oro%name2(num) = 'stddev' ! hprime(ix,1) + num = num + 1 ; oro%name2(num) = 'convexity' ! hprime(ix,2) + num = num + 1 ; oro%name2(num) = 'oa1' ! hprime(ix,3) + num = num + 1 ; oro%name2(num) = 'oa2' ! hprime(ix,4) + num = num + 1 ; oro%name2(num) = 'oa3' ! hprime(ix,5) + num = num + 1 ; oro%name2(num) = 'oa4' ! hprime(ix,6) + num = num + 1 ; oro%name2(num) = 'ol1' ! hprime(ix,7) + num = num + 1 ; oro%name2(num) = 'ol2' ! hprime(ix,8) + num = num + 1 ; oro%name2(num) = 'ol3' ! hprime(ix,9) + num = num + 1 ; oro%name2(num) = 'ol4' ! hprime(ix,10) + num = num + 1 ; oro%name2(num) = 'theta' ! hprime(ix,11) + num = num + 1 ; oro%name2(num) = 'gamma' ! hprime(ix,12) + num = num + 1 ; oro%name2(num) = 'sigma' ! hprime(ix,13) + num = num + 1 ; oro%name2(num) = 'elvmax' ! hprime(ix,14) + num = num + 1 ; oro%name2(num) = 'orog_filt' ! oro + num = num + 1 ; oro%name2(num) = 'orog_raw' ! oro_uf + num = num + 1 ; oro%name2(num) = 'land_frac' ! land fraction [0:1] + !--- variables below here are optional + num = num + 1 ; oro%name2(num) = 'lake_frac' ! lake fraction [0:1] + num = num + 1 ; oro%name2(num) = '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 n = 1,num + var2_p => oro%var2(:,:,n) + if (trim(oro%name2(n)) == 'lake_frac' .or. trim(oro%name2(n)) == 'lake_depth' ) then + call register_restart_field(Oro_restart, oro%name2(n), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + else + call register_restart_field(Oro_restart, oro%name2(n), var2_p, dimensions=(/'lat','lon'/)) + endif + enddo + + !--- register 3D vegetation and soil fractions + var3_fr => oro%var3v(:,:,:) + call register_restart_field(Oro_restart, 'vegetation_type_pct', var3_fr, dimensions=(/'num_veg_cat','lat ','lon '/) , is_optional=.true.) + var3_fr => oro%var3s(:,:,:) + call register_restart_field(Oro_restart, 'soil_type_pct', var3_fr, dimensions=(/'num_soil_cat','lat ','lon '/) , is_optional=.true.) + + end subroutine Oro_io_register + + !>@brief Copies orography data from temporary arrays back to Sfcprop grid arrays. + !> \section oro_io_data_type%copy procedure + !! After reading the restart, data is on temporary arrays with x-y data storage. + !! This subroutine copies the x-y fields to Sfcprop's blocked grid storage arrays. + subroutine Oro_io_copy(oro, Model, Sfcprop, Atm_block) + implicit none + class(Oro_io_data_type) :: oro + type(GFS_control_type), intent(in) :: Model + type(GFS_sfcprop_type) :: Sfcprop(:) + type(FmsNetcdfDomainFile_t) :: Oro_restart + type(block_control_type), intent(in) :: Atm_block + + integer :: i,j,nb,ix,num + + !$omp parallel do default(shared) private(i, j, nb, ix, num) + do nb = 1, Atm_block%nblks + !--- 2D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + !--- stddev + ! Sfcprop(nb)%hprim(ix) = oro%var2(i,j,1) + !--- hprime(1:14) + num = 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%hprime(ix,num) = oro%var2(i,j,num) + !--- oro + num = num + 1 ; Sfcprop(nb)%oro(ix) = oro%var2(i,j,num) + num = num + 1 ; Sfcprop(nb)%oro_uf(ix) = oro%var2(i,j,num) + + Sfcprop(nb)%landfrac(ix) = -9999.0 + Sfcprop(nb)%lakefrac(ix) = -9999.0 + + num = num + 1 ; Sfcprop(nb)%landfrac(ix) = oro%var2(i,j,num) !land frac [0:1] + if (Model%lkm > 0 ) then + if(oro%var2(i,j,num+1)>Model%lakefrac_threshold .and. & + oro%var2(i,j,num+2)>Model%lakedepth_threshold) then + Sfcprop(nb)%lakefrac(ix) = oro%var2(i,j,num+1) !lake frac [0:1] + Sfcprop(nb)%lakedepth(ix) = oro%var2(i,j,num+2) !lake depth [m] !YWu + else + Sfcprop(nb)%lakefrac(ix) = 0 + Sfcprop(nb)%lakedepth(ix) = -9999 + endif + else + Sfcprop(nb)%lakefrac(ix) = oro%var2(i,j,num+1) !lake frac [0:1] + Sfcprop(nb)%lakedepth(ix) = oro%var2(i,j,num+2) !lake depth [m] !YWu + endif + num = num + 2 ! To account for lakefrac and lakedepth + + Sfcprop(nb)%vegtype_frac(ix,:) = -9999.0 + Sfcprop(nb)%soiltype_frac(ix,:) = -9999.0 + + Sfcprop(nb)%vegtype_frac(ix,:) = oro%var3v(i,j,:) ! vegetation type fractions, [0:1] + Sfcprop(nb)%soiltype_frac(ix,:) = oro%var3s(i,j,:) ! soil type fractions, [0:1] + + enddo + enddo + + !--- deallocate containers and free restart container + deallocate(oro%name2) + deallocate(oro%var2) + deallocate(oro%var3v) + deallocate(oro%var3s) + + nullify(oro%name2) + nullify(oro%var2) + nullify(oro%var3v) + nullify(oro%var3s) + + end subroutine Oro_io_copy + + !>@brief Destructor for Oro_io_data_type + subroutine Oro_io_final(oro) + implicit none + type(Oro_io_data_type) :: oro + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(oro%var)) then ; \ + deallocate(oro%var) ; \ + nullify(oro%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(name2) + IF_ASSOC_DEALLOC_NULL(var2) + IF_ASSOC_DEALLOC_NULL(var3s) + IF_ASSOC_DEALLOC_NULL(var3v) + +#undef IF_ASSOC_DEALLOC_NULL + end subroutine Oro_io_final + + !>@brief Registers axes and fields for non-quilt restart reading of scaled orography variables. + !> \section Calls FMS restart register functions for axes and + !! variables in the large-scale or small-scale orography data. The + !! scaled data is handled by another function. Each scale needs its + !! own instance of oro_scale_io_data_type. + subroutine Oro_scale_io_register(oro_scale, Model, Oro_scale_restart, Atm_block) + implicit none + class(Oro_scale_io_data_type) :: oro_scale + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Oro_scale_restart + type(block_control_type), intent(in) :: Atm_block + + real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() + integer :: num, nx, ny + +#define WARN_DISASSOCIATE(name) \ + if(associated(name)) then ; \ + write(0,*) 'Internal error. Called oro_scale%register twice. Will try to keep going anyway.' ; \ + deallocate(name); \ + nullify(name) ; \ + endif + + WARN_DISASSOCIATE(oro_scale%name) + WARN_DISASSOCIATE(oro_scale%var) +#undef WARN_DISASSOCIATE + + call get_nx_ny_from_atm(Atm_block, nx, ny) + + !--- allocate the various containers needed for orography data + allocate(oro_scale%name(nvar_oro_scale)) + allocate(oro_scale%var(nx,ny,nvar_oro_scale)) + + oro_scale%name(1) = 'stddev' + oro_scale%name(2) = 'convexity' + oro_scale%name(3) = 'oa1' + oro_scale%name(4) = 'oa2' + oro_scale%name(5) = 'oa3' + oro_scale%name(6) = 'oa4' + oro_scale%name(7) = 'ol1' + oro_scale%name(8) = 'ol2' + oro_scale%name(9) = 'ol3' + oro_scale%name(10) = 'ol4' + + call register_axis(Oro_scale_restart, "lon", 'X') + call register_axis(Oro_scale_restart, "lat", 'Y') + + do num = 1,nvar_oro_scale + var2_p => oro_scale%var(:,:,num) + call register_restart_field(Oro_scale_restart, oro_scale%name(num), var2_p, dimensions=(/'lon','lat'/)) + enddo + end subroutine Oro_scale_io_register + + !>@brief Copies scaled orography data from temporary arrays back to Sfcprop grid arrays. + !> \section Oro_scale_io_data_type%copy procedure + !! After reading the restart, data is on temporary arrays with x-y data storage. + !! This subroutine copies the x-y fields to Sfcprop's blocked grid storage arrays. + subroutine Oro_scale_io_copy(oro_scale, Sfcprop, Atm_block, first_index) + implicit none + class(Oro_scale_io_data_type) :: oro_scale + type(GFS_sfcprop_type) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + integer, intent(in) :: first_index + + integer :: i,j,nb,ix,num,v + + !$OMP PARALLEL DO PRIVATE(nb,ix,i,j,v) + do nb = 1, Atm_block%nblks + !--- 2D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + do v=1,nvar_oro_scale + Sfcprop(nb)%hprime(ix,first_index-1+v) = oro_scale%var(i,j,v) + enddo + enddo + enddo + end subroutine Oro_scale_io_copy + + !>@brief Oro_scale_io_data_type destructor + subroutine Oro_scale_io_final(oro_scale) + implicit none + type(Oro_scale_io_data_type) :: oro_scale + +#define IF_ASSOC_DEALLOC_NULL(vvarr) \ + if(associated(oro_scale%vvarr)) then ; \ + deallocate(oro_scale%vvarr) ; \ + nullify(oro_scale%vvarr) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(name) + IF_ASSOC_DEALLOC_NULL(var) + +#undef IF_ASSOC_DEALLOC_NULL + end subroutine Oro_scale_io_final +end module fv3atm_oro_io +!> @} diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 new file mode 100644 index 000000000..d5cfb9734 --- /dev/null +++ b/io/fv3atm_restart_io.F90 @@ -0,0 +1,1282 @@ +!> \file fv3atm_restart_io.F90 +!! This file contains the restart reading and writing code, for quilt and non-quilt +!! of the Sfcprop and physics data. + +module fv3atm_restart_io_mod + + use block_control_mod, only: block_control_type + use mpp_mod, only: mpp_error, mpp_chksum, NOTE, FATAL + use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys, GFS_data_type + use GFS_restart, only: GFS_restart_type + 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 + use mpp_domains_mod, only: domain2d + use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & + create_3d_field_and_add_to_bundle, copy_from_gfs_data + use fv3atm_sfc_io + use fv3atm_rrfs_sd_io + use fv3atm_clm_lake_io + use fv3atm_oro_io + + implicit none + private + + public fv3atm_checksum + public fv3atm_restart_read + public fv3atm_restart_write + public fv3atm_restart_register + public fv_phy_restart_output + public fv_phy_restart_bundle_setup + public fv_sfc_restart_output + public fv_sfc_restart_bundle_setup + + !>\defgroup fv3atm_restart_io_mod module + !> @{ + + !>@Internal storage for reading and writing physics restart files. + type phy_data_type + real(kind=kind_phys), pointer, dimension(:,:,:) :: var2 => null() + real(kind=kind_phys), pointer, dimension(:,:,:,:) :: var3 => null() + character(len=32),dimension(:),pointer :: var2_names => null() + character(len=32),dimension(:),pointer :: var3_names => null() + integer :: nvar2d = 0, nvar3d = 0, npz = 0 + contains + procedure :: alloc => phy_data_alloc + procedure :: transfer_data => phy_data_transfer_data + final phy_data_final + end type phy_data_type + + !--- GFDL filenames + + !>@ Filename template for orography data. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_oro = 'oro_data.nc' + + !>@ Filename template for gravity wave drag large-scale orography data. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_oro_ls = 'oro_data_ls.nc' + + !>@ Filename template for gravity wave drag small-scale orography data. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_oro_ss = 'oro_data_ss.nc' + + !>@ Filename template for surface data that doesn't fall under other categories. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_srf = 'sfc_data.nc' + + !>@ Filename template for physics diagnostic data. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_phy = 'phy_data.nc' + + !>@ Filename template for monthly dust data for RRFS_SD. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_dust12m= 'dust12m_data.nc' + + !>@ Filename template for RRFS-SD emissions data. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_emi = 'emi_data.nc' + + !>@ Filename template for RRFS-SD smoke data. FMS may add grid and tile information to the name + character(len=32), parameter :: fn_rrfssd = 'SMOKE_RRFS_data.nc' + + real(kind_phys), parameter:: zero = 0.0, one = 1.0 + + !>@ Instance of phy_data_type for quilt output of physics diagnostic data + type(phy_data_type) :: phy_quilt + + !>@ Instance of clm_lake_data_type for quilt output of CLM Lake model restart data + type(clm_lake_data_type) :: clm_lake_quilt + + !>@ Instance of Sfc_io_data_type for quilt output of surface restart data + type(Sfc_io_data_type) :: sfc_quilt + + !>@ Instance of rrfs_sd_state_type for quilt output of RRFS-SD scheme restart data + type(rrfs_sd_state_type) :: rrfs_sd_quilt + +contains + + !>@brief Reads physics and surface fields. + !> \section fv3atm_restart_read subroutine + !! Calls sfc_prop_restart_read and phys_restart_read to read all surface and physics restart files. + subroutine fv3atm_restart_read (GFS_Data, GFS_Restart, Atm_block, Model, fv_domain, warm_start, ignore_rst_cksum) + implicit none + type(GFS_data_type), intent(inout) :: GFS_Data(:) + type(GFS_restart_type), intent(inout) :: GFS_Restart + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(inout) :: Model + type(domain2d), intent(in) :: fv_domain + logical, intent(in) :: warm_start + logical, intent(in) :: ignore_rst_cksum + + !--- read in surface data from chgres + call sfc_prop_restart_read (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, warm_start, ignore_rst_cksum) + + !--- read in physics restart data + call phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain, ignore_rst_cksum) + + end subroutine fv3atm_restart_read + + !>@brief Writes surface and physics restart fields without using the write component (quilt). + !> \section fv3atm_restart_write subroutine + !! Calls sfc_prop_restart_write and phys_restart_write to write + !! surface and physics restart fields. This pauses the model to + !! write; it does not use the write component (quilt). + subroutine fv3atm_restart_write (GFS_Data, GFS_Restart, Atm_block, Model, fv_domain, timestamp) + implicit none + type(GFS_data_type), intent(inout) :: GFS_Data(:) + type(GFS_restart_type), intent(inout) :: GFS_Restart + type(block_control_type), intent(in) :: Atm_block + 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 + 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) + + end subroutine fv3atm_restart_write + + !---------------- + ! fv3atm_checksum + !---------------- + subroutine fv3atm_checksum (Model, GFS_Data, Atm_block) + implicit none + !--- interface variables + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: GFS_Data(:) + type (block_control_type), intent(in) :: Atm_block + !--- local variables + integer :: outunit, i, ix, nb, isc, iec, jsc, jec, lev, ntr, k + integer :: nsfcprop2d, nt + real(kind=kind_phys), allocatable :: temp2d(:,:,:) + real(kind=kind_phys), allocatable :: temp3d(:,:,:,:) + real(kind=kind_phys), allocatable :: temp3dlevsp1(:,:,:,:) + integer, allocatable :: ii1(:), jj1(:) + character(len=32) :: name + + isc = Model%isc + iec = Model%isc+Model%nx-1 + jsc = Model%jsc + jec = Model%jsc+Model%ny-1 + lev = Model%levs + + ntr = size(GFS_Data(1)%Statein%qgrs,3) + + nsfcprop2d = 93 + if (Model%lsm == Model%lsm_noahmp) then + nsfcprop2d = nsfcprop2d + 49 + if (Model%use_cice_alb) then + nsfcprop2d = nsfcprop2d + 4 + endif + elseif (Model%lsm == Model%lsm_ruc) then + nsfcprop2d = nsfcprop2d + 4 + 12 + if (Model%rdlai) then + nsfcprop2d = nsfcprop2d + 1 + endif + else + if (Model%use_cice_alb) then + nsfcprop2d = nsfcprop2d + 4 + endif + endif + + if (Model%nstf_name(1) > 0) then + nsfcprop2d = nsfcprop2d + 16 + endif + + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + nsfcprop2d = nsfcprop2d + 10 + endif + + allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot2d+Model%nctp)) + allocate (temp3d(isc:iec,jsc:jec,1:lev,14+Model%ntot3d+2*ntr)) + allocate (temp3dlevsp1(isc:iec,jsc:jec,1:lev+1,3)) + + temp2d = zero + temp3d = zero + temp3dlevsp1 = zero + + !$omp parallel do default(shared) private(i, k, nb, ix, nt, ii1, jj1) + block_loop: do nb = 1, Atm_block%nblks + allocate(ii1(Atm_block%blksz(nb))) + allocate(jj1(Atm_block%blksz(nb))) + ii1=Atm_block%index(nb)%ii - isc + 1 + jj1=Atm_block%index(nb)%jj - jsc + 1 + + ! Copy into temp2d + nt=0 + + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Statein%pgr) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%slmsk) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsfc) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tisfc) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zorl) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%fice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%hprime(:,1)) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sncovr) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snoalb) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alvsf) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alnsf) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alvwf) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alnwf) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%facsf) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%facwf) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%slope) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%shdmin) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%shdmax) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tg3) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%vfrac) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%vtype) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stype) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%uustar) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%oro) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%oro_uf) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%hice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%weasd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%canopy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%ffmm) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%ffhh) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%f10m) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tprcp) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%srflag) + lsm_choice: if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%slc) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smc) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stc) + elseif (Model%lsm == Model%lsm_ruc) then + do k=1,3 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sh2o(:,k)) + enddo + ! Combine levels 4 to lsoil_lsm (9 for RUC) into one + nt=nt+1 + do ix=1,Atm_block%blksz(nb) + temp2d(ii1(ix),jj1(ix),nt) = sum(GFS_Data(nb)%Sfcprop%sh2o(ix,4:Model%lsoil_lsm)) + enddo + do k=1,3 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smois(:,k)) + enddo + ! Combine levels 4 to lsoil_lsm (9 for RUC) into one + nt=nt+1 + do ix=1,Atm_block%blksz(nb) + temp2d(ii1(ix),jj1(ix),nt) = sum(GFS_Data(nb)%Sfcprop%smois(ix,4:Model%lsoil_lsm)) + enddo + do k=1,3 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tslb(:,k)) + enddo + ! Combine levels 4 to lsoil_lsm (9 for RUC) into one + nt=nt+1 + do ix=1,Atm_block%blksz(nb) + temp2d(ii1(ix),jj1(ix),nt) = sum(GFS_Data(nb)%Sfcprop%tslb(ix,4:Model%lsoil_lsm)) + enddo + endif lsm_choice + + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t2m) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%q2m) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirbmdi) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirdfdi) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visbmdi) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visdfdi) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirbmui) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%nirdfui) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visbmui) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%visdfui) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%sfcdsw) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%sfcnsw) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Coupling%sfcdlw) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%xlon) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%xlat) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%xlat_d) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%sinlat) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%coslat) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%area) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%dx) + if (Model%ntoz > 0) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%ddy_o3) + endif + if (Model%h2o_phys) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Grid%ddy_h) + endif + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Cldprop%cv) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Cldprop%cvt) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Cldprop%cvb) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%sfalb) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%coszen) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%tsflw) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%semis) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Radtend%coszdg) + + ! Radtend%sfcfsw is an array of derived type, so we copy all + ! eight elements of the type in one loop + do ix=1,Atm_block%blksz(nb) + temp2d(ii1(ix),jj1(ix),nt+1) = GFS_Data(nb)%Radtend%sfcfsw(ix)%upfxc + temp2d(ii1(ix),jj1(ix),nt+2) = GFS_Data(nb)%Radtend%sfcfsw(ix)%upfx0 + temp2d(ii1(ix),jj1(ix),nt+3) = GFS_Data(nb)%Radtend%sfcfsw(ix)%dnfxc + temp2d(ii1(ix),jj1(ix),nt+4) = GFS_Data(nb)%Radtend%sfcfsw(ix)%dnfx0 + temp2d(ii1(ix),jj1(ix),nt+5) = GFS_Data(nb)%Radtend%sfcflw(ix)%upfxc + temp2d(ii1(ix),jj1(ix),nt+6) = GFS_Data(nb)%Radtend%sfcflw(ix)%upfx0 + temp2d(ii1(ix),jj1(ix),nt+7) = GFS_Data(nb)%Radtend%sfcflw(ix)%dnfxc + temp2d(ii1(ix),jj1(ix),nt+8) = GFS_Data(nb)%Radtend%sfcflw(ix)%dnfx0 + enddo + nt = nt + 8 + + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tiice(:,1)) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tiice(:,2)) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirvis_lnd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirnir_lnd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifvis_lnd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifnir_lnd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%emis_lnd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%emis_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sncovr_ice) + + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirvis_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdirnir_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifvis_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%albdifnir_ice) + endif + + lsm_choice_2: if (Model%lsm == Model%lsm_noahmp) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tvxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tgxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%canicexy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%canliqxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%eahxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tahxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%cmxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%chxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%fwetxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sneqvoxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%alboldxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qsnowxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%wslakexy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zwtxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%waxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%wtxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%lfmassxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%rtmassxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stmassxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%woodxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stblcpxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%fastcpxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xsaixy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xlaixy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%taussxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smcwtdxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%deeprechxy) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%rechxy) + + ! These five arrays use bizarre indexing, so we use loops: + do k=-2,0 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snicexy(:,k)) + enddo + + do k=-2,0 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snliqxy(:,k)) + enddo + + do k=-2,0 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsnoxy(:,k)) + enddo + + do k=1,4 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%smoiseq(:,k)) + enddo + + do k=-2,4 + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zsnsoxy(:,k)) + enddo + elseif (Model%lsm == Model%lsm_ruc) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%wetness) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%clw_surf_land) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%clw_surf_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qwv_surf_land) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qwv_surf_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsnow_land) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tsnow_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowfallac_land) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%snowfallac_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sfalb_lnd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sfalb_lnd_bck) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%sfalb_ice) + if (Model%rdlai) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xlaixy) + endif + endif lsm_choice_2 + + nstf_name_choice: if (Model%nstf_name(1) > 0) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%tref) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%z_c) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%c_0) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%c_d) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%w_0) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%w_d) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xt) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xs) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xu) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xz) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%zm) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xtts) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%xzts) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%ifd) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%dt_cool) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%qrain) + endif nstf_name_choice + + ! Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%T_snow) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%T_ice) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%h_ML) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_ML) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_mnw) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%h_talb) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_talb) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_bot1) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%t_bot2) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%c_t) + endif + + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Tbd%phy_f2d) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Tbd%phy_fctd) + + ! Copy to temp3dlevsp1 + nt=0 + + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3dlevsp1, GFS_Data(nb)%Statein%phii) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3dlevsp1, GFS_Data(nb)%Statein%prsi) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3dlevsp1, GFS_Data(nb)%Statein%prsik) + + ! Copy to temp3d + nt=0 + + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%phil) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%prsl) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%prslk) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%ugrs) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%vgrs) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%vvl) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%tgrs) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gu0) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gv0) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gt0) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%htrsw) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%htrlw) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%swhc) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Radtend%lwhc) + do k = 1,Model%ntot3d + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Tbd%phy_f3d(:,:,k)) + enddo + do k = 1,ntr + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Statein%qgrs(:,:,k)) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp3d,GFS_Data(nb)%Stateout%gq0(:,:,k)) + enddo + enddo block_loop + + + outunit = stdout() + do i = 1,nsfcprop2d+Model%ntot2d+Model%nctp + write (name, '(i3.3,3x,4a)') i, ' 2d ' + write(outunit,100) name, mpp_chksum(temp2d(:,:,i:i)) + enddo + do i = 1,3 + write (name, '(i2.2,3x,4a)') i, ' 3d levsp1' + write(outunit,100) name, mpp_chksum(temp3dlevsp1(:,:,:,i:i)) + enddo + do i = 1,14+Model%ntot3d+2*ntr + write (name, '(i2.2,3x,4a)') i, ' 3d levs' + write(outunit,100) name, mpp_chksum(temp3d(:,:,:,i:i)) + enddo +100 format("CHECKSUM::",A32," = ",Z20) + + deallocate(temp2d) + deallocate(temp3d) + deallocate(temp3dlevsp1) + end subroutine fv3atm_checksum + + !>@brief Reads surface, orography, CLM Lake, and RRFS-SD data. + !> \section sfc_prop_restart_read subroutine + !! Creates and populates a data type which is then used to "register" + !! restart variables with the FMS restart subsystem. + !! Calls an FMS routine to restore the data from a restart file. + !! Also calculates sncovr if it is not present in the restart file. + subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_start, ignore_rst_cksum) + use fv3atm_rrfs_sd_io + implicit none + !--- interface variable definitions + type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) + type (block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(inout) :: Model + type (domain2d), intent(in) :: fv_domain + logical, intent(in) :: warm_start + logical, intent(in) :: ignore_rst_cksum + !--- directory of the input files + character(5) :: indir='INPUT' + character(37) :: infile + !--- fms2_io file open logic + logical :: amiopen + logical :: override_frac_grid + + type(clm_lake_data_type) :: clm_lake + type(rrfs_sd_state_type) :: rrfs_sd_state + type(rrfs_sd_emissions_type) :: rrfs_sd_emis + type(Oro_scale_io_data_type) :: oro_ss + type(Oro_scale_io_data_type) :: oro_ls + type(Sfc_io_data_type) :: sfc + type(Oro_io_data_type) :: oro + + type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, dust12m_restart, emi_restart, rrfssd_restart + type(FmsNetcdfDomainFile_t) :: Oro_ls_restart, Oro_ss_restart + + !--- 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) ) + + call oro%register(Model,Oro_restart,Atm_block) + + !--- read the orography restart/data + call mpp_error(NOTE,'reading topographic/orographic information from INPUT/oro_data.tile*.nc') + call read_restart(Oro_restart, ignore_checksum=ignore_rst_cksum) + call close_file(Oro_restart) + + !--- copy data into GFS containers + call oro%copy(Model, Sfcprop, Atm_block) + + if_smoke: if(Model%rrfs_sd) then ! for RRFS-SD + + !--- Dust input FILE + !--- open file + infile=trim(indir)//'/'//trim(fn_dust12m) + amiopen=open_file(dust12m_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) ) + + !--- Register axes and variables, allocate memory: + call rrfs_sd_emis%register_dust12m(dust12m_restart, Atm_block) + + !--- read new GSL created dust12m restart/data + call mpp_error(NOTE,'reading dust12m information from INPUT/dust12m_data.tile*.nc') + call read_restart(dust12m_restart) + call close_file(dust12m_restart) + + !--- Copy to Sfcprop and free temporary arrays: + call rrfs_sd_emis%copy_dust12m(Sfcprop, Atm_block) + + !---------------------------------------------- + + !--- open anthropogenic emission file + infile=trim(indir)//'/'//trim(fn_emi) + amiopen=open_file(emi_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) ) + + ! Register axes and variables, allocate memory + call rrfs_sd_emis%register_emi(emi_restart, Atm_block) + + !--- read anthropogenic emi restart/data + call mpp_error(NOTE,'reading emi information from INPUT/emi_data.tile*.nc') + call read_restart(emi_restart) + call close_file(emi_restart) + + !--- Copy to Sfcprop and free temporary arrays: + call rrfs_sd_emis%copy_emi(Sfcprop, Atm_block) + + !---------------------------------------------- + + !--- Dust input FILE + !--- open file + infile=trim(indir)//'/'//trim(fn_rrfssd) + amiopen=open_file(rrfssd_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) ) + + ! Register axes and variables, allocate memory + call rrfs_sd_emis%register_fire(rrfssd_restart, Atm_block) + + !--- read new GSL created rrfssd restart/data + call mpp_error(NOTE,'reading rrfssd information from INPUT/SMOKE_RRFS_data.nc') + call read_restart(rrfssd_restart) + call close_file(rrfssd_restart) + + !--- Copy to Sfcprop and free temporary arrays: + call rrfs_sd_emis%copy_fire(Sfcprop, Atm_block) + + endif if_smoke ! RRFS_SD + + !--- 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 + + if ( (Model%gwd_opt==3 .or. Model%gwd_opt==33) .or. & + ( (Model%gwd_opt==2 .or. Model%gwd_opt==22) .and. & + Model%do_gsl_drag_ls_bl ) ) 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) ) + call oro_ls%register(Model,Oro_ls_restart,Atm_block) + !--- read new GSL created orography restart/data + call mpp_error(NOTE,'reading topographic/orographic information from & + &INPUT/oro_data_ls.tile*.nc') + call read_restart(Oro_ls_restart, ignore_checksum=ignore_rst_cksum) + call close_file(Oro_ls_restart) + call oro_ls%copy(Sfcprop,Atm_block,1) + endif + + !--- 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) ) + call oro_ss%register(Model,Oro_ss_restart,Atm_block) + call mpp_error(NOTE,'reading topographic/orographic information from & + &INPUT/oro_data_ss.tile*.nc') + call read_restart(Oro_ss_restart, ignore_checksum=ignore_rst_cksum) + call close_file(Oro_ss_restart) + call oro_ss%copy(Sfcprop,Atm_block,15) + 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)) + + if(sfc%allocate_arrays(Model, Atm_block, .true., warm_start)) then + call sfc%fill_2d_names(Model, warm_start) + call sfc%register_axes(Model, Sfc_restart, .true., warm_start) + + ! Tell CLM Lake to allocate data, and register its axes and fields + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%allocate_data(Model) + call clm_lake%copy_from_grid(Model,Atm_block,Sfcprop) + call clm_lake%register_axes(Model, Sfc_restart) + call clm_lake%register_fields(Sfc_restart) + endif + + if(Model%rrfs_sd) then + call rrfs_sd_state%allocate_data(Model) + call rrfs_sd_state%fill_data(Model, Atm_block, Sfcprop) + call rrfs_sd_state%register_axis(Model, Sfc_restart) + call rrfs_sd_state%register_fields(Sfc_restart) + endif + + call sfc%register_2d_fields(Model,Sfc_restart,.true.,warm_start) + endif ! if not allocated + + call sfc%fill_3d_names(Model,warm_start) + call sfc%register_3d_fields(Model,Sfc_restart,.true.,warm_start) + call sfc%init_fields(Model) + + !--- read the surface restart/data + call mpp_error(NOTE,'reading surface properties data from INPUT/sfc_data.tile*.nc') + call read_restart(Sfc_restart, ignore_checksum=ignore_rst_cksum) + call close_file(Sfc_restart) + + ! Tell clm_lake to copy data to temporary arrays + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%copy_to_grid(Model,Atm_block,Sfcprop) + endif + + if(Model%rrfs_sd) then + call rrfs_sd_state%copy_to_grid(Model,Atm_block,Sfcprop) + end if + + ! 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)) + ! write(0,*)' sfc%var2=',sfc%var2(:,:,12) + + !--- place the data into the block GFS containers + override_frac_grid=Model%frac_grid + call sfc%copy_to_grid(Model, Atm_block, Sfcprop, warm_start, override_frac_grid) + Model%frac_grid=override_frac_grid + + call mpp_error(NOTE, 'gfs_driver:: - after put to container ') + + call sfc%apply_safeguards(Model, Atm_block, Sfcprop) + + ! A standard-compliant Fortran 2003 compiler will call clm_lake_final and rrfs_sd_final here. + + end subroutine sfc_prop_restart_read + + !>@brief Writes surface restart data without using the write component. + !> \section sfc_prop_restart_write procedure + !! Routine to write out GFS surface restarts via the FMS restart + !! subsystem. Takes an optional argument to append timestamps for intermediate + !! restarts. + subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timestamp) + use fv3atm_rrfs_sd_io + implicit none + !--- interface variable definitions + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + type(domain2d), intent(in) :: fv_domain + character(len=32), optional, intent(in) :: timestamp + !--- 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 + + type(clm_lake_data_type), target :: clm_lake + type(rrfs_sd_state_type) :: rrfs_sd_state + type(Sfc_io_data_type) :: sfc + type(FmsNetcdfDomainFile_t) :: Sfc_restart + + !--- 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: if( amiopen ) then + call sfc%register_axes(Model, Sfc_restart, .false., .true.) + call sfc%write_axes(Model, Sfc_restart) + else + call mpp_error(FATAL, 'Error in opening file'//trim(infile) ) + end if if_amiopen + + ! Tell clm_lake to allocate data, register its axes, and call write_data for each axis's variable + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%allocate_data(Model) + call clm_lake%register_axes(Model, Sfc_restart) + call clm_lake%write_axes(Model, Sfc_restart) + endif + + if(Model%rrfs_sd) then + call rrfs_sd_state%allocate_data(Model) + call rrfs_sd_state%register_axis(Model,Sfc_restart) + call rrfs_sd_state%write_axis(Model,Sfc_restart) + end if + + if (sfc%allocate_arrays(Model, Atm_block, .false., .true.)) then + call sfc%fill_2d_names(Model,.true.) + end if + + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + ! Tell clm_lake to register all of its fields + call clm_lake%register_fields(Sfc_restart) + endif + + if(Model%rrfs_sd) then + call rrfs_sd_state%register_fields(Sfc_restart) + endif + + ! Register 2D surface property fields (except lake, smoke, and dust) + call sfc%register_2d_fields(Model, Sfc_restart, .false., .true.) + + ! Determine list of 3D surface property fields names: + call sfc%fill_3d_names(Model, .true.) + + ! Register 3D surface property fields (except lake, smoke, and dust) + call sfc%register_3d_fields(Model, Sfc_restart, .false., .true.) + + ! Tell clm_lake to copy Sfcprop data to its internal temporary arrays. + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%copy_from_grid(Model,Atm_block,Sfcprop) + endif + + if(Model%rrfs_sd) then + call rrfs_sd_state%copy_from_grid(Model,Atm_block,Sfcprop) + endif + + call sfc%copy_from_grid(Model, Atm_block, Sfcprop) + + call write_restart(Sfc_restart) + call close_file(Sfc_restart) + + ! A standard-compliant Fortran 2003 compiler will call rrfs_sd_final and clm_lake_final here + + end subroutine sfc_prop_restart_write + + !>@brief Reads the physics restart data. + !> \section phys_restart_read subroutine + !! Creates and populates a data type which is then used to "register" + !! restart variables with the GFDL FMS restart subsystem. + !! Calls a GFDL FMS routine to restore the data from a restart file. + subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain, ignore_rst_cksum) + implicit none + !--- interface variable definitions + type(GFS_restart_type), intent(in) :: GFS_Restart + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + type(domain2d), intent(in) :: fv_domain + logical, intent(in) :: ignore_rst_cksum + !--- local variables + integer :: i, j, k, nb, ix, num + integer :: isc, iec, jsc, jec, nx, ny + 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, was_allocated + + type(phy_data_type) :: phy + type(FmsNetcdfDomainFile_t) :: Phy_restart + + isc = Atm_block%isc + iec = Atm_block%iec + jsc = Atm_block%jsc + jec = Atm_block%jec + nx = (iec - isc + 1) + ny = (jec - jsc + 1) + + was_allocated = phy%alloc(GFS_Restart, Atm_block) + + !--- 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', phy%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(was_allocated) then + + do num = 1,phy%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,phy%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) + 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, ignore_checksum=ignore_rst_cksum) + call close_file(Phy_restart) + + call phy%transfer_data(.true., GFS_Restart, Atm_block, Model) + + end subroutine phys_restart_read + + !>@brief Writes the physics restart file without using the write component + !> \section phys_restart_write subroutine + !! Routine to write out GFS surface restarts via the FMS restart + !! subsystem. Takes an optional argument to append timestamps for intermediate + !! restarts. + subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) + implicit none + !--- interface variable definitions + type(GFS_restart_type), intent(in) :: GFS_Restart + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + type(domain2d), intent(in) :: fv_domain + character(len=32), optional, intent(in) :: timestamp + !--- local variables + integer :: i, j, k, nb, ix, num + integer :: isc, iec, jsc, jec, nx, ny + 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, allocated_something + + type(phy_data_type) :: phy + type(FmsNetcdfDomainFile_t) :: Phy_restart + + isc = Atm_block%isc + iec = Atm_block%iec + jsc = Atm_block%jsc + jec = Atm_block%jec + nx = (iec - isc + 1) + ny = (jec - jsc + 1) + + !--- register the restart fields + allocated_something = phy%alloc(GFS_Restart, Atm_block) + + !--- 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', phy%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(phy%npz) ) + do i=1, phy%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 + + do num = 1,phy%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,phy%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) + + call phy%transfer_data(.false., GFS_Restart, Atm_block, Model) + + call write_restart(Phy_restart) + call close_file(Phy_restart) + + end subroutine phys_restart_write + + !>@brief Allocates buffers and registers fields for a quilting (write component) restart. + !> \section fv3atm_restart_register subroutine + !! Allocates all data buffers and sets variable names for surface and physics restarts. + subroutine fv3atm_restart_register (Sfcprop, GFS_restart, Atm_block, Model) + implicit none + + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_restart_type), intent(in) :: GFS_Restart + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + + logical was_changed + + !--------------- phy + was_changed = phy_quilt%alloc(GFS_Restart, Atm_block) + + !--------------- sfc + was_changed = sfc_quilt%allocate_arrays(Model, Atm_block, .false., .true.) + call sfc_quilt%fill_2d_names(Model, .true.) + call sfc_quilt%fill_3d_names(Model, .true.) + + if(Model%iopt_lake == 2 .and. Model%lkm > 0) then + call clm_lake_quilt%allocate_data(Model) + endif + + if(Model%rrfs_sd) then + call rrfs_sd_quilt%allocate_data(Model) + endif + + end subroutine fv3atm_restart_register + + !>@Copies physics restart fields from write component data structures to the model grid. + subroutine fv_phy_restart_output(GFS_Restart, Atm_block) + + implicit none + + type(GFS_restart_type), intent(in) :: GFS_Restart + type(block_control_type), intent(in) :: Atm_block + + call phy_quilt%transfer_data(.false., GFS_Restart, Atm_block) + + end subroutine fv_phy_restart_output + + !>@Copies physics restart fields from the model grid to write component data structures + subroutine fv_sfc_restart_output(Sfcprop, Atm_block, Model) + !--- interface variable definitions + implicit none + + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + + call sfc_quilt%copy_from_grid(Model, Atm_block, Sfcprop) + if(Model%iopt_lake == 2 .and. Model%lkm > 0) then + call clm_lake_quilt%copy_from_grid(Model, Atm_block, Sfcprop) + endif + if(Model%rrfs_sd) then + call rrfs_sd_quilt%copy_from_grid(Model, Atm_block, Sfcprop) + endif + + end subroutine fv_sfc_restart_output + + !>@ Creates the ESMF bundle for physics restart data + subroutine fv_phy_restart_bundle_setup(bundle, grid, rc) + use esmf + + implicit none + + type(ESMF_FieldBundle),intent(inout) :: bundle + type(ESMF_Grid),intent(inout) :: grid + integer,intent(out) :: rc + + !*** local variables + integer i + character(128) :: bdl_name + character(128) :: outputfile + real(kind_phys),dimension(:,:),pointer :: temp_r2d + real(kind_phys),dimension(:,:,:),pointer :: temp_r3d + integer :: num + real(kind_phys), allocatable :: axis_values(:) + + if (.not. associated(phy_quilt%var2)) then + write(0,*)'ERROR phy_quilt%var2, NOT allocated' + endif + if (.not. associated(phy_quilt%var3)) then + write(0,*)'ERROR phy_quilt%var3 NOT allocated' + endif + + call ESMF_FieldBundleGet(bundle, name=bdl_name,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + outputfile = trim(bdl_name) + + !*** add esmf fields + + do num = 1,phy_quilt%nvar2d + temp_r2d => phy_quilt%var2(:,:,num) + call create_2d_field_and_add_to_bundle(temp_r2d, trim(phy_quilt%var2_names(num)), trim(outputfile), grid, bundle) + enddo + + allocate(axis_values(phy_quilt%npz)) + axis_values = (/ (i, i=1,phy_quilt%npz) /) + + do num = 1,phy_quilt%nvar3d + temp_r3d => phy_quilt%var3(:,:,:,num) + call create_3d_field_and_add_to_bundle(temp_r3d, trim(phy_quilt%var3_names(num)), "zaxis_1", axis_values, trim(outputfile), grid, bundle) + enddo + + deallocate(axis_values) + + end subroutine fv_phy_restart_bundle_setup + + !>@ Creates the ESMF bundle for surface restart data + subroutine fv_sfc_restart_bundle_setup(bundle, grid, Model, rc) + use esmf + + implicit none + + type(ESMF_FieldBundle),intent(inout) :: bundle + type(ESMF_Grid),intent(inout) :: grid + type(GFS_control_type), intent(in) :: Model + integer,intent(out) :: rc + + !*** local variables + character(128) :: sfcbdl_name + character(128) :: outputfile + + call ESMF_FieldBundleGet(bundle, name=sfcbdl_name,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + outputfile = trim(sfcbdl_name) + + !*** add esmf fields + + call sfc_quilt%bundle_2d_fields(bundle, grid, Model, outputfile) + call sfc_quilt%bundle_3d_fields(bundle, grid, Model, outputfile) + + if(Model%iopt_lake == 2 .and. Model%lkm > 0) then + call clm_lake_quilt%bundle_fields(bundle, grid, Model, outputfile) + endif + if(Model%rrfs_sd) then + call rrfs_sd_quilt%bundle_fields(bundle, grid, Model, outputfile) + endif + + end subroutine fv_sfc_restart_bundle_setup + + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ! + ! PRIVATE SUBROUTINES + ! + !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + !>@brief Allocates and fills internal data structures for quilt or non-quilt physics restart I/O + !> \section phy_data_type%alloc procedure + !! Allocates the variable and variable name data structures in the phy_data_type. + !! Also, copies the GFS_Restart names to the phy_data_type arrays. + !! Do not call from outside this module; it is part of the internal implementation. + logical function phy_data_alloc(phy, GFS_Restart, Atm_block) + use fv3atm_common_io, only: get_nx_ny_from_atm + implicit none + class(phy_data_type) :: phy + type(GFS_restart_type), intent(in) :: GFS_Restart + type(block_control_type), intent(in) :: Atm_block + + integer :: nx, ny, num + + phy_data_alloc = .false. + + if(associated(phy%var2)) return + + call get_nx_ny_from_atm(Atm_block, nx, ny) + + phy%npz = Atm_block%npz + phy%nvar2d = GFS_Restart%num2d + phy%nvar3d = GFS_Restart%num3d + + allocate (phy%var2(nx,ny,phy%nvar2d), phy%var2_names(phy%nvar2d)) + allocate (phy%var3(nx,ny,phy%npz,phy%nvar3d), phy%var3_names(phy%nvar3d)) + phy%var2 = zero + phy%var3 = zero + do num = 1,phy%nvar2d + phy%var2_names(num) = trim(GFS_Restart%name2d(num)) + enddo + do num = 1,phy%nvar3d + phy%var3_names(num) = trim(GFS_Restart%name3d(num)) + enddo + + phy_data_alloc = .true. + end function phy_data_alloc + + !>@brief Copies data between the internal physics restart data structures and the model grid + !> \section phy_data_type%transfer_data procedure + !! Restart I/O stores data in temporary arrays while interfacing with ESMF or FMS. This procedure + !! copies between the temporary arrays and the model grid. The "reading" flag controls the + !! direction of the copy. For reading=.true., data is copied from the temporary arrays to the + !! model grid (during restart read). For reading=.false., data is copied from the model grid to + !! temporary arrays (for writing the restart). + subroutine phy_data_transfer_data(phy, reading, GFS_Restart, Atm_block, Model) + use mpp_mod, only: FATAL, mpp_error + implicit none + class(phy_data_type) :: phy + logical, intent(in) :: reading + type(GFS_restart_type) :: GFS_Restart + type(block_control_type) :: Atm_block + type(GFS_control_type), optional, intent(in) :: Model + + integer :: i, j, k, num, nb, ix + + !--- register the restart fields + if (.not. associated(phy%var2)) then + call mpp_error(FATAL,'phy%var2 must be allocated') + return ! should never get here + endif + if (.not. associated(phy%var3)) then + call mpp_error(FATAL,'phy%var3 must be allocated') + return ! should never get here + endif + + ! Copy 2D Vars + + if(reading) then + !--- place the data into the block GFS containers + !--- phy%var* variables + do num = 1,phy%nvar2d + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1,Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + GFS_Restart%data(nb,num)%var2p(ix) = phy%var2(i,j,num) + enddo + enddo + enddo + else + !--- 2D variables + do num = 1,phy%nvar2d + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1,Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + phy%var2(i,j,num) = GFS_Restart%data(nb,num)%var2p(ix) + enddo + enddo + enddo + endif + + !-- if restart from init time, reset accumulated diag fields + + if(reading .and. present(Model)) then + if(Model%phour < 1.e-7) then + do num = GFS_Restart%fdiag,GFS_Restart%ldiag + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1,Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + GFS_Restart%data(nb,num)%var2p(ix) = zero + enddo + enddo + enddo + endif + endif + + ! Copy 3D Vars + + if(reading) then + do num = 1,phy%nvar3d + !$omp parallel do default(shared) private(i, j, k, nb, ix) + do nb = 1,Atm_block%nblks + do k=1,phy%npz + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + GFS_Restart%data(nb,num)%var3p(ix,k) = phy%var3(i,j,k,num) + enddo + enddo + enddo + enddo + else + !--- 3D variables + do num = 1,phy%nvar3d + !$omp parallel do default(shared) private(i, j, k, nb, ix) + do nb = 1,Atm_block%nblks + do k=1,phy%npz + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + phy%var3(i,j,k,num) = GFS_Restart%data(nb,num)%var3p(ix,k) + enddo + enddo + enddo + enddo + endif + + end subroutine phy_data_transfer_data + + !>@ Destructor for phy_data_type + subroutine phy_data_final(phy) + implicit none + type(phy_data_type) :: phy + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(phy%var)) then ; \ + deallocate(phy%var) ; \ + nullify(phy%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(var2) + IF_ASSOC_DEALLOC_NULL(var3) + IF_ASSOC_DEALLOC_NULL(var2_names) + IF_ASSOC_DEALLOC_NULL(var3_names) + +#undef IF_ASSOC_DEALLOC_NULL + end subroutine phy_data_final + +end module fv3atm_restart_io_mod +!> @} diff --git a/io/fv3atm_rrfs_sd_io.F90 b/io/fv3atm_rrfs_sd_io.F90 new file mode 100644 index 000000000..c6dc44e34 --- /dev/null +++ b/io/fv3atm_rrfs_sd_io.F90 @@ -0,0 +1,607 @@ +!> \file fv3atm_rrfs_sd_io.F90 +!! This file contains derived types and subroutines for RRFS-SD scheme I/O. +!! They read and write restart files, and read emissions data. + +module fv3atm_rrfs_sd_io + use block_control_mod, only: block_control_type + use fms2_io_mod, only: FmsNetcdfDomainFile_t, write_data, & + register_axis, register_restart_field, & + register_variable_attribute, register_field + use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys + use fv3atm_common_io, only: get_nx_ny_from_atm, create_2d_field_and_add_to_bundle, & + create_3d_field_and_add_to_bundle + + implicit none + + private + + public :: rrfs_sd_state_type, rrfs_sd_state_register_axis, rrfs_sd_state_write_axis, & + rrfs_sd_state_fill_data, rrfs_sd_state_register_fields, rrfs_sd_state_deallocate_data, & + rrfs_sd_state_copy_from_grid, rrfs_sd_state_copy_to_grid, & + rrfs_sd_state_final + + public :: rrfs_sd_emissions_type, rrfs_sd_emissions_final, & + rrfs_sd_emissions_register_dust12m, rrfs_sd_emissions_copy_dust12m, & + rrfs_sd_emissions_register_emi, rrfs_sd_emissions_copy_emi, & + rrfs_sd_emissions_register_fire, rrfs_sd_emissions_copy_fire + + !>\defgroup fv3atm_rrfs_sd_io module + !> @{ + + !>@ Temporary data storage for reading and writing restart data for the RRFS-SD scheme. + type rrfs_sd_state_type + ! The rrfs_sd_state_type stores temporary arrays used to read or + ! write RRFS-SD restart and axis variables. + + real(kind_phys), pointer, private, dimension(:,:) :: & ! i,j variables + emdust=>null(), emseas=>null(), emanoc=>null(), fhist=>null(), coef_bb_dc=>null() + + real(kind_phys), pointer, private, dimension(:,:,:) :: & + fire_in=>null() ! i, j, fire_aux_data_levels + + real(kind_phys), pointer, private, dimension(:) :: & + fire_aux_data_levels=>null() ! 1:Model%fire_aux_data_levels index array for metadata write + + contains + procedure, public :: register_axis => rrfs_sd_state_register_axis ! register fire_aux_data_levels axis + procedure, public :: write_axis => rrfs_sd_state_write_axis ! write fire_aux_data_levels variable + procedure, public :: allocate_data => rrfs_sd_state_allocate_data ! allocate all pointers + procedure, public :: fill_data => rrfs_sd_state_fill_data ! fill data with default values + procedure, public :: register_fields => rrfs_sd_state_register_fields ! register rrfs_sd fields + procedure, public :: deallocate_data => rrfs_sd_state_deallocate_data ! deallocate pointers + procedure, public :: copy_from_grid => rrfs_sd_state_copy_from_grid ! Copy Sfcprop to arrays + procedure, public :: copy_to_grid => rrfs_sd_state_copy_to_grid ! Copy arrays to Sfcprop + procedure, public :: bundle_fields => rrfs_sd_bundle_fields ! Point esmf bundles to arrays + final :: rrfs_sd_state_final ! Destructor; calls deallocate_data + end type rrfs_sd_state_type + + ! -------------------------------------------------------------------- + + !>@ Temporary data storage for reading RRFS-SD emissions data + type rrfs_sd_emissions_type + integer, private :: nvar_dust12m = 5 + integer, private :: nvar_emi = 1 + integer, private :: nvar_fire = 3 + + character(len=32), pointer, dimension(:), private :: dust12m_name => null() + character(len=32), pointer, dimension(:), private :: emi_name => null() + character(len=32), pointer, dimension(:), private :: fire_name => null() + + real(kind=kind_phys), pointer, dimension(:,:,:,:), private :: dust12m_var => null() + real(kind=kind_phys), pointer, dimension(:,:,:,:), private :: emi_var => null() + real(kind=kind_phys), pointer, dimension(:,:,:,:), private :: fire_var => null() + + contains + + procedure, public :: register_dust12m => rrfs_sd_emissions_register_dust12m + procedure, public :: copy_dust12m => rrfs_sd_emissions_copy_dust12m + + procedure, public :: register_emi => rrfs_sd_emissions_register_emi + procedure, public :: copy_emi => rrfs_sd_emissions_copy_emi + + procedure, public :: register_fire => rrfs_sd_emissions_register_fire + procedure, public :: copy_fire => rrfs_sd_emissions_copy_fire + + final :: rrfs_sd_emissions_final + end type rrfs_sd_emissions_type + + ! -------------------------------------------------------------------- + +contains + + + ! -------------------------------------------------------------------- + ! -- RRFS_SD_STATE IMPLEMENTATION ------------------------------------ + ! -------------------------------------------------------------------- + + !>@ Registers the fire_aux_data_levels axis for restart I/O + subroutine rrfs_sd_state_register_axis(data,Model,Sfc_restart) + implicit none + class(rrfs_sd_state_type) :: data + type(FmsNetcdfDomainFile_t) :: Sfc_restart + type(GFS_control_type), intent(in) :: Model + call register_axis(Sfc_restart, 'fire_aux_data_levels', & + dimension_length=Model%fire_aux_data_levels) + end subroutine rrfs_sd_state_register_axis + + ! -------------------------------------------------------------------- + + !>@ Registers and writes the axis indices for the fire_aux_data_levels axis + subroutine rrfs_sd_state_write_axis(data,Model,Sfc_restart) + implicit none + class(rrfs_sd_state_type) :: data + type(FmsNetcdfDomainFile_t) :: Sfc_restart + type(GFS_control_type), intent(in) :: Model + + call register_field(Sfc_restart, 'fire_aux_data_levels', 'double', (/'fire_aux_data_levels'/)) + call register_variable_attribute(Sfc_restart, 'fire_aux_data_levels', 'cartesian_axis' ,'Z', str_len=1) + call write_data(Sfc_restart, 'fire_aux_data_levels', data%fire_aux_data_levels) + end subroutine rrfs_sd_state_write_axis + + ! -------------------------------------------------------------------- + + !>@ Allocates temporary arrays for RRFS-SD scheme I/O and stores fire_aux_data_levels axis indices + subroutine rrfs_sd_state_allocate_data(data,Model) + implicit none + class(rrfs_sd_state_type) :: data + type(GFS_control_type), intent(in) :: Model + integer :: nx, ny, i + + call data%deallocate_data + + nx=Model%nx + ny=Model%ny + + allocate(data%emdust(nx,ny)) + allocate(data%emseas(nx,ny)) + allocate(data%emanoc(nx,ny)) + allocate(data%fhist(nx,ny)) + allocate(data%coef_bb_dc(nx,ny)) + allocate(data%fire_aux_data_levels(Model%fire_aux_data_levels)) + allocate(data%fire_in(nx,ny,Model%fire_aux_data_levels)) + + do i=1,Model%fire_aux_data_levels + data%fire_aux_data_levels(i) = i + enddo + + end subroutine rrfs_sd_state_allocate_data + + ! -------------------------------------------------------------------- + + !>@brief Fills RRFS-SD temporary arrays with reasonable defaults. + !> \section rrfs_sd_state_type%fill_data() procedure + !! Fills all temporary variables with default values. + !! Terrible things will happen if you don't call data%allocate_data first. + subroutine rrfs_sd_state_fill_data(data, Model, Atm_block, Sfcprop) + implicit none + class(rrfs_sd_state_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + + isc = Model%isc + jsc = Model%jsc + + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + 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 + + data%emdust(i,j) = 0 + data%emseas(i,j) = 0 + data%emanoc(i,j) = 0 + data%fhist(i,j) = 1. + data%coef_bb_dc(i,j) = 0 + + data%fire_in(i,j,:) = 0 + end do + end do + end subroutine rrfs_sd_state_fill_data + + ! -------------------------------------------------------------------- + + !>@brief Registers RRFS-SD restart variables (for read or write) + !> \section rrfs_sd_state_type%register_fields() procedure + !! Registers all restart fields needed by the RRFS-SD + !! Terrible things will happen if you don't call data%allocate_data + !! and data%register_axes first. + subroutine rrfs_sd_state_register_fields(data,Sfc_restart) + implicit none + class(rrfs_sd_state_type) :: data + type(FmsNetcdfDomainFile_t) :: Sfc_restart + + ! Register 2D fields + call register_restart_field(Sfc_restart, 'emdust', data%emdust, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'emseas', data%emseas, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'emanoc', data%emanoc, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'fhist', data%fhist, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'coef_bb_dc', data%coef_bb_dc, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + + ! Register 3D field + call register_restart_field(Sfc_restart, 'fire_in', data%fire_in, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'fire_aux_data_levels', 'Time '/), & + is_optional=.true.) + end subroutine rrfs_sd_state_register_fields + + ! -------------------------------------------------------------------- + + !>@brief Creates ESMF bundles for writing RRFS-SD restarts via the write component (quilt) + !> \section rrfs_sd_state_type%bundle_fields() procedure + !! Registers all restart fields needed by the RRFS-SD + !! Terrible things will happen if you don't call data%allocate_data + !! and data%register_axes first. + subroutine rrfs_sd_bundle_fields(data, bundle, grid, Model, outputfile) + use esmf + use GFS_typedefs, only: GFS_control_type + implicit none + class(rrfs_sd_state_type) :: data + type(ESMF_FieldBundle),intent(inout) :: bundle + type(ESMF_Grid),intent(inout) :: grid + type(GFS_control_type), intent(in) :: Model + character(*), intent(in) :: outputfile + + ! Register 2D fields + call create_2d_field_and_add_to_bundle(data%emdust, "emdust", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(data%emseas, "emseas", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(data%emanoc, "emanoc", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(data%fhist, "fhist", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(data%coef_bb_dc, "coef_bb_dc", trim(outputfile), grid, bundle) + + ! Register 3D field + call create_3d_field_and_add_to_bundle(data%fire_in, 'fire_in', 'fire_aux_data_levels', & + data%fire_aux_data_levels, trim(outputfile), grid, bundle) + end subroutine rrfs_sd_bundle_fields + + ! -------------------------------------------------------------------- + + !>@brief Destructor for the rrfs_sd_state_type + !> \section rrfs_sd_state_type destructor() procedure + !! Final routine for rrfs_sd_state_type, called automatically when + !! an object of that type goes out of scope. This is a wrapper + !! around data%deallocate_data() with necessary syntactic + !! differences. + subroutine rrfs_sd_state_final(data) + implicit none + type(rrfs_sd_state_type) :: data + call rrfs_sd_state_deallocate_data(data) + end subroutine rrfs_sd_state_final + + ! -------------------------------------------------------------------- + + !>@brief Deallocates internal arrays in an rrfs_sd_state_type + !> \section rrfs_sd_state_type%deallocate_data() procedure + !! Deallocates all data used, and nullifies the pointers. The data + !! object can safely be used again after this call. This is also + !! the implementation of the rrfs_sd_state_deallocate_data final routine. + subroutine rrfs_sd_state_deallocate_data(data) + implicit none + class(rrfs_sd_state_type) :: data + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(data%var)) then ; \ + deallocate(data%var) ; \ + nullify(data%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(emdust) + IF_ASSOC_DEALLOC_NULL(emseas) + IF_ASSOC_DEALLOC_NULL(emanoc) + IF_ASSOC_DEALLOC_NULL(fhist) + IF_ASSOC_DEALLOC_NULL(coef_bb_dc) + + IF_ASSOC_DEALLOC_NULL(fire_in) + + ! Undefine this to avoid cluttering the cpp scope: +#undef IF_ASSOC_DEALLOC_NULL + end subroutine rrfs_sd_state_deallocate_data + + ! -------------------------------------------------------------------- + + !>@brief Copies from rrfs_sd_state_type internal arrays to the model grid. + !> \section rrfs_sd_state_type%copy_to_grid() procedure + !! This procedure is called after reading a restart, to copy restart data + !! from the rrfs_sd_state_type to the model grid. + subroutine rrfs_sd_state_copy_to_grid(data, Model, Atm_block, Sfcprop) + implicit none + class(rrfs_sd_state_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, i, j + + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + + Sfcprop(nb)%emdust(ix) = data%emdust(i,j) + Sfcprop(nb)%emseas(ix) = data%emseas(i,j) + Sfcprop(nb)%emanoc(ix) = data%emanoc(i,j) + Sfcprop(nb)%fhist(ix) = data%fhist(i,j) + Sfcprop(nb)%coef_bb_dc(ix) = data%coef_bb_dc(i,j) + + Sfcprop(nb)%fire_in(ix,:) = data%fire_in(i,j,:) + enddo + enddo + end subroutine rrfs_sd_state_copy_to_grid + + ! -------------------------------------------------------------------- + + !>@brief Copies from the model grid to rrfs_sd_state_type internal arrays + !> \section rrfs_sd_state_type%copy_from_grid() procedure + !! This procedure is called before writing the restart, to copy data from + !! the model grid to rrfs_sd_state_type internal arrays. The ESMF or FMS + !! restart code will write data from those arrays, not the model grid. + subroutine rrfs_sd_state_copy_from_grid(data, Model, Atm_block, Sfcprop) + implicit none + class(rrfs_sd_state_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, i, j + + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + + data%emdust(i,j) = Sfcprop(nb)%emdust(ix) + data%emseas(i,j) = Sfcprop(nb)%emseas(ix) + data%emanoc(i,j) = Sfcprop(nb)%emanoc(ix) + data%fhist(i,j) = Sfcprop(nb)%fhist(ix) + data%coef_bb_dc(i,j) = Sfcprop(nb)%coef_bb_dc(ix) + + data%fire_in(i,j,:) = Sfcprop(nb)%fire_in(ix,:) + enddo + enddo + end subroutine rrfs_sd_state_copy_from_grid + + ! -------------------------------------------------------------------- + ! -- RRFS_SD_EMISSIONS IMPLEMENTATION -------------------------------- + ! -------------------------------------------------------------------- + + !>@ Allocates temporary arrays and registers variables for reading the dust12m file. + subroutine rrfs_sd_emissions_register_dust12m(data, restart, Atm_block) + implicit none + class(rrfs_sd_emissions_type) :: data + type(FmsNetcdfDomainFile_t) :: restart + type(block_control_type), intent(in) :: Atm_block + + real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() + integer :: num, nx, ny + + if(associated(data%dust12m_name)) then + deallocate(data%dust12m_name) + nullify(data%dust12m_name) + endif + if(associated(data%dust12m_var)) then + deallocate(data%dust12m_var) + nullify(data%dust12m_var) + endif + + call get_nx_ny_from_atm(Atm_block, nx, ny) + allocate(data%dust12m_name(data%nvar_dust12m)) + allocate(data%dust12m_var(nx,ny,12,data%nvar_dust12m)) + + data%dust12m_name(1) = 'clay' + data%dust12m_name(2) = 'rdrag' + data%dust12m_name(3) = 'sand' + data%dust12m_name(4) = 'ssm' + data%dust12m_name(5) = 'uthr' + + !--- register axis + call register_axis(restart, 'lon', 'X') + call register_axis(restart, 'lat', 'Y') + call register_axis(restart, 'time', 12) + !--- register the 3D fields + do num = 1,data%nvar_dust12m + var3_p2 => data%dust12m_var(:,:,:,num) + call register_restart_field(restart, data%dust12m_name(num), var3_p2, & + dimensions=(/'time', 'lat ', 'lon '/),& + &is_optional=.true.) + ! That was "is_optional=.not.mand" in the original, but mand was never initialized. + enddo + end subroutine rrfs_sd_emissions_register_dust12m + + ! -------------------------------------------------------------------- + + !>@ Called after register_dust12m() to copy data from internal arrays to the model grid and deallocate arrays + subroutine rrfs_sd_emissions_copy_dust12m(data, Sfcprop, Atm_block) + implicit none + type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) + class(rrfs_sd_emissions_type) :: data + type(block_control_type), intent(in) :: Atm_block + + integer :: num, nb, i, j, ix, k + + if(.not.associated(data%dust12m_name) .or. .not.associated(data%dust12m_var)) then + write(0,*) 'ERROR: Called copy_dust12m before register_dust12m' + return + endif + + !$omp parallel do default(shared) private(i, j, nb, ix, k) + do nb = 1, Atm_block%nblks + !--- 3D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + do k = 1, 12 + Sfcprop(nb)%dust12m_in(ix,k,1) = data%dust12m_var(i,j,k,1) + Sfcprop(nb)%dust12m_in(ix,k,2) = data%dust12m_var(i,j,k,2) + Sfcprop(nb)%dust12m_in(ix,k,3) = data%dust12m_var(i,j,k,3) + Sfcprop(nb)%dust12m_in(ix,k,4) = data%dust12m_var(i,j,k,4) + Sfcprop(nb)%dust12m_in(ix,k,5) = data%dust12m_var(i,j,k,5) + enddo + enddo + enddo + + deallocate(data%dust12m_name) + nullify(data%dust12m_name) + deallocate(data%dust12m_var) + nullify(data%dust12m_var) + end subroutine rrfs_sd_emissions_copy_dust12m + + ! -------------------------------------------------------------------- + + !>@ Allocates temporary arrays and registers variables for reading the emissions file. + subroutine rrfs_sd_emissions_register_emi(data, restart, Atm_block) + implicit none + class(rrfs_sd_emissions_type) :: data + type(FmsNetcdfDomainFile_t) :: restart + type(block_control_type), intent(in) :: Atm_block + + real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() + integer :: num, nx, ny + + if(associated(data%emi_name)) then + deallocate(data%emi_name) + nullify(data%emi_name) + endif + + if(associated(data%emi_var)) then + deallocate(data%emi_var) + nullify(data%emi_var) + endif + + call get_nx_ny_from_atm(Atm_block, nx, ny) + allocate(data%emi_name(data%nvar_emi)) + allocate(data%emi_var(nx,ny,1,data%nvar_emi)) + + data%emi_name(1) = 'e_oc' + !--- register axis + call register_axis( restart, 'time', 1) ! only read first time level, even if multiple are present + call register_axis( restart, "grid_xt", 'X' ) + call register_axis( restart, "grid_yt", 'Y' ) + !--- register the 2D fields + do num = 1,data%nvar_emi + var3_p2 => data%emi_var(:,:,:,num) + call register_restart_field(restart, data%emi_name(num), var3_p2, & + dimensions=(/'time ','grid_yt','grid_xt'/)) + enddo + end subroutine rrfs_sd_emissions_register_emi + + ! -------------------------------------------------------------------- + + !>@ Called after register_emi() to copy data from internal arrays to the model grid and deallocate arrays + subroutine rrfs_sd_emissions_copy_emi(data, Sfcprop, Atm_block) + implicit none + type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) + class(rrfs_sd_emissions_type) :: data + type(block_control_type), intent(in) :: Atm_block + + integer :: num, nb, i, j, ix + + if(.not.associated(data%emi_name) .or. .not.associated(data%emi_var)) then + write(0,*) 'ERROR: Called copy_emi before register_emi' + return + endif + + do num=1,data%nvar_emi + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + !--- 2D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + Sfcprop(nb)%emi_in(ix,num) = data%emi_var(i,j,1,num) + enddo + enddo + enddo + + deallocate(data%emi_name) + nullify(data%emi_name) + deallocate(data%emi_var) + nullify(data%emi_var) + end subroutine rrfs_sd_emissions_copy_emi + + ! -------------------------------------------------------------------- + + !>@ Allocates temporary arrays and registers variables for reading the fire data file. + subroutine rrfs_sd_emissions_register_fire(data, restart, Atm_block) + implicit none + class(rrfs_sd_emissions_type) :: data + type(FmsNetcdfDomainFile_t) :: restart + type(block_control_type), intent(in) :: Atm_block + + real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() + integer :: num, nx, ny + + if(associated(data%fire_name)) then + deallocate(data%fire_name) + nullify(data%fire_name) + endif + + if(associated(data%fire_var)) then + deallocate(data%fire_var) + nullify(data%fire_var) + endif + + !--- allocate the various containers needed for rrfssd fire data + call get_nx_ny_from_atm(Atm_block, nx, ny) + allocate(data%fire_name(data%nvar_fire)) + allocate(data%fire_var(nx,ny,24,data%nvar_fire)) + + data%fire_name(1) = 'ebb_smoke_hr' + data%fire_name(2) = 'frp_avg_hr' + data%fire_name(3) = 'frp_std_hr' + + !--- register axis + call register_axis(restart, 'lon', 'X') + call register_axis(restart, 'lat', 'Y') + call register_axis(restart, 't', 24) + !--- register the 3D fields + do num = 1,data%nvar_fire + var3_p2 => data%fire_var(:,:,:,num) + call register_restart_field(restart, data%fire_name(num), var3_p2, & + dimensions=(/'t ', 'lat', 'lon'/), is_optional=.true.) + enddo + + end subroutine rrfs_sd_emissions_register_fire + + ! -------------------------------------------------------------------- + + !>@ Called after register_fire() to copy data from internal arrays to the model grid and deallocate arrays + subroutine rrfs_sd_emissions_copy_fire(data, Sfcprop, Atm_block) + implicit none + class(rrfs_sd_emissions_type) :: data + type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, k, i, j + + !$omp parallel do default(shared) private(i, j, nb, ix, k) + do nb = 1, Atm_block%nblks + !--- 3D variables + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 + j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 + !--- assign hprime(1:10) and hprime(15:24) with new oro stat data + do k = 1, 24 + Sfcprop(nb)%smoke_RRFS(ix,k,1) = data%fire_var(i,j,k,1) + Sfcprop(nb)%smoke_RRFS(ix,k,2) = data%fire_var(i,j,k,2) + Sfcprop(nb)%smoke_RRFS(ix,k,3) = data%fire_var(i,j,k,3) + enddo + enddo + enddo + end subroutine rrfs_sd_emissions_copy_fire + + !>@ Destructor for rrfs_sd_emissions_type + subroutine rrfs_sd_emissions_final(data) + implicit none + type(rrfs_sd_emissions_type) :: data + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(data%var)) then ; \ + deallocate(data%var) ; \ + nullify(data%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(dust12m_name) + IF_ASSOC_DEALLOC_NULL(emi_name) + IF_ASSOC_DEALLOC_NULL(fire_name) + IF_ASSOC_DEALLOC_NULL(dust12m_var) + IF_ASSOC_DEALLOC_NULL(emi_var) + IF_ASSOC_DEALLOC_NULL(fire_var) + + ! Undefine this to avoid cluttering the cpp scope: +#undef IF_ASSOC_DEALLOC_NULL + end subroutine rrfs_sd_emissions_final + +end module fv3atm_rrfs_sd_io + +!> @} diff --git a/io/fv3atm_sfc_io.F90 b/io/fv3atm_sfc_io.F90 new file mode 100644 index 000000000..cff249370 --- /dev/null +++ b/io/fv3atm_sfc_io.F90 @@ -0,0 +1,1625 @@ +!> \file fv3atm_sfc_io.F90 +!! This file contains a derived type and subroutines to read and write restart files for +!! most FV3ATM surface fields. It works both for quilt (via ESMF) and non-quilt (via FMS) +!! restarts. Certain fields are handled by other files: fv3atm_oro_io.F90, fv3atm_rrfs_sd_io.F90, +!! and fv3atm_clm_lake_io.F90. +module fv3atm_sfc_io + + use block_control_mod, only: block_control_type + use fms2_io_mod, only: FmsNetcdfDomainFile_t, unlimited, write_data,& + register_axis, register_restart_field, & + register_variable_attribute, register_field, & + get_global_io_domain_indices, variable_exists + use fv3atm_common_io, only: GFS_Data_transfer, & + create_2d_field_and_add_to_bundle, create_3d_field_and_add_to_bundle + use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys + use mpp_mod, only: mpp_error, NOTE + use physcons, only: con_tice !saltwater freezing temp (K) + + implicit none + private + + public :: Sfc_io_data_type + public :: Sfc_io_fill_2d_names, Sfc_io_fill_3d_names, Sfc_io_allocate_arrays, & + Sfc_io_register_axes, Sfc_io_write_axes, Sfc_io_register_2d_fields, & + Sfc_io_register_3d_fields, Sfc_io_copy_to_grid, Sfc_io_copy_from_grid, & + Sfc_io_apply_safeguards, Sfc_io_transfer, Sfc_io_final + + !> \defgroup fv3atm_sfc_io module + !> @{ + + !>@ Minimum temperature allowed for snow/ice + real(kind=kind_phys), parameter :: timin = 173.0_kind_phys + + real(kind_phys), parameter:: min_lake_orog = 200.0_kind_phys + real(kind_phys), parameter:: zero = 0, one = 1 + + !> Internal data storage type for reading and writing surface restart files + type Sfc_io_data_type + integer, public :: nvar2o = 0 + integer, public :: nvar3 = 0 + integer, public :: nvar2r = 0 + integer, public :: nvar2mp = 0 + integer, public :: nvar3mp = 0 + integer, public :: nvar2l = 0 + integer, public :: nvar2m = 0 + integer, public :: nvar_before_lake = 0 + + ! The lsoil flag is only meaningful when reading:; + logical, public :: is_lsoil = .false. + + ! SYNONYMS: Some nvar variables had two names in fv3atm_io.F90. They have + ! only one name here. The "_s" is redundant because this file only has + ! surface restart variables. + ! + ! - nvar2m = nvar_s2m + ! - nvar2o = nvar_s2o + ! - nvar2r = nvar_s2r + ! - nvar2mp = nvar_s2mp + ! - nvar3mp = nvar_s3mp + + real(kind=kind_phys), pointer, dimension(:,:,:), public :: var2 => null() + real(kind=kind_phys), pointer, dimension(:,:,:), public :: var3ice => null() + real(kind=kind_phys), pointer, dimension(:,:,:,:), public :: var3 => null() + real(kind=kind_phys), pointer, dimension(:,:,:,:), public :: var3sn => null() + real(kind=kind_phys), pointer, dimension(:,:,:,:), public :: var3eq => null() + real(kind=kind_phys), pointer, dimension(:,:,:,:), public :: var3zn => null() + + character(len=32), pointer, dimension(:), public :: name2 => null() + character(len=32), pointer, dimension(:), public :: name3 => null() + + contains + + procedure, public :: allocate_arrays => Sfc_io_allocate_arrays + procedure, public :: register_axes => Sfc_io_register_axes + procedure, public :: write_axes => Sfc_io_write_axes + procedure, public :: register_2d_fields => Sfc_io_register_2d_fields + procedure, public :: register_3d_fields => Sfc_io_register_3d_fields + procedure, public :: bundle_2d_fields => Sfc_io_bundle_2d_fields + procedure, public :: bundle_3d_fields => Sfc_io_bundle_3d_fields + procedure, public :: fill_2d_names => Sfc_io_fill_2d_names + procedure, public :: fill_3d_names => Sfc_io_fill_3d_names + procedure, public :: init_fields => Sfc_io_init_fields + procedure, public :: transfer => Sfc_io_transfer + procedure, public :: copy_to_grid => Sfc_io_copy_to_grid + procedure, public :: copy_from_grid => Sfc_io_copy_from_grid + procedure, public :: apply_safeguards => Sfc_io_apply_safeguards + + procedure, private :: calculate_indices => Sfc_io_calculate_indices + + final :: Sfc_io_final + end type Sfc_io_data_type + +contains + + !>@brief Calculates all nvar indices in the Sfc_io_data_type + !> \section Sfc_io_data_type%calculate_indices() procedure + !! Calculates all nvar counts, which record the number of fields + !! of various types. These determine array sizes. + !! Returns .true. if any nvar counts changed, or .false. otherwise. + function Sfc_io_calculate_indices(sfc, Model, reading, warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + logical :: Sfc_io_calculate_indices + logical, intent(in) :: reading, warm_start + + integer :: nvar2m, nvar2o, nvar3, nvar2r, nvar2mp, nvar3mp, nvar2l + integer :: nvar_before_lake + + nvar2m = 48 + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + nvar2m = nvar2m + 4 + !nvar2m = nvar2m + 5 + endif + if (Model%cplwav) then + nvar2m = nvar2m + 1 + endif + if (Model%nstf_name(1) > 0) then + nvar2o = 18 + else + nvar2o = 0 + endif + if (Model%lsm == Model%lsm_ruc .and. warm_start) then + if (Model%rdlai) then + nvar2r = 13 + else + nvar2r = 12 + endif + nvar3 = 5 + else + if(.not.reading .and. Model%rdlai) then + nvar2r = 1 + else + nvar2r = 0 + endif + nvar3 = 3 + endif + if (Model%lsm == Model%lsm_noahmp) then + nvar2mp = 29 + nvar3mp = 5 + else + nvar2mp = 0 + nvar3mp = 0 + endif + !CLM Lake and Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + nvar2l = 10 + else + nvar2l = 0 + endif + + nvar_before_lake=nvar2m+nvar2o+nvar2r+nvar2mp + + Sfc_io_calculate_indices = & + nvar2m /= sfc%nvar2m .or. & + nvar2o /= sfc%nvar2o .or. & + nvar3 /= sfc%nvar3 .or. & + nvar2r /= sfc%nvar2r .or. & + nvar2mp /= sfc%nvar2mp .or. & + nvar3mp /= sfc%nvar3mp .or. & + nvar2l /= sfc%nvar2l .or. & + nvar2m /= sfc%nvar2m .or. & + nvar_before_lake /= sfc%nvar_before_lake + + sfc%nvar2m = nvar2m + sfc%nvar2o = nvar2o + sfc%nvar3 = nvar3 + sfc%nvar2r = nvar2r + sfc%nvar2mp = nvar2mp + sfc%nvar3mp = nvar3mp + sfc%nvar2l = nvar2l + sfc%nvar2m = nvar2m + sfc%nvar_before_lake = nvar_before_lake + + end function Sfc_io_calculate_indices + + !>@brief Allocates internal Sfc_io_data_type arrays if array sizes should change. + !> \section Sfc_io_data_type%allocate_arrays() procedure + !! Calls calculate_arrays() to determine if any nvar counts have changed, based + !! on the new arguments. If they have changed, then arrays are reallocated. + !! The arrays will need to be filled with new data at that point, as the contents + !! will be unknown. Returns .true. if arrays were reallocated, and .false. otherwise. + function Sfc_io_allocate_arrays(sfc, Model, Atm_block, reading, warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + logical :: Sfc_io_allocate_arrays + logical, intent(in) :: reading, warm_start + + integer :: isc, iec, jsc, jec, npz, nx, ny + + isc = Atm_block%isc + iec = Atm_block%iec + jsc = Atm_block%jsc + jec = Atm_block%jec + npz = Atm_block%npz + nx = (iec - isc + 1) + ny = (jec - jsc + 1) + + Sfc_io_allocate_arrays = sfc%calculate_indices(Model, reading, warm_start) + Sfc_io_allocate_arrays = Sfc_io_allocate_arrays .or. .not. associated(sfc%name2) + + if(Sfc_io_allocate_arrays) then + !--- allocate the various containers needed for restarts + allocate(sfc%name2(sfc%nvar2m+sfc%nvar2o+sfc%nvar2mp+sfc%nvar2r+sfc%nvar2l)) + allocate(sfc%name3(0:sfc%nvar3+sfc%nvar3mp)) + allocate(sfc%var2(nx,ny,sfc%nvar2m+sfc%nvar2o+sfc%nvar2mp+sfc%nvar2r+sfc%nvar2l)) + + ! Note that this may cause problems with RUC LSM for coldstart runs from GFS data + ! if the initial conditions do contain this variable, because Model%kice is 9 for + ! RUC LSM, but tiice in the initial conditions will only have two vertical layers + allocate(sfc%var3ice(nx,ny,Model%kice)) + + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then + allocate(sfc%var3(nx,ny,Model%lsoil,sfc%nvar3)) + elseif (Model%lsm == Model%lsm_ruc) then + allocate(sfc%var3(nx,ny,Model%lsoil_lsm,sfc%nvar3)) + endif + + sfc%var2 = -9999.0_kind_phys + sfc%var3 = -9999.0_kind_phys + sfc%var3ice= -9999.0_kind_phys + + if (Model%lsm == Model%lsm_noahmp) then + allocate(sfc%var3sn(nx,ny,-2:0,4:6)) + allocate(sfc%var3eq(nx,ny,1:4,7:7)) + allocate(sfc%var3zn(nx,ny,-2:4,8:8)) + + sfc%var3sn = -9999.0_kind_phys + sfc%var3eq = -9999.0_kind_phys + sfc%var3zn = -9999.0_kind_phys + endif + endif + + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_flake .and. Model%me==0) then + if(size(sfc%name2)/=sfc%nvar_before_lake+10) then +3814 format("ERROR: size mismatch size(sfc%name2)=",I0," /= nvar_before_lake+10=",I0) + write(0,3814) size(sfc%name2),sfc%nvar_before_lake+10 + endif + endif + end function Sfc_io_allocate_arrays + + !>@ Registers all axes for reading or writing restarts using FMS (non-quilt) + subroutine Sfc_io_register_axes(sfc, Model, Sfc_restart, reading, warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + logical, intent(in) :: reading, warm_start + + if(reading) then + sfc%is_lsoil = .false. + endif + + if(.not.warm_start .and. reading) then + if( variable_exists(Sfc_restart,"lsoil") ) then + if(reading) then + sfc%is_lsoil=.true. + endif + 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) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil) + else if(Model%lsm == Model%lsm_ruc .and. reading) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil_lsm) + ! The RUC only ever writes zaxis_1, which is combined soil/ice + ! vertical dimension, lsoil_lsm/kice, which is 9. Other LSMs read and + ! write zaxis_2, which is lsoil for them, and that's always 4. + ! Defining zaxis_2 here lets RUC LSM read from a different soil + ! vertical coordinate (lsoil_lsm). It is needed for restart of RUC LSM + ! from RUC LSM. This capability exists for historical reasons, because + ! there are two sets of soil state variables: one set has lsoil=4 + ! vertical layers (Noah LSM. NoahMP LSM), and another set has + ! lsoil_lsm=9 vertical levels (RUC LSM). Ideally there should be just + ! one set of soil variables that could have different vertical + ! dimension depending on the choice of LSM. For now: just make sure + ! you only restart RUC LSM off of RUC LSM, and always have kice = + ! lsoil = lsoil_lsm = 9 and everything will be fine. + endif + 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) + endif + end subroutine Sfc_io_register_axes + + !>@ Writes axis index variables and related metadata for all axes when writing FMS (non-quilt) restarts + subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + + integer, allocatable :: buffer(:) + integer :: i, is, ie + logical :: mand + + 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_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_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) then + 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_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_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_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) + end subroutine Sfc_io_write_axes + + !>@ Fills the name3d array with all surface 3D field names. + subroutine Sfc_io_fill_3d_names(sfc,Model,warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + logical, intent(in) :: warm_start + integer :: nt + + !--- names of the 3d variables to save + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) 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 + sfc%name3(0) = 'tiice' + end subroutine Sfc_io_fill_3d_names + + !>@ Fills the name2d array with all surface 2D field names. Updates nvar2m if needed. + subroutine Sfc_io_fill_2d_names(sfc,Model,warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + logical, intent(in) :: warm_start + integer :: nt + + !--- names of the 2D variables to save + nt=0 + nt=nt+1 ; sfc%name2(nt) = 'slmsk' + nt=nt+1 ; sfc%name2(nt) = 'tsea' !tsfc + nt=nt+1 ; sfc%name2(nt) = 'sheleg' !weasd + nt=nt+1 ; sfc%name2(nt) = 'tg3' + nt=nt+1 ; sfc%name2(nt) = 'zorl' + nt=nt+1 ; sfc%name2(nt) = 'alvsf' + nt=nt+1 ; sfc%name2(nt) = 'alvwf' + nt=nt+1 ; sfc%name2(nt) = 'alnsf' + nt=nt+1 ; sfc%name2(nt) = 'alnwf' + nt=nt+1 ; sfc%name2(nt) = 'facsf' + nt=nt+1 ; sfc%name2(nt) = 'facwf' + nt=nt+1 ; sfc%name2(nt) = 'vfrac' + nt=nt+1 ; sfc%name2(nt) = 'canopy' + nt=nt+1 ; sfc%name2(nt) = 'f10m' + nt=nt+1 ; sfc%name2(nt) = 't2m' + nt=nt+1 ; sfc%name2(nt) = 'q2m' + nt=nt+1 ; sfc%name2(nt) = 'vtype' + nt=nt+1 ; sfc%name2(nt) = 'stype' + nt=nt+1 ; sfc%name2(nt) = 'uustar' + nt=nt+1 ; sfc%name2(nt) = 'ffmm' + nt=nt+1 ; sfc%name2(nt) = 'ffhh' + nt=nt+1 ; sfc%name2(nt) = 'hice' + nt=nt+1 ; sfc%name2(nt) = 'fice' + nt=nt+1 ; sfc%name2(nt) = 'tisfc' + nt=nt+1 ; sfc%name2(nt) = 'tprcp' + nt=nt+1 ; sfc%name2(nt) = 'srflag' + nt=nt+1 ; sfc%name2(nt) = 'snwdph' !snowd + nt=nt+1 ; sfc%name2(nt) = 'shdmin' + nt=nt+1 ; sfc%name2(nt) = 'shdmax' + nt=nt+1 ; sfc%name2(nt) = 'slope' + nt=nt+1 ; sfc%name2(nt) = 'snoalb' + !--- variables below here are optional + nt=nt+1 ; sfc%name2(nt) = 'sncovr' + nt=nt+1 ; sfc%name2(nt) = 'snodl' !snowd on land portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'weasdl'!weasd on land portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'tsfc' !tsfc composite + nt=nt+1 ; sfc%name2(nt) = 'tsfcl' !temp on land portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'zorlw' !zorl on water portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'zorll' !zorl on land portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'zorli' !zorl on ice portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'albdirvis_lnd' + nt=nt+1 ; sfc%name2(nt) = 'albdirnir_lnd' + nt=nt+1 ; sfc%name2(nt) = 'albdifvis_lnd' + nt=nt+1 ; sfc%name2(nt) = 'albdifnir_lnd' + nt=nt+1 ; sfc%name2(nt) = 'emis_lnd' + nt=nt+1 ; sfc%name2(nt) = 'emis_ice' + nt=nt+1 ; sfc%name2(nt) = 'sncovr_ice' + nt=nt+1 ; sfc%name2(nt) = 'snodi' ! snowd on ice portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'weasdi'! weasd on ice portion of a cell + + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + nt=nt+1 ; sfc%name2(nt) = 'albdirvis_ice' + nt=nt+1 ; sfc%name2(nt) = 'albdifvis_ice' + nt=nt+1 ; sfc%name2(nt) = 'albdirnir_ice' + nt=nt+1 ; sfc%name2(nt) = 'albdifnir_ice' + endif + + if(Model%cplwav) then + nt=nt+1 ; sfc%name2(nt) = 'zorlwav' !zorl from wave component + sfc%nvar2m = nt + endif + + if (Model%nstf_name(1) > 0) then + !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) + nt=nt+1 ; sfc%name2(nt) = 'tref' + nt=nt+1 ; sfc%name2(nt) = 'z_c' + nt=nt+1 ; sfc%name2(nt) = 'c_0' + nt=nt+1 ; sfc%name2(nt) = 'c_d' + nt=nt+1 ; sfc%name2(nt) = 'w_0' + nt=nt+1 ; sfc%name2(nt) = 'w_d' + nt=nt+1 ; sfc%name2(nt) = 'xt' + nt=nt+1 ; sfc%name2(nt) = 'xs' + nt=nt+1 ; sfc%name2(nt) = 'xu' + nt=nt+1 ; sfc%name2(nt) = 'xv' + nt=nt+1 ; sfc%name2(nt) = 'xz' + nt=nt+1 ; sfc%name2(nt) = 'zm' + nt=nt+1 ; sfc%name2(nt) = 'xtts' + nt=nt+1 ; sfc%name2(nt) = 'xzts' + nt=nt+1 ; sfc%name2(nt) = 'd_conv' + nt=nt+1 ; sfc%name2(nt) = 'ifd' + nt=nt+1 ; sfc%name2(nt) = 'dt_cool' + nt=nt+1 ; sfc%name2(nt) = 'qrain' + endif + ! + ! Only needed when Noah MP LSM is used - 29 2D + ! + if (Model%lsm == Model%lsm_noahmp) then + nt=nt+1 ; sfc%name2(nt) = 'snowxy' + nt=nt+1 ; sfc%name2(nt) = 'tvxy' + nt=nt+1 ; sfc%name2(nt) = 'tgxy' + nt=nt+1 ; sfc%name2(nt) = 'canicexy' + nt=nt+1 ; sfc%name2(nt) = 'canliqxy' + nt=nt+1 ; sfc%name2(nt) = 'eahxy' + nt=nt+1 ; sfc%name2(nt) = 'tahxy' + nt=nt+1 ; sfc%name2(nt) = 'cmxy' + nt=nt+1 ; sfc%name2(nt) = 'chxy' + nt=nt+1 ; sfc%name2(nt) = 'fwetxy' + nt=nt+1 ; sfc%name2(nt) = 'sneqvoxy' + nt=nt+1 ; sfc%name2(nt) = 'alboldxy' + nt=nt+1 ; sfc%name2(nt) = 'qsnowxy' + nt=nt+1 ; sfc%name2(nt) = 'wslakexy' + nt=nt+1 ; sfc%name2(nt) = 'zwtxy' + nt=nt+1 ; sfc%name2(nt) = 'waxy' + nt=nt+1 ; sfc%name2(nt) = 'wtxy' + nt=nt+1 ; sfc%name2(nt) = 'lfmassxy' + nt=nt+1 ; sfc%name2(nt) = 'rtmassxy' + nt=nt+1 ; sfc%name2(nt) = 'stmassxy' + nt=nt+1 ; sfc%name2(nt) = 'woodxy' + nt=nt+1 ; sfc%name2(nt) = 'stblcpxy' + nt=nt+1 ; sfc%name2(nt) = 'fastcpxy' + nt=nt+1 ; sfc%name2(nt) = 'xsaixy' + nt=nt+1 ; sfc%name2(nt) = 'xlaixy' + nt=nt+1 ; sfc%name2(nt) = 'taussxy' + nt=nt+1 ; sfc%name2(nt) = 'smcwtdxy' + nt=nt+1 ; sfc%name2(nt) = 'deeprechxy' + nt=nt+1 ; sfc%name2(nt) = 'rechxy' + else if (Model%lsm == Model%lsm_ruc .and. warm_start) then + nt=nt+1 ; sfc%name2(nt) = 'wetness' + nt=nt+1 ; sfc%name2(nt) = 'clw_surf_land' + nt=nt+1 ; sfc%name2(nt) = 'clw_surf_ice' + nt=nt+1 ; sfc%name2(nt) = 'qwv_surf_land' + nt=nt+1 ; sfc%name2(nt) = 'qwv_surf_ice' + nt=nt+1 ; sfc%name2(nt) = 'tsnow_land' + nt=nt+1 ; sfc%name2(nt) = 'tsnow_ice' + nt=nt+1 ; sfc%name2(nt) = 'snowfall_acc_land' + nt=nt+1 ; sfc%name2(nt) = 'snowfall_acc_ice' + nt=nt+1 ; sfc%name2(nt) = 'sfalb_lnd' + nt=nt+1 ; sfc%name2(nt) = 'sfalb_lnd_bck' + nt=nt+1 ; sfc%name2(nt) = 'sfalb_ice' + if (Model%rdlai) then + nt=nt+1 ; sfc%name2(nt) = 'lai' + endif + else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then + nt=nt+1 ; sfc%name2(nt) = 'lai' + endif + + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + nt=nt+1 ; sfc%name2(nt) = 'T_snow' + nt=nt+1 ; sfc%name2(nt) = 'T_ice' + nt=nt+1 ; sfc%name2(nt) = 'h_ML' + nt=nt+1 ; sfc%name2(nt) = 't_ML' + nt=nt+1 ; sfc%name2(nt) = 't_mnw' + nt=nt+1 ; sfc%name2(nt) = 'h_talb' + nt=nt+1 ; sfc%name2(nt) = 't_talb' + nt=nt+1 ; sfc%name2(nt) = 't_bot1' + nt=nt+1 ; sfc%name2(nt) = 't_bot2' + nt=nt+1 ; sfc%name2(nt) = 'c_t' + endif + end subroutine Sfc_io_fill_2d_names + + !>@ Registers 2D fields with FMS for reading or writing non-quilt restart files + subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + logical, intent(in) :: reading, warm_start + + real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() + real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() + 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() + integer :: num + logical :: mand + + character(len=7) :: time2d(3) + + if(.not.reading) then + time2d=(/'xaxis_1','yaxis_1','Time '/) + else + time2d=(/'Time ','yaxis_1','xaxis_1'/) + endif + + !--- register the 2D fields + do num = 1,sfc%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)) == 'snodi' .or. trim(sfc%name2(num)) == 'weasdi' & + .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' .or. trim(sfc%name2(num)) == 'emis_ice' & + .or. trim(sfc%name2(num)) == 'sncovr_ice') then + if(reading .and. sfc%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=time2d,& + &is_optional=.true.) + end if + else + if(reading .and. sfc%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=time2d) + end if + endif + enddo + + if (Model%nstf_name(1) > 0) then + mand = .false. + if (Model%nstf_name(2) == 0) mand = .true. + do num = sfc%nvar2m+1,sfc%nvar2m+sfc%nvar2o + var2_p => sfc%var2(:,:,num) + if(sfc%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=time2d, is_optional=.not.mand) + endif + enddo + endif + + if (Model%lsm == Model%lsm_ruc) then ! sfc%nvar2mp = 0 + do num = sfc%nvar2m+sfc%nvar2o+1, sfc%nvar2m+sfc%nvar2o+sfc%nvar2r + var2_p => sfc%var2(:,:,num) + if(sfc%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=time2d) + end if + enddo + endif ! mp/ruc + + ! Noah MP register only necessary only lsm = 2, not necessary has values + if ( (.not.reading .and. Model%lsm == Model%lsm_noahmp) & + .or. (reading .and. sfc%nvar2mp > 0) ) then + mand = .not.reading + do num = sfc%nvar2m+sfc%nvar2o+1,sfc%nvar2m+sfc%nvar2o+sfc%nvar2mp + var2_p => sfc%var2(:,:,num) + if(sfc%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=time2d, is_optional=.not.mand) + end if + enddo + endif ! noahmp + + ! Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + mand = .not.reading + do num = sfc%nvar_before_lake+1,sfc%nvar_before_lake+sfc%nvar2l + var2_p => sfc%var2(:,:,num) + if(sfc%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=time2d, is_optional=.not.mand) + endif + enddo + endif + + end subroutine Sfc_io_register_2d_fields + + !>@ Registers 3D fields with FMS for reading or writing non-quilt restart files + subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + logical, intent(in) :: reading, warm_start + + real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() + 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() + real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_fr => NULL() + integer :: num + logical :: mand + + character(len=7), parameter :: xyz1_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_1', 'Time '/) + character(len=7), parameter :: xyz2_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_2', 'Time '/) + character(len=7), parameter :: xyz3_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/) + character(len=7), parameter :: xyz4_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_4', 'Time '/) + + !--- register the 3D fields + var3_p => sfc%var3ice(:,:,:) + call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, is_optional=.true.) + + if(reading) then + do num = 1,sfc%nvar3 + 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(sfc%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=xyz2_time,& + &is_optional=.true.) + end if + end if + enddo + elseif(Model%lsm == Model%lsm_ruc) then + do num = 1,sfc%nvar3 + var3_p => sfc%var3(:,:,:,num) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz1_time) + enddo + nullify(var3_p) + else ! writing something other than ruc + do num = 1,sfc%nvar3 + var3_p => sfc%var3(:,:,:,num) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz2_time) + enddo + nullify(var3_p) + endif + + if (Model%lsm == Model%lsm_noahmp) then + mand = .not.reading + do num = sfc%nvar3+1,sfc%nvar3+3 + var3_p1 => sfc%var3sn(:,:,:,num) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p1, dimensions=xyz3_time, is_optional=.not.mand) + enddo + + var3_p2 => sfc%var3eq(:,:,:,7) + call register_restart_field(Sfc_restart, sfc%name3(7), var3_p2, dimensions=xyz2_time, is_optional=.not.mand) + + var3_p3 => sfc%var3zn(:,:,:,8) + call register_restart_field(Sfc_restart, sfc%name3(8), var3_p3, dimensions=xyz4_time, is_optional=.not.mand) + endif !mp + + end subroutine Sfc_io_register_3d_fields + + !>@ Initializes some surface fields with reasonable defaults + subroutine Sfc_io_init_fields(sfc,Model) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + + !--- Noah MP define arbitrary value (number layers of snow) to indicate + !coldstart(sfcfile doesn't include noah mp fields) or not + + if (Model%lsm == Model%lsm_noahmp) then + sfc%var2(1,1,sfc%nvar2m+19) = -66666.0_kind_phys + endif + end subroutine Sfc_io_init_fields + + !>@ Copies data to the model grid (reading=true) or from the model grid (reading=false) + !> \section Sfc_io_data_type%transfer + !! Called to transfer data between the model grid and Sfc_io_data_type temporary arrays. + !! The FMS and ESMF restarts use the temporary arrays, not the model grid arrays. This + !! transfer routine copies to the model grid if reading=.true. or from the model grid + !! if reading=.false. This is mostly loops around GFS_data_transfer() interface calls. + !! + !! In addition, if override_frac_grid is provided, it will be set to Model%frac_grid. + subroutine Sfc_io_transfer(sfc, reading, Model, Atm_block, Sfcprop, warm_start, override_frac_grid) + !--- interface variable definitions + implicit none + + class(Sfc_io_data_type) :: sfc + logical, intent(in) :: reading + type(GFS_sfcprop_type) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + logical, intent(in) :: warm_start + logical, intent(out), optional :: override_frac_grid + + integer :: i, j, k, nb, ix, lsoil, num, nt + integer :: isc, iec, jsc, jec, npz, nx, ny + integer, allocatable :: ii1(:), jj1(:) + real(kind_phys) :: ice + + ! "To" variable: + ! to=.TRUE. means transfer sfc data TO Sfcprop grid + ! to=.FALSE. means transfer into sfc data FROM Sfcprop grid + + isc = Atm_block%isc + iec = Atm_block%iec + jsc = Atm_block%jsc + jec = Atm_block%jec + npz = Atm_block%npz + nx = (iec - isc + 1) + ny = (jec - jsc + 1) + + ! 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)) + ! write(0,*)' sfc_var2=',sfc_var2(:,:,12) + + !$omp parallel do default(shared) private(i, j, nb, ix, nt, ii1, jj1, lsoil) + block_loop: do nb = 1, Atm_block%nblks + allocate(ii1(Atm_block%blksz(nb))) + allocate(jj1(Atm_block%blksz(nb))) + ii1=Atm_block%index(nb)%ii - isc + 1 + jj1=Atm_block%index(nb)%jj - jsc + 1 + + nt=0 + + !--- 2D variables + ! ------------ + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%slmsk) !--- slmsk + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tsfco) !--- tsfc (tsea in sfc file) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%weasd) !--- weasd (sheleg in sfc file) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tg3) !--- tg3 + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%zorl) !--- zorl composite + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%alvsf) !--- alvsf + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%alvwf) !--- alvwf + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%alnsf) !--- alnsf + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%alnwf) !--- alnwf + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%facsf) !--- facsf + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%facwf) !--- facwf + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%vfrac) !--- vfrac + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%canopy) !--- canopy + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%f10m) !--- f10m + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%t2m) !--- t2m + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%q2m) !--- q2m + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%vtype) !--- vtype + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%stype) !--- stype + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%uustar) !--- uustar + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%ffmm) !--- ffmm + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%ffhh) !--- ffhh + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%hice) !--- hice + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%fice) !--- fice + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tisfc) !--- tisfc + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tprcp) !--- tprcp + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%srflag) !--- srflag + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snowd) !--- snowd (snwdph in the file) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%shdmin) !--- shdmin + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%shdmax) !--- shdmax + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%slope) !--- slope + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snoalb) !--- snoalb + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sncovr) !--- sncovr + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snodl) !--- snodl (snowd on land portion of a cell) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%weasdl) !--- weasdl (weasd on land portion of a cell) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tsfc) !--- tsfc composite + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tsfcl) !--- tsfcl (temp on land portion of a cell) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%zorlw) !--- zorlw (zorl on water portion of a cell) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%zorll) !--- zorll (zorl on land portion of a cell) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%zorli) !--- zorli (zorl on ice portion of a cell) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdirvis_lnd) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdirnir_lnd) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdifvis_lnd) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdifnir_lnd) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%emis_lnd) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%emis_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sncovr_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snodi) !--- snodi (snowd on ice portion of a cell) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%weasdi) !--- weasdi (weasd on ice portion of a cell) + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdirvis_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdifvis_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdirnir_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%albdifnir_ice) + ! call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sfalb_ice) + endif + if(Model%cplwav) then + !tgs - the following line is a bug. It should be nt = nt + !nt = sfc%nvar2m-1 ! Next item will be at sfc%nvar2m + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%zorlwav) !--- (zorl from wave model) + else if(reading) then + Sfcprop(nb)%zorlwav = Sfcprop(nb)%zorlw + endif + + if(present(override_frac_grid)) then + override_frac_grid=Model%frac_grid + endif + + if(reading) then + do_lsi_fractions: do ix = 1, Atm_block%blksz(nb) + 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 + Sfcprop(nb)%lakefrac(ix) = one + endif + endif + + if_frac_grid: if (Model%frac_grid) then + if (Sfcprop(nb)%landfrac(ix) > -999.0_kind_phys) then + Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) + 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 + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 + endif + endif + else + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 + endif + endif + endif + else + if(present(override_frac_grid)) then + override_frac_grid = .false. + endif + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + if (Sfcprop(nb)%slmsk(ix) < 0.1_kind_phys .or. Sfcprop(nb)%slmsk(ix) > 1.9_kind_phys) then + Sfcprop(nb)%landfrac(ix) = zero + if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = zero + else ! ocean + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one + endif + endif + endif + endif + else ! not a fractional grid + if (Sfcprop(nb)%landfrac(ix) > -999.0_kind_phys) then + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%slmsk(ix) = zero + 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. Sfcprop(nb)%stype(ix) == 14) & + Sfcprop(nb)%slmsk(ix) = zero + if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then + Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + else + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + endif + endif + else + if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & + .and. Sfcprop(nb)%stype(ix) /= 14) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + Sfcprop(nb)%slmsk(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = zero + if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + else ! ocean + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one + if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + endif + endif + endif + endif if_frac_grid + enddo do_lsi_fractions + endif + + if (reading .and. warm_start .and. Model%kdt > 1) then + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%slmsk(ix) = sfc%var2(ii1(ix),jj1(ix),1) !--- slmsk + enddo + endif + + ! + !--- NSSTM variables + !tgs - the following line is a bug that will show if(Model%cplwav) = true + !nt = sfc%nvar2m + if (Model%nstf_name(1) > 0) then + if (reading .and. Model%nstf_name(2) == 1) then ! nsst spinup + !--- nsstm tref + nt = nt + 18 + Sfcprop(nb)%tref = Sfcprop(nb)%tsfco + Sfcprop(nb)%z_c = zero + Sfcprop(nb)%c_0 = zero + Sfcprop(nb)%c_d = zero + Sfcprop(nb)%w_0 = zero + Sfcprop(nb)%w_d = zero + Sfcprop(nb)%xt = zero + Sfcprop(nb)%xs = zero + Sfcprop(nb)%xu = zero + Sfcprop(nb)%xv = zero + Sfcprop(nb)%xz = 20.0_kind_phys + Sfcprop(nb)%zm = zero + Sfcprop(nb)%xtts = zero + Sfcprop(nb)%xzts = zero + Sfcprop(nb)%d_conv = zero + Sfcprop(nb)%ifd = zero + Sfcprop(nb)%dt_cool = zero + Sfcprop(nb)%qrain = zero + elseif (.not.reading .or. Model%nstf_name(2) == 0) then ! nsst restart + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tref) !--- nsstm tref + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%z_c) !--- nsstm z_c + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%c_0) !--- nsstm c_0 + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%c_d) !--- nsstm c_d + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%w_0) !--- nsstm w_0 + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%w_d) !--- nsstm w_d + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xt) !--- nsstm xt + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xs) !--- nsstm xs + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xu) !--- nsstm xu + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xv) !--- nsstm xv + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xz) !--- nsstm xz + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%zm) !--- nsstm zm + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xtts) !--- nsstm xtts + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xzts) !--- nsstm xzts + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%d_conv) !--- nsstm d_conv + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%ifd) !--- nsstm ifd + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%dt_cool) !--- nsstm dt_cool + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%qrain) !--- nsstm qrain + endif + endif + + if (Model%lsm == Model%lsm_ruc .and. (warm_start .or. .not. reading)) then + !--- Extra RUC variables + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%wetness) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%clw_surf_land) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%clw_surf_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%qwv_surf_land) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%qwv_surf_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tsnow_land) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tsnow_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snowfallac_land) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snowfallac_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sfalb_lnd) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sfalb_lnd_bck) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sfalb_ice) + if (Model%rdlai) then + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xlaixy) + endif + else if (reading .and. Model%lsm == Model%lsm_ruc) then + ! Initialize RUC snow cover on ice from snow cover + Sfcprop(nb)%sncovr_ice = Sfcprop(nb)%sncovr + if (Model%rdlai) then + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xlaixy) + end if + elseif (Model%lsm == Model%lsm_noahmp) then + !--- Extra Noah MP variables + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snowxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tvxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tgxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%canicexy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%canliqxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%eahxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%tahxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%cmxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%chxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%fwetxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sneqvoxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%alboldxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%qsnowxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%wslakexy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%zwtxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%waxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%wtxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%lfmassxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%rtmassxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%stmassxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%woodxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%stblcpxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%fastcpxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xsaixy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%xlaixy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%taussxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%smcwtdxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%deeprechxy) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%rechxy) + endif + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%T_snow) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%T_ice) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%h_ML) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%t_ML) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%t_mnw) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%h_talb) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%t_talb) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%t_bot1) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%t_bot2) + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%c_t) + endif + if(.not.reading) then + do k = 1,Model%kice + do ix = 1, Atm_block%blksz(nb) + ice=Sfcprop(nb)%tiice(ix,k) + if(ice@ Copies from Sfc_io_data_type internal arrays to the model grid by calling transfer() with reading=.true. + subroutine Sfc_io_copy_to_grid(sfc, Model, Atm_block, Sfcprop, warm_start, override_frac_grid) + !--- interface variable definitions + implicit none + + class(Sfc_io_data_type) :: sfc + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + logical, intent(in) :: warm_start + logical, intent(out), optional :: override_frac_grid + + call sfc%transfer(.true.,Model, Atm_block, Sfcprop, warm_start, override_frac_grid) + + end subroutine Sfc_io_copy_to_grid + + !>@ Copies from the model grid to Sfc_io_data_type internal arrays by calling transfer() with reading=.false. + subroutine Sfc_io_copy_from_grid(sfc, Model, Atm_block, Sfcprop) + !--- interface variable definitions + implicit none + + class(Sfc_io_data_type) :: sfc + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + + call sfc%transfer(.false., Model, Atm_block, Sfcprop, warm_start=.false.) + + end subroutine Sfc_io_copy_from_grid + + !>@ Calculates values and applies safeguards after reading restart data. + subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) + !--- interface variable definitions + implicit none + + class(Sfc_io_data_type) :: sfc + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(block_control_type), intent(in) :: Atm_block + type(GFS_control_type), intent(in) :: Model + + integer :: i, j, k, nb, ix, lsoil, num, nt + integer :: isc, iec, jsc, jec, npz, nx, ny + real(kind_phys) :: ice, tem, tem1 + + isc = Atm_block%isc + iec = Atm_block%iec + jsc = Atm_block%jsc + jec = Atm_block%jec + npz = Atm_block%npz + nx = (iec - isc + 1) + ny = (jec - jsc + 1) + + ! so far: At cold start everything is 9999.0, warm start snowxy has values + ! but the 3D of snow fields are not available because not allocated yet. + ! ix,nb loops may be consolidate with the Noah MP isnowxy init + ! restore traditional vars first,we need some of them to init snow fields + ! snow depth to actual snow layers; so we can allocate and register + ! note zsnsoxy is from -2:4 - isnowxy is from 0:-2, but we need + ! exact snow layers to pass 3D fields correctly, snow layers are + ! different fro grid to grid, we have to init point by point/grid. + ! It has to be done after the weasd is available + ! sfc%var2(1,1,32) is the first; we need this to allocate snow related fields + + i = Atm_block%index(1)%ii(1) - isc + 1 + j = Atm_block%index(1)%jj(1) - jsc + 1 + + if (sfc%var2(i,j,33) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodl') + !$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%landfrac(ix) > zero) then + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) + Sfcprop(nb)%snodl(ix) = Sfcprop(nb)%snowd(ix) * tem + else + Sfcprop(nb)%snodl(ix) = zero + endif + enddo + enddo + endif + + if (sfc%var2(i,j,34) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasdl') + !$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%landfrac(ix) > zero) then + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) + Sfcprop(nb)%weasdl(ix) = Sfcprop(nb)%weasd(ix) * tem + else + Sfcprop(nb)%weasdl(ix) = zero + endif + enddo + enddo + endif + + if (sfc%var2(i,j,36) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) !--- compute tsfcl from existing variables + enddo + enddo + endif + + if (sfc%var2(i,j,37) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlw') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%landfrac(ix) < one .and. Sfcprop(nb)%fice(ix) < one) then + Sfcprop(nb)%zorlw(ix) = min(Sfcprop(nb)%zorl(ix), 0.317) + endif + enddo + enddo + endif + + if (sfc%var2(i,j,38) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorll') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorl(ix) !--- compute zorll from existing variables + enddo + enddo + endif + + if (sfc%var2(i,j,39) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix)) > zero) then + Sfcprop(nb)%zorli(ix) = one + endif + enddo + enddo + endif + + if (sfc%var2(i,j,45) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing emis_ice') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%emis_ice(ix) = 0.96 + enddo + enddo + endif + + if (sfc%var2(i,j,46) < -9990.0_kind_phys .and. Model%lsm /= Model%lsm_ruc) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr_ice') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + ! Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) + Sfcprop(nb)%sncovr_ice(ix) = zero + enddo + enddo + endif + + if (sfc%var2(i,j,47) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodi') + !$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > zero) then + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) + Sfcprop(nb)%snodi(ix) = min(Sfcprop(nb)%snowd(ix) * tem, 3.0) + else + Sfcprop(nb)%snodi(ix) = zero + endif + enddo + enddo + endif + + if (sfc%var2(i,j,48) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasdi') + !$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > zero) then + tem = one / (Sfcprop(nb)%fice(ix)*(one-Sfcprop(nb)%landfrac(ix))+Sfcprop(nb)%landfrac(ix)) + Sfcprop(nb)%weasdi(ix) = Sfcprop(nb)%weasd(ix)*tem + else + Sfcprop(nb)%weasdi(ix) = zero + endif + enddo + enddo + endif + + if (Model%use_cice_alb) then + if (sfc%var2(i,j,49) < -9990.0_kind_phys) then + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%oceanfrac(ix) > zero .and. & + Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%albdirvis_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdifvis_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdirnir_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdifnir_ice(ix) = 0.6_kind_phys + endif + enddo + enddo + endif + + endif + + ! Fill in composite tsfc for coldstart runs - must happen after tsfcl is computed + compute_tsfc_for_colstart: if (sfc%var2(i,j,35) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing composite tsfc') + if(Model%frac_grid) then ! 3-way composite + !$omp parallel do default(shared) private(nb, ix, tem, tem1) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) ! this may break restart reproducibility + tem1 = one - Sfcprop(nb)%landfrac(ix) + tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & + + Sfcprop(nb)%tisfc(ix) * tem & + + Sfcprop(nb)%tsfco(ix) * (tem1-tem) + enddo + enddo + else + !$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%slmsk(ix) == 1) then + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + else + tem = one - Sfcprop(nb)%fice(ix) + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%tsfco(ix) * tem + endif + enddo + enddo + endif + endif compute_tsfc_for_colstart + + if (sfc%var2(i,j,sfc%nvar2m) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlwav') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorl(ix) !--- compute zorlwav from existing variables + enddo + enddo + endif + + if (nint(sfc%var3ice(1,1,1)) == -9999) then !--- initialize internal ice temp from layer 1 and 2 soil temp + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%tiice(ix,1) = max(timin, min(con_tice, Sfcprop(nb)%stc(ix,1))) + Sfcprop(nb)%tiice(ix,2) = max(timin, min(con_tice, Sfcprop(nb)%stc(ix,2))) + enddo + enddo + endif + + end subroutine Sfc_io_apply_safeguards + + !>@ destructor for Sfc_io_data_type + subroutine Sfc_io_final(sfc) + implicit none + type(Sfc_io_data_type) :: sfc + + sfc%nvar2m=0 + sfc%nvar2o=0 + sfc%nvar2l=0 + sfc%nvar3=0 + sfc%nvar2r=0 + sfc%nvar2mp=0 + sfc%nvar3mp=0 + sfc%nvar2m=0 + sfc%nvar_before_lake=0 + sfc%is_lsoil=.false. + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(sfc%var)) then ; \ + deallocate(sfc%var) ; \ + nullify(sfc%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(var2) + IF_ASSOC_DEALLOC_NULL(var3ice) + IF_ASSOC_DEALLOC_NULL(var3) + IF_ASSOC_DEALLOC_NULL(var3sn) + IF_ASSOC_DEALLOC_NULL(var3eq) + IF_ASSOC_DEALLOC_NULL(var3zn) + IF_ASSOC_DEALLOC_NULL(name2) + IF_ASSOC_DEALLOC_NULL(name3) + +#undef IF_ASSOC_DEALLOC_NULL + + end subroutine Sfc_io_final + + !>@ Creates ESMF bundles for 2D fields, for writing surface restart files using the write component (quilt) + subroutine Sfc_io_bundle_2d_fields(sfc, bundle, grid, Model, outputfile) + use esmf + use GFS_typedefs, only: GFS_control_type + implicit none + class(Sfc_io_data_type) :: sfc + type(ESMF_FieldBundle),intent(inout) :: bundle + type(ESMF_Grid),intent(inout) :: grid + type(GFS_control_type), intent(in) :: Model + character(*), intent(in) :: outputfile + + real(kind_phys),dimension(:,:),pointer :: temp_r2d + integer :: num + + if (.not. associated(sfc%var2)) then + write(0,*)'ERROR sfc%var2, NOT associated' + return + endif + if (.not. associated(sfc%name2)) then + write(0,*)'ERROR sfc%name2 NOT associated' + return + endif + + do num = 1,sfc%nvar2m + temp_r2d => sfc%var2(:,:,num) + call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc%name2(num)), outputfile, grid, bundle) + enddo + + if (Model%nstf_name(1) > 0) then + do num = sfc%nvar2m+1,sfc%nvar2m+sfc%nvar2o + temp_r2d => sfc%var2(:,:,num) + call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc%name2(num)), outputfile, grid, bundle) + enddo + endif + + if (Model%lsm == Model%lsm_ruc) then ! sfc%nvar2mp =0 + do num = sfc%nvar2m+sfc%nvar2o+1, sfc%nvar2m+sfc%nvar2o+sfc%nvar2r + temp_r2d => sfc%var2(:,:,num) + call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc%name2(num)), outputfile, grid, bundle) + enddo + else if (Model%lsm == Model%lsm_noahmp) then ! sfc%nvar2r =0 + do num = sfc%nvar2m+sfc%nvar2o+1,sfc%nvar2m+sfc%nvar2o+sfc%nvar2mp + temp_r2d => sfc%var2(:,:,num) + call create_2d_field_and_add_to_bundle(temp_r2d, trim(sfc%name2(num)), outputfile, grid, bundle) + enddo + endif + end subroutine Sfc_io_bundle_2d_fields + + !>@ Creates ESMF bundles for 3D fields, for writing surface restart files using the write component (quilt) + subroutine Sfc_io_bundle_3d_fields(sfc, bundle, grid, Model, outputfile) + use esmf + use GFS_typedefs, only: GFS_control_type + implicit none + class(Sfc_io_data_type) :: sfc + type(ESMF_FieldBundle),intent(inout) :: bundle + type(ESMF_Grid),intent(inout) :: grid + type(GFS_control_type), intent(in) :: Model + character(*), intent(in) :: outputfile + + real(kind_phys),dimension(:,:,:),pointer :: temp_r3d + integer :: num, i + real(kind_phys), dimension(:), allocatable :: zaxis_1, zaxis_2, zaxis_3, zaxis_4 + + allocate(zaxis_1(Model%kice)) + zaxis_1 = (/ (i, i=1,Model%kice) /) + + temp_r3d => sfc%var3ice(:,:,:) + call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc%name3(0)), "zaxis_1", zaxis_1, trim(outputfile), grid, bundle) + + if(Model%lsm == Model%lsm_ruc) then + do num = 1,sfc%nvar3 + temp_r3d => sfc%var3(:,:,:,num) + call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc%name3(num)), "zaxis_1", zaxis_1, trim(outputfile), grid, bundle) + enddo + else + allocate(zaxis_2(Model%lsoil)) + zaxis_2 = (/ (i, i=1,Model%lsoil) /) + do num = 1,sfc%nvar3 + temp_r3d => sfc%var3(:,:,:,num) + call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc%name3(num)), "zaxis_2", zaxis_2, trim(outputfile), grid, bundle) + enddo + deallocate(zaxis_2) + endif + + if (Model%lsm == Model%lsm_noahmp) then + allocate(zaxis_3(3)) + zaxis_3 = (/ (i, i=1,3) /) + + do num = sfc%nvar3+1,sfc%nvar3+3 + temp_r3d => sfc%var3sn(:,:,:,num) + call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc%name3(num)), "zaxis_3", zaxis_3, trim(outputfile), grid, bundle) + enddo + + allocate(zaxis_2(Model%lsoil)) + zaxis_2 = (/ (i, i=1,Model%lsoil) /) + + temp_r3d => sfc%var3eq(:,:,:,7) + call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc%name3(7)), "zaxis_2", zaxis_2, trim(outputfile), grid, bundle) + + allocate(zaxis_4(7)) + zaxis_4 = (/ (i, i=1,7) /) + + temp_r3d => sfc%var3zn(:,:,:,8) + call create_3d_field_and_add_to_bundle(temp_r3d, trim(sfc%name3(8)), "zaxis_4", zaxis_4, trim(outputfile), grid, bundle) + endif ! lsm = lsm_noahmp + + if(allocated(zaxis_1)) deallocate(zaxis_1) + if(allocated(zaxis_2)) deallocate(zaxis_2) + if(allocated(zaxis_3)) deallocate(zaxis_3) + if(allocated(zaxis_4)) deallocate(zaxis_4) + + end subroutine Sfc_io_bundle_3d_fields +end module fv3atm_sfc_io +!> @} diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 94e568073..3cd17002f 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -2024,7 +2024,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (mype == lead_write_task) then !** write out inline post log file open(newunit=nolog,file='log.atm.inlinepost.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3gfs fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) close(nolog) endif if (lprnt) then @@ -2327,7 +2327,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (out_phase == 1 .and. mype == lead_write_task) then !** write out log file open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3gfs fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) close(nolog) endif enddo two_phase_loop diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 3897ff43c..6557f76f8 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -55,8 +55,8 @@ module module_fcst_grid_comp use data_override_mod, only: data_override_init use fv_nggps_diags_mod, only: fv_dyn_bundle_setup - use fv3gfs_io_mod, only: fv_phys_bundle_setup - use fv3gfs_restart_io_mod, only: fv_phy_restart_bundle_setup, fv_sfc_restart_bundle_setup + use fv3atm_history_io_mod, only: fv_phys_bundle_setup + use fv3atm_restart_io_mod, only: fv_phy_restart_bundle_setup, fv_sfc_restart_bundle_setup use fv_ufs_restart_io_mod, only: fv_core_restart_bundle_setup, & fv_srf_wnd_restart_bundle_setup, & fv_tracer_restart_bundle_setup diff --git a/moving_nest/fv_moving_nest_physics.F90 b/moving_nest/fv_moving_nest_physics.F90 index 2dc6bce5b..1219617a6 100644 --- a/moving_nest/fv_moving_nest_physics.F90 +++ b/moving_nest/fv_moving_nest_physics.F90 @@ -177,7 +177,7 @@ subroutine mn_phys_reset_sfc_props(Atm, n, mn_static, Atm_block, IPD_data, ioffs IPD_data(nb)%Sfcprop%tg3(ix) = mn_static%deep_soil_temp_grid(i_idx, j_idx) - ! Follow logic from FV3/io/FV3GFS_io.F90 line 1187 + ! Follow logic from FV3/io/fv3atm_sfc_io.F90 ! TODO this will need to be more complicated if we support frac_grid !if (nint(mn_static%soil_type_grid(i_idx, j_idx)) == 14 .or. int(mn_static%soil_type_grid(i_idx, j_idx)+0.5) <= 0) then !if (nint(mn_static%soil_type_grid(i_idx, j_idx)) == 14 .or. From 2363f5bcc2eca7be8a637c39a675c9213dc4562a Mon Sep 17 00:00:00 2001 From: haiqinli <38666296+haiqinli@users.noreply.github.com> Date: Mon, 26 Jun 2023 13:21:27 -0600 Subject: [PATCH 03/48] Community Convective Cloud (C3) scheme (#657) * "for the Community Convective Cloud (c3) scheme" * "add a new SDF of FV3_HRRR_c3" --- ccpp/config/ccpp_prebuild_config.py | 6 +- ccpp/data/GFS_typedefs.F90 | 48 ++++++---- ccpp/data/GFS_typedefs.meta | 50 +++++++---- ccpp/driver/GFS_restart.F90 | 8 +- ccpp/physics | 2 +- ...ml => suite_FV3_GFS_v17_coupled_p8_c3.xml} | 8 +- ...nified.xml => suite_FV3_GFS_v17_p8_c3.xml} | 8 +- ccpp/suites/suite_FV3_HRRR_c3.xml | 88 +++++++++++++++++++ 8 files changed, 171 insertions(+), 47 deletions(-) rename ccpp/suites/{suite_FV3_GFS_v17_coupled_p8_unified.xml => suite_FV3_GFS_v17_coupled_p8_c3.xml} (94%) rename ccpp/suites/{suite_FV3_GFS_v17_p8_unified.xml => suite_FV3_GFS_v17_p8_c3.xml} (94%) create mode 100644 ccpp/suites/suite_FV3_HRRR_c3.xml diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index aaf540bcc..c57fd56b2 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -144,9 +144,9 @@ 'physics/physics/cu_gf_driver_pre.F90', 'physics/physics/cu_gf_driver.F90', 'physics/physics/cu_gf_driver_post.F90', - 'physics/physics/cu_unified_driver_pre.F90', - 'physics/physics/cu_unified_driver.F90', - 'physics/physics/cu_unified_driver_post.F90', + 'physics/physics/cu_c3_driver_pre.F90', + 'physics/physics/cu_c3_driver.F90', + 'physics/physics/cu_c3_driver_post.F90', 'physics/physics/hedmf.f', 'physics/physics/moninshoc.f', 'physics/physics/satmedmfvdif.F', diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d831942f2..d964a8bf0 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1146,7 +1146,7 @@ module GFS_typedefs integer :: imfshalcnv_samf = 2 !< flag for SAMF scale- & aerosol-aware mass-flux shallow convection scheme integer :: imfshalcnv_gf = 3 !< flag for scale- & aerosol-aware Grell-Freitas scheme (GSD) integer :: imfshalcnv_ntiedtke = 4 !< flag for new Tiedtke scheme (CAPS) - integer :: imfshalcnv_unified = 5 !< flag for the unified convection scheme + integer :: imfshalcnv_c3 = 5 !< flag for the Community Convective Cloud (C3) scheme logical :: hwrf_samfdeep !< flag for HWRF SAMF deepcnv scheme (HWRF) logical :: progsigma !< flag for prognostic area fraction in samf ddepcnv scheme (GFS) integer :: imfdeepcnv !< flag for mass-flux deep convection scheme @@ -1160,13 +1160,16 @@ module GFS_typedefs integer :: imfdeepcnv_samf = 2 !< flag for SAMF scale- & aerosol-aware mass-flux deep convection scheme integer :: imfdeepcnv_gf = 3 !< flag for scale- & aerosol-aware Grell-Freitas scheme (GSD) integer :: imfdeepcnv_ntiedtke = 4 !< flag for new Tiedtke scheme (CAPS) - integer :: imfdeepcnv_unified = 5 !< flag for the unified convection scheme + integer :: imfdeepcnv_c3 = 5 !< flag for the Community Convective Cloud (C3) scheme logical :: hwrf_samfshal !< flag for HWRF SAMF shalcnv scheme (HWRF) integer :: isatmedmf !< flag for scale-aware TKE-based moist edmf scheme !< 0: initial version of satmedmf (Nov. 2018) !< 1: updated version of satmedmf (as of May 2019) integer :: isatmedmf_vdif = 0 !< flag for initial version of satmedmf (Nov. 2018) integer :: isatmedmf_vdifq = 1 !< flag for updated version of satmedmf (as of May 2019) + integer :: ichoice = 0 !< flag for closure of C3/GF deep convection + integer :: ichoicem = 13!< flag for closure of C3/GF mid convection + integer :: ichoice_s = 3 !< flag for closure of C3/GF shallow convection integer :: nmtvr !< number of topographic variables such as variance etc !< used in the GWD parameterization - 10 more added if @@ -2686,7 +2689,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%cqs2 = clear_val Sfcprop%lh = clear_val end if - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) then allocate (Sfcprop%maxupmf(IM)) allocate (Sfcprop%conv_act(IM)) allocate (Sfcprop%conv_act_m(IM)) @@ -3138,7 +3141,7 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%rrfs_hwp = clear_val endif - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) then allocate (Coupling%qci_conv (IM,Model%levs)) Coupling%qci_conv = clear_val endif @@ -3802,6 +3805,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: spp_gwd = 0 logical :: do_spp = .false. + integer :: ichoice = 0 !< flag for closure of C3/GF deep convection + integer :: ichoicem = 13!< flag for closure of C3/GF mid convection + integer :: ichoice_s = 3 !< flag for closure of C3/GF shallow convection + !-- chem nml variables for RRFS-SD real(kind=kind_phys) :: dust_alpha = 0. real(kind=kind_phys) :: dust_gamma = 0. @@ -3974,6 +3981,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & wetdep_ls_opt, smoke_forecast, aero_ind_fdb, aero_dir_fdb, & rrfs_smoke_debug, do_plumerise, plumerisefire_frq, & addsmoke_flag, enh_mix, mix_chem, smoke_dir_fdb_coef, & + !--- C3/GF closures + ichoice,ichoicem,ichoice_s, & !--- (DFI) time ranges with radar-prescribed microphysics tendencies ! and (maybe) convection suppression fh_dfi_radar, radar_tten_limits, do_cap_suppress, & @@ -4090,17 +4099,17 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & write(*,*) 'NO FLAG: pbl is generic' endif - if(imfshalcnv == Model%imfshalcnv_gf .or. imfshalcnv == Model%imfshalcnv_unified) then + if(imfshalcnv == Model%imfshalcnv_gf .or. imfshalcnv == Model%imfshalcnv_c3) then if(me==master) & - write(*,*) 'FLAG: imfshalcnv_gf or imfshalcnv_unified so scnv not generic' + write(*,*) 'FLAG: imfshalcnv_gf or imfshalcnv_c3 so scnv not generic' Model%flag_for_scnv_generic_tend=.false. elseif(me==master) then write(*,*) 'NO FLAG: scnv is generic' endif - if(imfdeepcnv == Model%imfdeepcnv_gf .or. imfdeepcnv == Model%imfdeepcnv_unified) then + if(imfdeepcnv == Model%imfdeepcnv_gf .or. imfdeepcnv == Model%imfdeepcnv_c3) then if(me==master) & - write(*,*) 'FLAG: imfdeepcnv_gf or imfdeepcnv_unified so dcnv not generic' + write(*,*) 'FLAG: imfdeepcnv_gf or imfdeepcnv_c3 so dcnv not generic' Model%flag_for_dcnv_generic_tend=.false. elseif(me==master) then write(*,*) 'NO FLAG: dcnv is generic' @@ -4207,6 +4216,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%fire_aux_data_levels = 10 + Model%ichoice_s = ichoice_s + Model%ichoicem = ichoicem + Model%ichoice = ichoice + !--- integrated dynamics through earth's atmosphere Model%lsidea = lsidea if (Model%lsidea) then @@ -5655,7 +5668,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' Grell-Freitas scale & aerosol-aware mass-flux deep conv scheme' elseif(Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke) then print *,' New Tiedtke cumulus scheme' - elseif(Model%imfdeepcnv == Model%imfdeepcnv_unified) then + elseif(Model%imfdeepcnv == Model%imfdeepcnv_c3) then print *,' New unified cumulus convection scheme' endif endif @@ -5700,7 +5713,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' Grell-Freitas scale- & aerosol-aware mass-flux shallow conv scheme (2013)' elseif (Model%imfshalcnv == Model%imfshalcnv_ntiedtke) then print *,' New Tiedtke cumulus scheme' - elseif (Model%imfshalcnv == Model%imfshalcnv_unified) then + elseif (Model%imfshalcnv == Model%imfshalcnv_c3) then print *,' New unified cumulus scheme' else print *,' unknown mass-flux scheme in use - defaulting to no shallow convection' @@ -5948,7 +5961,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & endif if(Model%ras .or. Model%cscnv) Model%cnvcld = .false. - if(Model%do_shoc .or. Model%pdfcld .or. Model%do_mynnedmf .or. Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) Model%cnvcld = .false. + if(Model%do_shoc .or. Model%pdfcld .or. Model%do_mynnedmf .or. Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) Model%cnvcld = .false. if(Model%cnvcld) Model%ncnvcld3d = 1 !--- get cnvwind index in phy_f2d; last entry in phy_f2d array @@ -6014,7 +6027,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lmfdeep2 = (Model%imfdeepcnv == Model%imfdeepcnv_samf & .or. Model%imfdeepcnv == Model%imfdeepcnv_gf & .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke & - .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) + .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) !--- END CODE FROM GLOOPR !--- BEGIN CODE FROM GLOOPB @@ -6269,6 +6282,11 @@ subroutine control_print(Model) print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg print *, ' cpl_imp_dbg : ', Model%cpl_imp_dbg print *, ' use_med_flux : ', Model%use_med_flux + if(Model%imfdeepcnv == Model%imfdeepcnv_gf .or.Model%imfdeepcnv == Model%imfdeepcnv_c3) then + print*,'ichoice_s : ', Model%ichoice_s + print*,'ichoicem : ', Model%ichoicem + print*,'ichoice : ', Model%ichoice + endif if(model%rrfs_sd) then print *, ' ' print *, 'smoke parameters' @@ -6953,7 +6971,7 @@ subroutine tbd_create (Tbd, IM, Model) allocate (Tbd%hpbl (IM)) Tbd%hpbl = clear_val - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke .or. Model%imfdeepcnv == Model%imfdeepcnv_samf .or. Model%imfshalcnv == Model%imfshalcnv_samf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified .or. Model%imfshalcnv == Model%imfshalcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke .or. Model%imfdeepcnv == Model%imfdeepcnv_samf .or. Model%imfshalcnv == Model%imfshalcnv_samf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3 .or. Model%imfshalcnv == Model%imfshalcnv_c3) then allocate(Tbd%prevsq(IM, Model%levs)) Tbd%prevsq = clear_val endif @@ -6963,7 +6981,7 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%ud_mf = zero endif - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) then allocate(Tbd%forcet(IM, Model%levs)) allocate(Tbd%forceq(IM, Model%levs)) allocate(Tbd%forcet(IM, Model%levs)) @@ -6973,7 +6991,7 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%prevst = clear_val end if - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) then allocate(Tbd%cactiv(IM)) allocate(Tbd%cactiv_m(IM)) allocate(Tbd%aod_gf(IM)) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 4ab11dd4c..2934b838b 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -1089,7 +1089,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection) [conv_act_m] standard_name = consecutive_calls_for_grell_freitas_mid_level_convection long_name = Memory counter for GF midlevel @@ -1097,7 +1097,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection) [hice] standard_name = sea_ice_thickness long_name = sea ice thickness @@ -3029,7 +3029,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection) [pfi_lsan] standard_name = ice_flux_due_to_large_scale_precipitation long_name = instantaneous 3D flux of ice from nonconvective precipitation @@ -5191,9 +5191,9 @@ units = flag dimensions = () type = integer -[imfshalcnv_unified] - standard_name = identifier_for_unified_shallow_convection - long_name = flag for Unified shallow convection scheme +[imfshalcnv_c3] + standard_name = identifier_for_c3_shallow_convection + long_name = flag for C3 shallow convection scheme units = flag dimensions = () type = integer @@ -5227,9 +5227,9 @@ units = flag dimensions = () type = integer -[imfdeepcnv_unified] - standard_name = identifier_for_unified_deep_convection - long_name = flag for Unified deep convection scheme +[imfdeepcnv_c3] + standard_name = identifier_for_c3_deep_convection + long_name = flag for C3 deep convection scheme units = flag dimensions = () type = integer @@ -5239,6 +5239,24 @@ units = flag dimensions = () type = integer +[ichoice] + standard_name = identifier_for_c3_or_gf_deep_convection_closure + long_name = flag for C3 or GF deep convection closure + units = flag + dimensions = () + type = integer +[ichoicem] + standard_name = identifier_for_c3_or_gf_mid_convection_closure + long_name = flag for C3 or GF mid convection closure + units = flag + dimensions = () + type = integer +[ichoice_s] + standard_name = identifier_for_c3_or_gf_shallow_convection_closure + long_name = flag for C3 or GF shallow convection closure + units = flag + dimensions = () + type = integer [hwrf_samfdeep] standard_name = flag_for_hurricane_specific_code_in_scale_aware_mass_flux_deep_convection long_name = flag for hwrf samfdeepcnv scheme @@ -7440,7 +7458,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection) [imap] standard_name = map_of_block_column_number_to_global_i_index long_name = map of local index ix to global index i for this block @@ -7664,7 +7682,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection) [forceq] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -7672,7 +7690,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection) [prevst] standard_name = air_temperature_on_previous_timestep long_name = temperature from previous time step @@ -7680,7 +7698,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection) [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = moisture from previous time step @@ -7688,21 +7706,21 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection .or. control_for_deep_convection_scheme == identifer_for_scale_aware_mass_flux_deep_convection .or. control_for_shallow_convection_scheme == identifier_for_scale_aware_mass_flux_shallow_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection .or. control_for_deep_convection_scheme == identifier_for_new_tiedtke_deep_convection .or. control_for_deep_convection_scheme == identifer_for_scale_aware_mass_flux_deep_convection .or. control_for_shallow_convection_scheme == identifier_for_scale_aware_mass_flux_shallow_convection) [cactiv] standard_name = counter_for_grell_freitas_convection long_name = convective activity memory units = none dimensions = (horizontal_loop_extent) type = integer - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection) [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = mid-level convective activity memory units = none dimensions = (horizontal_loop_extent) type = integer - active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_unified_deep_convection) + active = (control_for_deep_convection_scheme == identifier_for_grell_freitas_deep_convection .or. control_for_deep_convection_scheme == identifier_for_c3_deep_convection) [CLDFRA_BL] standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer long_name = subgrid cloud fraction from PBL scheme diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index a1447b67b..9abf926de 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -118,7 +118,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%num2d = Restart%num2d + 3 endif ! Unified convection - if (Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_c3) then Restart%num2d = Restart%num2d + 3 endif ! CA @@ -258,7 +258,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo endif ! Unified convection - if (Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_c3) then num = num + 1 Restart%name2d(num) = 'gf_2d_conv_act' do nb = 1,nblks @@ -555,7 +555,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & !--Convection variable used in CB cloud fraction. Presently this !--is only needed in sgscloud_radpre for imfdeepcnv == imfdeepcnv_gf. - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) then num = num + 1 Restart%name3d(num) = 'cnv_3d_ud_mf' do nb = 1,nblks @@ -564,7 +564,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & endif !Unified convection scheme - if (Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_c3) then num = num + 1 Restart%name3d(num) = 'gf_3d_prevst' do nb = 1,nblks diff --git a/ccpp/physics b/ccpp/physics index 90c708975..427c77ba1 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 90c70897562884f413b27b7bca35130e8b881b7f +Subproject commit 427c77ba16f62bd84996f91b09655fff53abe549 diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_unified.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml similarity index 94% rename from ccpp/suites/suite_FV3_GFS_v17_coupled_p8_unified.xml rename to ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml index ea0599bbc..f0a8d7d92 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_unified.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml @@ -1,6 +1,6 @@ - + @@ -67,8 +67,8 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - cu_unified_driver_pre - cu_unified_driver + cu_c3_driver_pre + cu_c3_driver GFS_DCNV_generic_post GFS_SCNV_generic_pre GFS_SCNV_generic_post @@ -83,7 +83,7 @@ mp_thompson_post GFS_MP_generic_post - cu_unified_driver_post + cu_c3_driver_post maximum_hourly_diagnostics diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_unified.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml similarity index 94% rename from ccpp/suites/suite_FV3_GFS_v17_p8_unified.xml rename to ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml index b82018122..a79f37f7f 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_unified.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml @@ -1,6 +1,6 @@ - + @@ -66,8 +66,8 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - cu_unified_driver_pre - cu_unified_driver + cu_c3_driver_pre + cu_c3_driver GFS_DCNV_generic_post GFS_SCNV_generic_pre GFS_SCNV_generic_post @@ -82,7 +82,7 @@ mp_thompson_post GFS_MP_generic_post - cu_unified_driver_post + cu_c3_driver_post maximum_hourly_diagnostics diff --git a/ccpp/suites/suite_FV3_HRRR_c3.xml b/ccpp/suites/suite_FV3_HRRR_c3.xml new file mode 100644 index 000000000..ec55ee1ec --- /dev/null +++ b/ccpp/suites/suite_FV3_HRRR_c3.xml @@ -0,0 +1,88 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + flake_driver + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + rrfs_smoke_wrapper + mynnedmf_wrapper + rrfs_smoke_postpbl + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_c3_driver_pre + cu_c3_driver + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + cu_c3_driver_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + From dd6cd460e437ab5485533a0a62b0262e15ffc421 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Wed, 28 Jun 2023 13:17:57 -0400 Subject: [PATCH 04/48] Move unused ccpp suites to suites_not_used directory (#665) --- ccpp/{suites => suites_not_used}/suite_FV3_CPT_v0.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_csawmg.xml | 0 .../{suites => suites_not_used}/suite_FV3_GFS_2017_csawmgshoc.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_gfdlmp.xml | 0 .../suite_FV3_GFS_2017_gfdlmp_noahmp.xml | 0 .../suite_FV3_GFS_2017_gfdlmp_regional.xml | 0 .../suite_FV3_GFS_2017_gfdlmp_regional_c768.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_h2ophys.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_myj.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_ntiedtke.xml | 0 .../suite_FV3_GFS_2017_ozphys_2015.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_sas.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_satmedmf.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_satmedmfq.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_shinhong.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_stretched.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_ysu.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_cpld_rasmgshoc.xml | 0 .../suite_FV3_GFS_cpld_rasmgshocnsst.xml | 0 .../suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml | 0 .../suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml | 0 .../suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml | 0 .../suite_FV3_GFS_cpldnst_rasmgshoc.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_rasmgshoc.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_gf.xml | 0 .../{suites => suites_not_used}/suite_FV3_GFS_v15_gf_thompson.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_mynn.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_ras.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_rasmgshoc.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_thompson.xml | 0 .../suite_FV3_GFS_v15_thompson_mynn.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15p2_no_nsst.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15plus.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15plusras.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_clm_lake.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled.xml | 0 .../suite_FV3_GFS_v16_coupled_noahmp.xml | 0 .../suite_FV3_GFS_v16_coupled_nsstNoahmp.xml | 0 .../suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled_p8.xml | 0 .../suite_FV3_GFS_v16_coupled_p8_sfcocn.xml | 0 .../{suites => suites_not_used}/suite_FV3_GFS_v16_couplednsst.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_no_nsst.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_noahmp.xml | 0 .../suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_p8.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_thompson.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_ugwpv1.xml | 0 .../suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml | 0 .../suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml | 0 .../suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml | 0 .../suite_FV3_GFSv17alpha_cpldnsstras.xml | 0 .../suite_FV3_GFSv17alpha_cpldnsstras_flake.xml | 0 .../suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml | 0 .../suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml | 0 .../suite_FV3_GFSv17alpha_cpldnsstsas.xml | 0 .../suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_ras.xml | 0 .../suite_FV3_GFSv17alpha_ras_flake.xml | 0 .../suite_FV3_GFSv17alpha_ras_ugwp.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_sas.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_HAFS_v1_thompson.xml | 0 .../suite_FV3_HAFS_v1_thompson_noahmp.xml | 0 .../suite_FV3_HAFS_v1_thompson_noahmp_nonsst.xml | 0 .../suite_FV3_HAFS_v1_thompson_nonsst.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_HRRR_flake.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_HRRR_gf.xml | 0 .../suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml | 0 .../suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml | 0 ccpp/{suites => suites_not_used}/suite_FV3_RRFS_v1alpha.xml | 0 72 files changed, 0 insertions(+), 0 deletions(-) rename ccpp/{suites => suites_not_used}/suite_FV3_CPT_v0.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_csawmg.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_csawmgshoc.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_gfdlmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_gfdlmp_noahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_gfdlmp_regional.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_h2ophys.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_myj.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_ntiedtke.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_ozphys_2015.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_sas.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_satmedmf.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_satmedmfq.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_shinhong.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_stretched.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_2017_ysu.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_cpld_rasmgshoc.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_cpld_rasmgshocnsst.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_cpldnst_rasmgshoc.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_rasmgshoc.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_gf.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_gf_thompson.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_mynn.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_ras.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_rasmgshoc.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_thompson.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15_thompson_mynn.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15p2_no_nsst.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15plus.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v15plusras.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_clm_lake.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled_noahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled_p8.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_couplednsst.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_no_nsst.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_noahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_p8.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_thompson.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFS_v16_ugwpv1.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_cpldnsstras.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_cpldnsstsas.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_ras.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_ras_flake.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_ras_ugwp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_GFSv17alpha_sas.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_HAFS_v1_thompson.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_HAFS_v1_thompson_noahmp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_HAFS_v1_thompson_noahmp_nonsst.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_HAFS_v1_thompson_nonsst.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_HRRR_flake.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_HRRR_gf.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml (100%) rename ccpp/{suites => suites_not_used}/suite_FV3_RRFS_v1alpha.xml (100%) diff --git a/ccpp/suites/suite_FV3_CPT_v0.xml b/ccpp/suites_not_used/suite_FV3_CPT_v0.xml similarity index 100% rename from ccpp/suites/suite_FV3_CPT_v0.xml rename to ccpp/suites_not_used/suite_FV3_CPT_v0.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_csawmg.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_csawmg.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_csawmg.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_csawmgshoc.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_csawmgshoc.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp_noahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp_noahmp.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp_regional.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp_regional.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_h2ophys.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_h2ophys.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_myj.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_myj.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_myj.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_myj.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_ntiedtke.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_ntiedtke.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_ozphys_2015.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_ozphys_2015.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_sas.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_sas.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_sas.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_sas.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_satmedmf.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_satmedmf.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_satmedmfq.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_satmedmfq.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_shinhong.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_shinhong.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_shinhong.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_stretched.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_stretched.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_stretched.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_stretched.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_ysu.xml b/ccpp/suites_not_used/suite_FV3_GFS_2017_ysu.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_2017_ysu.xml rename to ccpp/suites_not_used/suite_FV3_GFS_2017_ysu.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml b/ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshoc.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml rename to ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshoc.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml b/ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsst.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml rename to ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsst.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml b/ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml rename to ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml b/ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml rename to ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsst_ugwp.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml b/ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml rename to ccpp/suites_not_used/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml b/ccpp/suites_not_used/suite_FV3_GFS_cpldnst_rasmgshoc.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml rename to ccpp/suites_not_used/suite_FV3_GFS_cpldnst_rasmgshoc.xml diff --git a/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml b/ccpp/suites_not_used/suite_FV3_GFS_rasmgshoc.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_rasmgshoc.xml rename to ccpp/suites_not_used/suite_FV3_GFS_rasmgshoc.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15_gf.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15_gf.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15_gf.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15_gf.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15_gf_thompson.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15_gf_thompson.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15_mynn.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15_mynn.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15_mynn.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15_mynn.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15_ras.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15_ras.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15_ras.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15_ras.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15_rasmgshoc.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15_rasmgshoc.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15_thompson.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15_thompson.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15_thompson.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15_thompson_mynn.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15_thompson_mynn.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15p2_no_nsst.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15p2_no_nsst.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15p2_no_nsst.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15p2_no_nsst.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15plus.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15plus.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15plus.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15plus.xml diff --git a/ccpp/suites/suite_FV3_GFS_v15plusras.xml b/ccpp/suites_not_used/suite_FV3_GFS_v15plusras.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v15plusras.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v15plusras.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_clm_lake.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_clm_lake.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_clm_lake.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_clm_lake.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_coupled.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_coupled.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_coupled.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_noahmp.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_noahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_coupled_noahmp.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_noahmp.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_nsstNoahmp.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_nsstNoahmpUGWPv1.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_p8.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_coupled_p8.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_p8.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_coupled_p8_sfcocn.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_couplednsst.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_couplednsst.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_couplednsst.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_couplednsst.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_no_nsst.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_no_nsst.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_no_nsst.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_no_nsst.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_noahmp.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_noahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_noahmp.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_noahmp.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_nsstNoahmpUGWPv1.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_p8.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_p8.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_p8.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_p8.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_thompson.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_thompson.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_thompson.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_thompson.xml diff --git a/ccpp/suites/suite_FV3_GFS_v16_ugwpv1.xml b/ccpp/suites_not_used/suite_FV3_GFS_v16_ugwpv1.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFS_v16_ugwpv1.xml rename to ccpp/suites_not_used/suite_FV3_GFS_v16_ugwpv1.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstras.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstras.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstras_flake.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstras_ugwp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstrasnoshal.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstsas.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstsas.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_ras.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_ras.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_ras.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_ras.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_ras_flake.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_ras_flake.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_ras_flake.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_ras_flake.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_ras_ugwp.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_ras_ugwp.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_ras_ugwp.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_ras_ugwp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_sas.xml b/ccpp/suites_not_used/suite_FV3_GFSv17alpha_sas.xml similarity index 100% rename from ccpp/suites/suite_FV3_GFSv17alpha_sas.xml rename to ccpp/suites_not_used/suite_FV3_GFSv17alpha_sas.xml diff --git a/ccpp/suites/suite_FV3_HAFS_v1_thompson.xml b/ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson.xml similarity index 100% rename from ccpp/suites/suite_FV3_HAFS_v1_thompson.xml rename to ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson.xml diff --git a/ccpp/suites/suite_FV3_HAFS_v1_thompson_noahmp.xml b/ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson_noahmp.xml similarity index 100% rename from ccpp/suites/suite_FV3_HAFS_v1_thompson_noahmp.xml rename to ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson_noahmp.xml diff --git a/ccpp/suites/suite_FV3_HAFS_v1_thompson_noahmp_nonsst.xml b/ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson_noahmp_nonsst.xml similarity index 100% rename from ccpp/suites/suite_FV3_HAFS_v1_thompson_noahmp_nonsst.xml rename to ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson_noahmp_nonsst.xml diff --git a/ccpp/suites/suite_FV3_HAFS_v1_thompson_nonsst.xml b/ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson_nonsst.xml similarity index 100% rename from ccpp/suites/suite_FV3_HAFS_v1_thompson_nonsst.xml rename to ccpp/suites_not_used/suite_FV3_HAFS_v1_thompson_nonsst.xml diff --git a/ccpp/suites/suite_FV3_HRRR_flake.xml b/ccpp/suites_not_used/suite_FV3_HRRR_flake.xml similarity index 100% rename from ccpp/suites/suite_FV3_HRRR_flake.xml rename to ccpp/suites_not_used/suite_FV3_HRRR_flake.xml diff --git a/ccpp/suites/suite_FV3_HRRR_gf.xml b/ccpp/suites_not_used/suite_FV3_HRRR_gf.xml similarity index 100% rename from ccpp/suites/suite_FV3_HRRR_gf.xml rename to ccpp/suites_not_used/suite_FV3_HRRR_gf.xml diff --git a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml b/ccpp/suites_not_used/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml similarity index 100% rename from ccpp/suites/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml rename to ccpp/suites_not_used/suite_FV3_RAP_noah_sfcdiff_ugwpv1.xml diff --git a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml b/ccpp/suites_not_used/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml similarity index 100% rename from ccpp/suites/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml rename to ccpp/suites_not_used/suite_FV3_RAP_noah_sfcdiff_unified_ugwp.xml diff --git a/ccpp/suites/suite_FV3_RRFS_v1alpha.xml b/ccpp/suites_not_used/suite_FV3_RRFS_v1alpha.xml similarity index 100% rename from ccpp/suites/suite_FV3_RRFS_v1alpha.xml rename to ccpp/suites_not_used/suite_FV3_RRFS_v1alpha.xml From e1de62f23cb66424f39e32a827c16c973a7103a2 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Wed, 5 Jul 2023 10:33:20 -0400 Subject: [PATCH 05/48] Name change for two NSSL MP namelist parameters (#662) * name change for two NSSL MP namelist parameters --- ccpp/data/GFS_typedefs.F90 | 20 ++++++++++---------- ccpp/data/GFS_typedefs.meta | 4 ++-- ccpp/physics | 2 +- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d964a8bf0..f0c91fcf1 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -970,9 +970,9 @@ module GFS_typedefs real(kind=kind_phys) :: nssl_cccn !< CCN concentration (m-3) real(kind=kind_phys) :: nssl_alphah !< graupel shape parameter real(kind=kind_phys) :: nssl_alphahl !< hail shape parameter - real(kind=kind_phys) :: nssl_alphar ! shape parameter for rain (imurain=1 only) - real(kind=kind_phys) :: nssl_ehw0_in ! constant or max assumed graupel-droplet collection efficiency - real(kind=kind_phys) :: nssl_ehlw0_in! constant or max assumed hail-droplet collection efficiency + real(kind=kind_phys) :: nssl_alphar ! shape parameter for rain (imurain=1 only) + real(kind=kind_phys) :: nssl_ehw0 ! constant or max assumed graupel-droplet collection efficiency + real(kind=kind_phys) :: nssl_ehlw0 ! constant or max assumed hail-droplet collection efficiency logical :: nssl_hail_on !< NSSL flag to activate the hail category logical :: nssl_ccn_on !< NSSL flag to activate the CCN category logical :: nssl_invertccn !< NSSL flag to treat CCN as activated (true) or unactivated (false) @@ -3419,8 +3419,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: nssl_alphah = 0.0 !< graupel shape parameter real(kind=kind_phys) :: nssl_alphahl = 1.0 !< hail shape parameter real(kind=kind_phys) :: nssl_alphar = 0.0 ! shape parameter for rain (imurain=1 only) - real(kind=kind_phys) :: nssl_ehw0_in = 0.9 ! constant or max assumed graupel-droplet collection efficiency - real(kind=kind_phys) :: nssl_ehlw0_in = 0.9 ! constant or max assumed hail-droplet collection efficiency + real(kind=kind_phys) :: nssl_ehw0 = 0.9 ! constant or max assumed graupel-droplet collection efficiency + real(kind=kind_phys) :: nssl_ehlw0 = 0.9 ! constant or max assumed hail-droplet collection efficiency logical :: nssl_hail_on = .false. !< NSSL flag to activate the hail category logical :: nssl_ccn_on = .true. !< NSSL flag to activate the CCN category logical :: nssl_invertccn = .true. !< NSSL flag to treat CCN as activated (true) or unactivated (false) @@ -3886,7 +3886,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ext_diag_thompson, dt_inner, lgfdlmprad, & sedi_semi, decfl, & nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_alphar, nssl_ehw0_in, nssl_ehlw0_in, & + nssl_alphar, nssl_ehw0, nssl_ehlw0, & nssl_invertccn, nssl_hail_on, nssl_ccn_on, & !--- max hourly avg_max_length, & @@ -4484,8 +4484,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nssl_alphah = nssl_alphah Model%nssl_alphahl = nssl_alphahl Model%nssl_alphar = nssl_alphar - Model%nssl_ehw0_in = nssl_ehw0_in - Model%nssl_ehlw0_in = nssl_ehlw0_in + Model%nssl_ehw0 = nssl_ehw0 + Model%nssl_ehlw0 = nssl_ehlw0 Model%nssl_hail_on = nssl_hail_on Model%nssl_ccn_on = nssl_ccn_on Model%nssl_invertccn = nssl_invertccn @@ -6429,8 +6429,8 @@ subroutine control_print(Model) print *, ' nssl_alphah - graupel shape parameter : ', Model%nssl_alphah print *, ' nssl_alphahl - hail shape parameter : ', Model%nssl_alphahl print *, ' nssl_alphar - rain shape parameter : ', Model%nssl_alphar - print *, ' nssl_ehw0_in - graupel-droplet collection effiency : ', Model%nssl_ehw0_in - print *, ' nssl_ehlw0_in - hail-droplet collection effiency : ', Model%nssl_ehlw0_in + print *, ' nssl_ehw0 - graupel-droplet collection effiency : ', Model%nssl_ehw0 + print *, ' nssl_ehlw0 - hail-droplet collection effiency : ', Model%nssl_ehlw0 print *, ' nssl_hail_on - hail activation flag : ', Model%nssl_hail_on print *, ' lradar - radar refl. flag : ', Model%lradar print *, ' lrefres : ', Model%lrefres diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 2934b838b..9e32dea0f 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -4322,14 +4322,14 @@ dimensions = () type = real kind = kind_phys -[nssl_ehw0_in] +[nssl_ehw0] standard_name = nssl_graupel_collection_efficiency long_name = graupel droplet collection efficiency in NSSL microphysics scheme units = none dimensions = () type = real kind = kind_phys -[nssl_ehlw0_in] +[nssl_ehlw0] standard_name = nssl_hail_collection_efficiency long_name = hail droplet collection efficiency in NSSL microphysics scheme units = none diff --git a/ccpp/physics b/ccpp/physics index 427c77ba1..c90c3d11e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 427c77ba16f62bd84996f91b09655fff53abe549 +Subproject commit c90c3d11e18cf495a4ca35dc2806482cbce11191 From 0bff645ba06f6c7c060651364f29b1c83fe5cad2 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 7 Jul 2023 12:34:30 -0400 Subject: [PATCH 06/48] Export evaporative flux from ATM (#672) * add export of evap from ATM * add block_copy for special values * add 32bit physics use case for block copy --- atmos_model.F90 | 52 ++++--- cpl/module_block_data.F90 | 280 ++++++++++++++++++++++++-------------- cpl/module_cplfields.F90 | 4 +- 3 files changed, 210 insertions(+), 126 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 5c54aed86..6725b1809 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -787,7 +787,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- Model should restart at the forecast hours that are multiples of fhzero. !--- WARNING: For special cases that model needs to restart at non-multiple of fhzero !--- the fields in first output files are not accumulated from the beginning of - !--- the bucket, but the restart time. + !--- the bucket, but the restart time. if (mod(sec,int(GFS_Control%fhzero*3600.)) /= 0) then diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.),int(GFS_Control%fhzero))*3600.0) if (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero' @@ -2840,7 +2840,7 @@ subroutine setup_exportdata(rc) integer :: isc, iec, jsc, jec integer :: nb, nk integer :: sphum, liq_wat, ice_wat, o3mr - real(GFS_kind_phys) :: rtime, rtimek + real(GFS_kind_phys) :: rtime, rtimek, spval integer :: localrc integer :: n,rank @@ -2853,7 +2853,8 @@ subroutine setup_exportdata(rc) !--- local parameters real(kind=ESMF_KIND_R8), parameter :: zeror8 = 0._ESMF_KIND_R8 - + real(GFS_kind_phys), parameter :: revap = one/2.501E+06_GFS_kind_phys ! reciprocal of specific + ! heat of vaporization J/kg !--- begin if (present(rc)) rc = ESMF_SUCCESS @@ -2865,6 +2866,7 @@ subroutine setup_exportdata(rc) rtime = one / GFS_control%dtp rtimek = GFS_control%rho_h2o * rtime + spval = GFS_control%huge do n=1, size(exportFields) @@ -2931,6 +2933,9 @@ subroutine setup_exportdata(rc) ! Instantaneous Latent heat flux (W/m**2) case ('inst_laten_heat_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, rc=localrc) + ! Instantaneous Evap flux (kg/m**2/s) + case ('inst_evap_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, revap, spval, rc=localrc) ! Instantaneous Downward long wave radiation flux (W/m**2) case ('inst_down_lw_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfci_cpl, Atm_block, nb, rc=localrc) @@ -2988,61 +2993,64 @@ subroutine setup_exportdata(rc) !--- Mean quantities ! MEAN Zonal compt of momentum flux (N/m**2) case ('mean_zonal_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Merid compt of momentum flux (N/m**2) case ('mean_merid_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Sensible heat flux (W/m**2) case ('mean_sensi_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Latent heat flux (W/m**2) case ('mean_laten_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + ! MEAN Evap rate (kg/m**2/s) + case ('mean_evap_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime*revap, rc=localrc) ! MEAN Downward LW heat flux (W/m**2) case ('mean_down_lw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Downward SW heat flux (W/m**2) case ('mean_down_sw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET long wave radiation flux (W/m**2) case ('mean_net_lw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET solar radiation flux over the ocean (W/m**2) case ('mean_net_sw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward nir direct flux (W/m**2) case ('mean_down_sw_ir_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward nir diffused flux (W/m**2) case ('mean_down_sw_ir_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward uv+vis direct flux (W/m**2) case ('mean_down_sw_vis_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward uv+vis diffused flux (W/m**2) case ('mean_down_sw_vis_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc nir direct flux (W/m**2) case ('mean_net_sw_ir_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc nir diffused flux (W/m**2) case ('mean_net_sw_ir_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc uv+vis direct flux (W/m**2) case ('mean_net_sw_vis_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc uv+vis diffused flux (W/m**2) case ('mean_net_sw_vis_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN precipitation rate (kg/m2/s) case ('mean_prec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! MEAN convective precipitation rate (kg/m2/s) case ('mean_prec_rate_conv') - call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) + call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! MEAN snow precipitation rate (kg/m2/s) case ('mean_fprec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! oceanfrac used by atm to calculate fluxes case ('openwater_frac_in_atm') call block_data_combine_fractions(datar82d, GFS_data(nb)%sfcprop%oceanfrac, GFS_Data(nb)%sfcprop%fice, Atm_block, nb, rc=localrc) diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90 index 1149bd252..7bd0a71b3 100644 --- a/cpl/module_block_data.F90 +++ b/cpl/module_block_data.F90 @@ -13,6 +13,7 @@ module module_block_data interface block_data_copy module procedure block_copy_1d_i4_to_2d_r8 module procedure block_copy_1d_r8_to_2d_r8 + module procedure block_copy_spval_1d_r8_to_2d_r8 module procedure block_copy_2d_r8_to_2d_r8 module procedure block_copy_2d_r8_to_3d_r8 module procedure block_copy_3d_r8_to_3d_r8 @@ -20,6 +21,7 @@ module module_block_data module procedure block_copy_1dslice2_r8_to_2d_r8 module procedure block_copy_3dslice_r8_to_3d_r8 module procedure block_copy_1d_r4_to_2d_r8 + module procedure block_copy_spval_1d_r4_to_2d_r8 module procedure block_copy_2d_r4_to_2d_r8 module procedure block_copy_2d_r4_to_3d_r8 module procedure block_copy_3d_r4_to_3d_r8 @@ -78,12 +80,12 @@ subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, integer, pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -110,15 +112,15 @@ subroutine block_copy_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:) + real(kind=8), pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -138,25 +140,62 @@ subroutine block_copy_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, end if if (present(rc)) rc = localrc - + end subroutine block_copy_1d_r8_to_2d_r8 + subroutine block_copy_spval_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, special_value, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=8), pointer :: source_ptr(:) + type(block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=8), intent(in) :: scale_factor + real(kind=8), intent(in) :: special_value + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + !$omp parallel do private(ix,ib,jb,i,j) + 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 + if (source_ptr(ix) .ne. special_value) then + destin_ptr(i,j) = scale_factor * source_ptr(ix) + else + destin_ptr(i,j) = special_value + end if + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_spval_1d_r8_to_2d_r8 + ! -- copy: 1D slice to 2D subroutine block_copy_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -188,17 +227,17 @@ subroutine block_copy_1dslice2_r8_to_2d_r8(destin_ptr, source_ptr, slice1, slice ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:) integer, intent(in) :: slice1 integer, intent(in) :: slice2 type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -230,15 +269,15 @@ subroutine block_copy_2d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=8) :: factor ! -- begin @@ -269,15 +308,15 @@ subroutine block_copy_2d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -308,12 +347,12 @@ subroutine block_array_copy_2d_r8_to_2d_r8(destin_ptr, source_arr, block, block_ type (block_control_type), intent(in) :: block integer, intent(in) :: block_index real(kind=8), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -341,15 +380,15 @@ subroutine block_copy_3d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=8) :: factor ! -- begin @@ -381,13 +420,13 @@ subroutine block_array_copy_3d_r8_to_3d_r8(destin_ptr, source_arr, block, block_ real(kind=8), intent(in) :: source_arr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=8), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -417,16 +456,16 @@ subroutine block_copy_3dslice_r8_to_3d_r8(destin_ptr, source_ptr, slice, block, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=8) :: factor ! -- begin @@ -462,13 +501,13 @@ subroutine block_array_copy_3dslice_r8_to_3d_r8(destin_ptr, source_arr, slice, b integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=8), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -569,7 +608,7 @@ subroutine block_copy_or_fill_1d_r8_to_2d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:) + real(kind=8), pointer :: source_ptr(:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -594,7 +633,7 @@ subroutine block_copy_or_fill_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) integer, intent(in) :: slice real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block @@ -620,7 +659,7 @@ subroutine block_copy_or_fill_1dslice2_r8_to_2d_r8(destin_ptr, source_ptr, slice ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:) integer, intent(in) :: slice1 integer, intent(in) :: slice2 real(ESMF_KIND_R8), intent(in) :: fill_value @@ -647,7 +686,7 @@ subroutine block_copy_or_fill_2d_r8_to_3d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -672,16 +711,15 @@ subroutine block_combine_frac_1d_r8_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: fract1_ptr(:) - real(kind=8), pointer :: fract2_ptr(:) + real(kind=8), pointer :: fract1_ptr(:) + real(kind=8), pointer :: fract2_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -713,15 +751,15 @@ subroutine block_copy_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:) + real(kind=4), pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=4) :: factor ! -- begin @@ -744,22 +782,59 @@ subroutine block_copy_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, end subroutine block_copy_1d_r4_to_2d_r8 + subroutine block_copy_spval_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, special_value, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), pointer :: source_ptr(:) + type(block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), intent(in) :: scale_factor + real(kind=4), intent(in) :: special_value + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + !$omp parallel do private(ix,ib,jb,i,j) + 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 + if (source_ptr(ix) .ne. special_value) then + destin_ptr(i,j) = scale_factor * source_ptr(ix) + else + destin_ptr(i,j) = special_value + end if + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_spval_1d_r4_to_2d_r8 + ! -- copy: 1D slice to 2D subroutine block_copy_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=4) :: factor ! -- begin @@ -800,9 +875,9 @@ subroutine block_copy_1dslice2_r4_to_2d_r8(destin_ptr, source_ptr, slice1, slice integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -833,15 +908,15 @@ subroutine block_copy_2d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=4) :: factor ! -- begin @@ -872,15 +947,15 @@ subroutine block_copy_2d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=4) :: factor ! -- begin @@ -910,13 +985,13 @@ subroutine block_array_copy_2d_r4_to_2d_r8(destin_ptr, source_arr, block, block_ real(kind=4), intent(in) :: source_arr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -944,15 +1019,15 @@ subroutine block_copy_3d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:,:) + real(kind=4), pointer :: source_ptr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=4) :: factor ! -- begin @@ -988,9 +1063,9 @@ subroutine block_array_copy_3d_r4_to_3d_r8(destin_ptr, source_arr, block, block_ integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -1020,16 +1095,16 @@ subroutine block_copy_3dslice_r4_to_3d_r8(destin_ptr, source_ptr, slice, block, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:,:,:) + real(kind=4), pointer :: source_ptr(:,:,:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=4) :: factor ! -- begin @@ -1065,13 +1140,13 @@ subroutine block_array_copy_3dslice_r4_to_3d_r8(destin_ptr, source_arr, slice, b integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -1104,7 +1179,7 @@ subroutine block_copy_or_fill_1d_r4_to_2d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:) + real(kind=4), pointer :: source_ptr(:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -1129,7 +1204,7 @@ subroutine block_copy_or_fill_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) integer, intent(in) :: slice real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block @@ -1182,7 +1257,7 @@ subroutine block_copy_or_fill_2d_r4_to_3d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -1207,16 +1282,15 @@ subroutine block_combine_frac_1d_r4_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: fract1_ptr(:) - real(kind=4), pointer :: fract2_ptr(:) + real(kind=4), pointer :: fract1_ptr(:) + real(kind=4), pointer :: fract2_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb ! -- begin localrc = ESMF_RC_PTR_NOTALLOC diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 56eb372ad..884a3bdeb 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -26,7 +26,7 @@ module module_cplfields ! l : model levels (3D) ! s : surface (2D) ! t : tracers (4D) - integer, public, parameter :: NexportFields = 119 + integer, public, parameter :: NexportFields = 121 type(ESMF_Field), target, public :: exportFields(NexportFields) type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ & @@ -61,6 +61,7 @@ module module_cplfields FieldInfo("mean_merid_moment_flx_atm ", "s"), & FieldInfo("mean_sensi_heat_flx ", "s"), & FieldInfo("mean_laten_heat_flx ", "s"), & + FieldInfo("mean_evap_rate ", "s"), & FieldInfo("mean_down_lw_flx ", "s"), & FieldInfo("mean_down_sw_flx ", "s"), & FieldInfo("mean_prec_rate ", "s"), & @@ -68,6 +69,7 @@ module module_cplfields FieldInfo("inst_merid_moment_flx ", "s"), & FieldInfo("inst_sensi_heat_flx ", "s"), & FieldInfo("inst_laten_heat_flx ", "s"), & + FieldInfo("inst_evap_rate ", "s"), & FieldInfo("inst_down_lw_flx ", "s"), & FieldInfo("inst_down_sw_flx ", "s"), & FieldInfo("inst_temp_height2m ", "s"), & From 67e146d3a7a7f4183975ad5380bb91e25fc55f03 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Mon, 10 Jul 2023 15:27:07 -0400 Subject: [PATCH 07/48] Fix memory errors: uninitialized variables, and NetCDF writes to arrays that are too small (#668) * move utility routines, data structures, and name generation out of FV3GFS_io.F90 * move RRFS SD state restart io to separate file and rename clm_lake_io.F90 * move rrfs sd emissions input code to FV3GFS_rrfs_sd_io.F90 * register sfc fields in FV3GFS_sfc_io.F90 * move oro reading to FV3GFS_oro_io.F90 * gwd I/O in FV3GFS_oro_io.F90 * store quilt restart data structures in FV3GFS_sfc_io types * rrfs sd restart in quilt (still under testing) * bug fixes for RRFS 32-bit physics --- ccpp/data/GFS_typedefs.F90 | 27 +++++++++++++++++++++++++++ ccpp/physics | 2 +- 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index f0c91fcf1..2ff3db97e 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -6821,6 +6821,10 @@ subroutine grid_create (Grid, IM, Model) allocate (Grid%ddy_o3 (IM)) allocate (Grid%jindx1_o3 (IM)) allocate (Grid%jindx2_o3 (IM)) + + Grid%ddy_o3 = clear_val + Grid%jindx1_o3 = clear_val + Grid%jindx2_o3 = clear_val endif !--- stratosphere h2o active @@ -6828,6 +6832,10 @@ subroutine grid_create (Grid, IM, Model) allocate (Grid%ddy_h (IM)) allocate (Grid%jindx1_h (IM)) allocate (Grid%jindx2_h (IM)) + + Grid%ddy_h = clear_val + Grid%jindx1_h = clear_val + Grid%jindx2_h = clear_val endif !--- iccn active @@ -6838,6 +6846,13 @@ subroutine grid_create (Grid, IM, Model) allocate (Grid%ddx_ci (IM)) allocate (Grid%iindx1_ci (IM)) allocate (Grid%iindx2_ci (IM)) + + Grid%ddy_ci = clear_val + Grid%jindx1_ci = clear_val + Grid%jindx2_ci = clear_val + Grid%ddx_ci = clear_val + Grid%iindx1_ci = clear_val + Grid%iindx2_ci = clear_val endif !--- iaerclm active @@ -6848,6 +6863,13 @@ subroutine grid_create (Grid, IM, Model) allocate (Grid%ddx_aer (IM)) allocate (Grid%iindx1_aer(IM)) allocate (Grid%iindx2_aer(IM)) + + Grid%ddy_aer = clear_val + Grid%jindx1_aer = clear_val + Grid%jindx2_aer = clear_val + Grid%ddx_aer = clear_val + Grid%iindx1_aer = clear_val + Grid%iindx2_aer = clear_val endif !--- Model%do_ugwpv1 @@ -6856,6 +6878,11 @@ subroutine grid_create (Grid, IM, Model) allocate (Grid%ddy_j2tau (IM)) allocate (Grid%jindx1_tau (IM)) allocate (Grid%jindx2_tau (IM)) + + Grid%ddy_j1tau = clear_val + Grid%ddy_j2tau = clear_val + Grid%jindx1_tau = clear_val + Grid%jindx2_tau = clear_val endif end subroutine grid_create diff --git a/ccpp/physics b/ccpp/physics index c90c3d11e..c4ae12946 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c90c3d11e18cf495a4ca35dc2806482cbce11191 +Subproject commit c4ae12946ee8cfd090cac17b02b4e4216a7c82b1 From e7dc085032e072cc075d060ef654a0a6fe663956 Mon Sep 17 00:00:00 2001 From: HelinWei-NOAA <48133472+HelinWei-NOAA@users.noreply.github.com> Date: Wed, 19 Jul 2023 11:16:39 -0400 Subject: [PATCH 08/48] Land surface upgrades for HR2 (#663) * adding soil color data to NoahMP * add iopt_diag for 2m t/q diagnostic option * fixed a sfc_name2 error * fix a counting error in Sfc_io_calculate_indices --- ccpp/data/GFS_typedefs.F90 | 15 +++++++++++- ccpp/data/GFS_typedefs.meta | 18 ++++++++++++++ ccpp/driver/GFS_diagnostics.F90 | 12 ++++++++++ ccpp/physics | 2 +- io/fv3atm_restart_io.F90 | 3 ++- io/fv3atm_sfc_io.F90 | 42 +++++++++++++++++++++++---------- 6 files changed, 76 insertions(+), 16 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 2ff3db97e..d0b19327c 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -283,8 +283,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: vfrac (:) => null() !< vegetation fraction integer, pointer :: vtype (:) => null() !< vegetation type integer, pointer :: stype (:) => null() !< soil type + integer, pointer :: scolor (:) => null() !< soil color integer, pointer :: vtype_save (:) => null()!< vegetation type save integer, pointer :: stype_save (:) => null()!< soil type save + integer, pointer :: scolor_save (:) => null()!< soil color 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 @@ -1045,6 +1047,8 @@ module GFS_typedefs integer :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) integer :: iopt_stc !snow/soil temperature time scheme (only layer 1) integer :: iopt_trs !thermal roughness scheme (1-z0h=z0m; 2-czil; 3-ec;4-kb inversed) + integer :: iopt_diag !2m t/q diagnostic approach (1->external GFS sfc_diag 2->original NoahMP 2-title 3->NoahMP + !2-title + internal GFS sfc_diag ) ! -- RUC LSM options integer :: mosaic_lu=0 !< control for use of fractional landuse in RUC land surface model @@ -2379,6 +2383,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%vtype_save (IM)) allocate (Sfcprop%stype (IM)) allocate (Sfcprop%stype_save (IM)) + allocate (Sfcprop%scolor (IM)) + allocate (Sfcprop%scolor_save(IM)) allocate (Sfcprop%uustar (IM)) allocate (Sfcprop%oro (IM)) allocate (Sfcprop%oro_uf (IM)) @@ -2397,6 +2403,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%vtype_save = zero Sfcprop%stype = zero Sfcprop%stype_save = zero + Sfcprop%scolor = zero + Sfcprop%scolor_save = zero Sfcprop%uustar = clear_val Sfcprop%oro = clear_val Sfcprop%oro_uf = clear_val @@ -3493,6 +3501,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: iopt_tbot = 2 !lower boundary of soil temperature (1->zero-flux; 2->noah) integer :: iopt_stc = 1 !snow/soil temperature time scheme (only layer 1) integer :: iopt_trs = 2 !thermal roughness scheme (1-z0h=z0m; 2-czil; 3-ec;4-kb reversed) + integer :: iopt_diag = 2 !2m t/q diagnostic approach (1->external GFS sfc_diag 2->original NoahMP 2-title + !3->NoahMP 2-title + internal GFS sfc_diag ) integer :: mosaic_lu = 0 ! 1 - used of fractional landuse in RUC lsm integer :: mosaic_soil = 0 ! 1 - used of fractional soil in RUC lsm @@ -3897,7 +3907,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! Noah MP options iopt_dveg,iopt_crs,iopt_btr,iopt_run,iopt_sfc, iopt_frz, & iopt_inf, iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc, & - iopt_trs, & + iopt_trs, iopt_diag, & ! RUC lsm options mosaic_lu, mosaic_soil, isncond_opt, isncovr_opt, & ! GFDL surface layer options @@ -4659,6 +4669,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%iopt_tbot = iopt_tbot Model%iopt_stc = iopt_stc Model%iopt_trs = iopt_trs + Model%iopt_diag = iopt_diag ! RUC lsm options Model%mosaic_lu = mosaic_lu @@ -5597,6 +5608,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,'iopt_tbot = ',Model%iopt_tbot print *,'iopt_stc = ', Model%iopt_stc print *,'iopt_trs = ', Model%iopt_trs + print *,'iopt_diag = ', Model%iopt_diag elseif (Model%lsm == Model%lsm_ruc) then print *,' RUC Land Surface Model used' print *, 'The Physics options are' @@ -6513,6 +6525,7 @@ subroutine control_print(Model) print *, ' iopt_tbot : ', Model%iopt_tbot print *, ' iopt_stc : ', Model%iopt_stc print *, ' iopt_trs : ', Model%iopt_trs + print *, ' iopt_diag : ', Model%iopt_diag elseif (Model%lsm == Model%lsm_ruc) then print *,' RUC Land Surface Model used' print *, 'The Physics options are' diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 9e32dea0f..64e7ae5b7 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -1053,6 +1053,18 @@ units = index dimensions = (horizontal_loop_extent) type = integer +[scolor] + standard_name = soil_color_classification + long_name = soil color for lsm + units = index + dimensions = (horizontal_loop_extent) + type = integer +[scolor_save] + standard_name = soil_color_classification_save + long_name = soil color for lsm save + units = index + dimensions = (horizontal_loop_extent) + type = integer [uustar] standard_name = surface_friction_velocity long_name = boundary layer parameter @@ -4905,6 +4917,12 @@ units = index dimensions = () type = integer +[iopt_diag] + standard_name = control_for_land_surface_scheme_surface_diagnose_approach + long_name = choice for surface diagnose approach option (see noahmp module for definition) + units = index + dimensions = () + type = integer [use_ufo] standard_name = flag_for_gcycle_surface_option long_name = flag for gcycle surface option diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index c1598a28c..f14773d34 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -3838,6 +3838,18 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%stype(:) enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'scolor' + ExtDiag(idx)%desc = 'soil color in integer 1-20' + ExtDiag(idx)%unit = 'number' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%scolor(:) + enddo + + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'lfrac' diff --git a/ccpp/physics b/ccpp/physics index c4ae12946..5dc968ef4 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c4ae12946ee8cfd090cac17b02b4e4216a7c82b1 +Subproject commit 5dc968ef4e0aa0c36ef980e39a44d58056d1cb2c diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index d5cfb9734..ccdc6d719 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -162,7 +162,7 @@ subroutine fv3atm_checksum (Model, GFS_Data, Atm_block) ntr = size(GFS_Data(1)%Statein%qgrs,3) - nsfcprop2d = 93 + nsfcprop2d = 94 if (Model%lsm == Model%lsm_noahmp) then nsfcprop2d = nsfcprop2d + 49 if (Model%use_cice_alb) then @@ -228,6 +228,7 @@ subroutine fv3atm_checksum (Model, GFS_Data, Atm_block) call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%vfrac) call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%vtype) call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%stype) + call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%scolor) call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%uustar) call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%oro) call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,temp2d,GFS_Data(nb)%Sfcprop%oro_uf) diff --git a/io/fv3atm_sfc_io.F90 b/io/fv3atm_sfc_io.F90 index cff249370..6cd007761 100644 --- a/io/fv3atm_sfc_io.F90 +++ b/io/fv3atm_sfc_io.F90 @@ -107,7 +107,7 @@ function Sfc_io_calculate_indices(sfc, Model, reading, warm_start) integer :: nvar2m, nvar2o, nvar3, nvar2r, nvar2mp, nvar3mp, nvar2l integer :: nvar_before_lake - nvar2m = 48 + nvar2m = 49 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then nvar2m = nvar2m + 4 !nvar2m = nvar2m + 5 @@ -438,6 +438,7 @@ subroutine Sfc_io_fill_2d_names(sfc,Model,warm_start) nt=nt+1 ; sfc%name2(nt) = 'slope' nt=nt+1 ; sfc%name2(nt) = 'snoalb' !--- variables below here are optional + nt=nt+1 ; sfc%name2(nt) = 'scolor' nt=nt+1 ; sfc%name2(nt) = 'sncovr' nt=nt+1 ; sfc%name2(nt) = 'snodl' !snowd on land portion of a cell nt=nt+1 ; sfc%name2(nt) = 'weasdl'!weasd on land portion of a cell @@ -593,7 +594,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) .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' .or. trim(sfc%name2(num)) == 'emis_ice' & - .or. trim(sfc%name2(num)) == 'sncovr_ice') then + .or. trim(sfc%name2(num)) == 'sncovr_ice' .or. trim(sfc%name2(num)) == 'scolor') then if(reading .and. sfc%is_lsoil) then call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) else @@ -829,6 +830,7 @@ subroutine Sfc_io_transfer(sfc, reading, Model, Atm_block, Sfcprop, warm_start, call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%shdmax) !--- shdmax call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%slope) !--- slope call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snoalb) !--- snoalb + call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%scolor) !--- scolor call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%sncovr) !--- sncovr call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%snodl) !--- snodl (snowd on land portion of a cell) call GFS_Data_transfer(reading,ii1,jj1,isc,jsc,nt,sfc%var2,Sfcprop(nb)%weasdl) !--- weasdl (weasd on land portion of a cell) @@ -1277,7 +1279,21 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) i = Atm_block%index(1)%ii(1) - isc + 1 j = Atm_block%index(1)%jj(1) - jsc + 1 - if (sfc%var2(i,j,33) < -9990.0_kind_phys) then + if (sfc%var2(i,j,32) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - set init soil color') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if ( nint (Sfcprop(nb)%slmsk(ix)) == 1 ) then !including glacier + Sfcprop(nb)%scolor(ix) = 4 + else + Sfcprop(nb)%scolor(ix) = zero + endif + enddo + enddo + endif + + if (sfc%var2(i,j,34) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodl') !$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks @@ -1292,7 +1308,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,34) < -9990.0_kind_phys) then + if (sfc%var2(i,j,35) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasdl') !$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks @@ -1307,7 +1323,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,36) < -9990.0_kind_phys) then + if (sfc%var2(i,j,37) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks @@ -1317,7 +1333,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,37) < -9990.0_kind_phys) then + if (sfc%var2(i,j,38) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlw') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks @@ -1329,7 +1345,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,38) < -9990.0_kind_phys) then + if (sfc%var2(i,j,39) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorll') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks @@ -1339,7 +1355,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,39) < -9990.0_kind_phys) then + if (sfc%var2(i,j,40) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks @@ -1351,7 +1367,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,45) < -9990.0_kind_phys) then + if (sfc%var2(i,j,46) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing emis_ice') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks @@ -1361,7 +1377,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,46) < -9990.0_kind_phys .and. Model%lsm /= Model%lsm_ruc) then + if (sfc%var2(i,j,47) < -9990.0_kind_phys .and. Model%lsm /= Model%lsm_ruc) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr_ice') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks @@ -1372,7 +1388,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,47) < -9990.0_kind_phys) then + if (sfc%var2(i,j,48) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodi') !$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks @@ -1387,7 +1403,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif - if (sfc%var2(i,j,48) < -9990.0_kind_phys) then + if (sfc%var2(i,j,49) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasdi') !$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks @@ -1403,7 +1419,7 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) endif if (Model%use_cice_alb) then - if (sfc%var2(i,j,49) < -9990.0_kind_phys) then + if (sfc%var2(i,j,50) < -9990.0_kind_phys) then !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) From b32981f72045e4f7191a62088be12996cd67d2ed Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 24 Jul 2023 12:48:46 -0400 Subject: [PATCH 09/48] Fixed stratosphere warm bias and code optimization for MERRA2 (#674) * optimized the code and decrease the stratosphere warm bias for mraerosol=T --------- Co-authored-by: anning.cheng --- ccpp/data/CCPP_typedefs.F90 | 4 ++++ ccpp/physics | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index 9a6a387ba..ed27c5e37 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -929,6 +929,8 @@ subroutine gfs_interstitial_setup_tracers(Interstitial, Model) if (Model%imp_physics == Model%imp_physics_thompson) then if (Model%ltaerosol) then Interstitial%nvdiff = 12 + else if (Model%mraerosol) then + Interstitial%nvdiff = 10 else Interstitial%nvdiff = 9 endif @@ -1018,6 +1020,8 @@ subroutine gfs_interstitial_setup_tracers(Interstitial, Model) elseif (Model%imp_physics == Model%imp_physics_thompson) then if (Model%ltaerosol) then Interstitial%nvdiff = 12 + else if (Model%mraerosol) then + Interstitial%nvdiff = 10 else Interstitial%nvdiff = 9 endif diff --git a/ccpp/physics b/ccpp/physics index 5dc968ef4..9b6997449 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5dc968ef4e0aa0c36ef980e39a44d58056d1cb2c +Subproject commit 9b69974496a208e26feef30d0b0e405ac4e023b9 From 6d17939836dd5665854a88931552f17e56c1c377 Mon Sep 17 00:00:00 2001 From: WenMeng-NOAA <48260754+WenMeng-NOAA@users.noreply.github.com> Date: Thu, 27 Jul 2023 09:25:15 -0400 Subject: [PATCH 10/48] Update inline post (#666) * Add initialization for some local variables. * Change undefined value of aextc55 as 0 * Read soill to level 9 for RUC LSM * Correct tke reading and update upp revision. * Update upp revision to baa7751 --- io/post_fv3.F90 | 1317 ++++++++++++++++++++++------------------------- upp | 2 +- 2 files changed, 616 insertions(+), 703 deletions(-) diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 7cc6ab45e..f8dcc80de 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -187,7 +187,7 @@ subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & call set_outflds(kth,th,kpv,pv) if(allocated(datapd))deallocate(datapd) allocate(datapd(ite-its+1,jte-jts+1,nrecout+100)) -!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd,ista,iend) +!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,datapd,ista,iend) do k=1,nrecout+100 do j=1,jend+1-jsta do i=1,iend+1-ista @@ -494,6 +494,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) ! Apr 2022 W. Meng Unify set_postvars_gfs and ! set_postvars_regional to set_postvars_fv3 ! Apr 2023 W. Meng Sync RRFS and GFS changes from off-line post +! Jun 2023 W. Meng Remove duplicate initialization; +! relocate computation of aerosol fields ! !----------------------------------------------------------------------- !*** set up post fields from nmint_state @@ -542,12 +544,13 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) sfcvxi, t10m, t10avg, psfcavg, akhsavg, akmsavg, & albedo, tg, prate_max, pwat, snow_acm, snow_bkt, & acgraup, graup_bucket, acfrain, frzrn_bucket, & - ltg1_max, ltg2_max, ltg3_max, aodtot, ebb, hwp, & + ltg1_max, ltg2_max, ltg3_max, ebb, hwp, & aod550,du_aod550,ss_aod550,su_aod550,oc_aod550, & bc_aod550,maod, & dustpm10, dustcb, bccb, occb, sulfcb, sscb, & dustallcb, ssallcb, dustpm, sspm, pp25cb, pp10cb, & - no3cb, nh4cb, dusmass, ducmass, dusmass25,ducmass25 + no3cb, nh4cb, dusmass, ducmass, dusmass25,ducmass25, & + snownc, graupelnc, qrmax use soil, only: sldpth, sh2o, smc, stc, sllevel use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & @@ -603,9 +606,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) real,dimension(:), allocatable :: slat,qstl real,external::FPVSNEW real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & - cw2d, cfr2d, accswe_ice, accswe_land, & - snacc_land, snacc_ice - real,dimension(:,:,:),allocatable :: extsmoke, extdust + cw2d, cfr2d, snacc_land, snacc_ice + real,dimension(:,:,:),allocatable :: ext550 character(len=80) :: fieldname, wrtFBName, flatlon, & VarName type(ESMF_Grid) :: wrtGrid @@ -670,7 +672,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) bk5(i) = wrt_int_state%bk(i) enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat,ista,iend) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,f,gdlat,ista,iend) do j=jsta,jend do i=ista,iend f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) @@ -679,18 +681,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) ! pt = ak5(1) -! GFS does not have surface specific humidity -! inst sensible heat flux -! inst latent heat flux -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths,ista,iend) - do j=jsta,jend - do i=ista,iend - qs(i,j) = SPVAL - twbs(i,j) = SPVAL - qwbs(i,j) = SPVAL - enddo - enddo - ! GFS set up DT to compute accumulated fields, set it to one dtq2 = wrt_int_state%dtp nphs = 2. @@ -698,57 +688,26 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) !Allocate for regional models only if(modelname=='FV3R') then - allocate(extsmoke(ista:iend,jsta:jend,lm)) - allocate(extdust(ista:iend,jsta:jend,lm)) - allocate(accswe_ice(ista:iend,jsta:jend)) - allocate(accswe_land(ista:iend,jsta:jend)) + allocate(ext550(ista:iend,jsta:jend,lm)) allocate(snacc_ice(ista:iend,jsta:jend)) allocate(snacc_land(ista:iend,jsta:jend)) - endif -! -! GFS does not have convective cloud efficiency -! similated precip -! 10 m theta -! 10 m humidity -! snow free albedo -!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval,ista,iend), & -!$omp& shared(cldefi,lspa,th10,q10,albase) - do j=jsta,jend - do i=ista,iend - cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL - albase(i,j) = SPVAL - enddo - enddo + do j=jsta,jend + do i=ista,iend + snacc_ice(i,j)=spval + snacc_land(i,j)=spval + end do + end do -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate,ista,iend) - do j=jsta,jend - do i=ista,iend - cprate(i,j) = 0. - enddo - enddo + do l=1,lm + do j=jsta,jend + do i=ista,iend + ext550(i,j,l)=spval + end do + end do + end do + endif -! GFS probably does not use zenith angle, czen, czmean -! inst surface outgoing longwave, radot -! inst cloud fraction for high, middle, and low cloud, -! cfrach -! inst ground heat flux, grnflx -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,ista,iend), & -!$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) - do j=jsta,jend - do i=ista,iend - czen(i,j) = SPVAL - czmean(i,j) = SPVAL - cfrach(i,j) = SPVAL - cfracl(i,j) = SPVAL - cfracm(i,j) = SPVAL - grnflx(i,j) = SPVAL - enddo - enddo ! ! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam sldpth(1) = 0.10 @@ -756,27 +715,13 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) sldpth(3) = 0.6 sldpth(4) = 1.0 -! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, n -! cfrcv to 1 -! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 -! UNDERGROUND RUNOFF, bgroff -! inst incoming sfc longwave -! inst incoming sfc shortwave, rswin -! inst incoming clear sky sfc shortwave, rswinc -! inst outgoing sfc shortwave, rswout -! snow phase change heat flux, snopcx -! GFS does not use total momentum flux,sfcuvx -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,ista,iend), & -!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rswin,rswinc,rswout,snopcx,sfcuvx,& -!$omp& ltg1_max,ltg2_max,ltg3_max) +! set ncfrcv to 1, ncfrst to 1 +!$omp parallel do default(none),private(i,j),shared(jsta,jend,spval,ista,iend), & +!$omp& shared(ncfrcv,ncfrst) do j=jsta,jend do i=ista,iend - acfrcv(i,j) = spval ncfrcv(i,j) = 1.0 - acfrst(i,j) = spval ncfrst(i,j) = 1.0 - bgroff(i,j) = spval - rswinc(i,j) = spval enddo enddo @@ -787,77 +732,11 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) ! GFS surface flux has been averaged, set ASRFC to 1 asrfc = 1.0 -! GFS does not have temperature tendency due to long wave radiation -! temperature tendency due to short wave radiation -! temperature tendency due to latent heating from convection -! temperature tendency due to latent heating from grid scale - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l,ista_2l,iend_2u), & -!$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - rlwtt(i,j,l) = spval - rswtt(i,j,l) = spval - tcucn(i,j,l) = spval - tcucns(i,j,l) = spval - train(i,j,l) = spval - enddo - enddo - enddo - ! set avrain to 1 avrain = 1.0 avcnvc = 1.0 theat = 6.0 ! just in case GFS decides to output T tendency -! GFS does not have temperature tendency due to latent heating from grid scale - train = spval - -! GFS does not have soil moisture availability, smstav -! accumulated surface evaporatio, sfcevp -! averaged accumulated snow, acsnow -! snow melt,acsnom -! humidity at roughness length, qz0 -! u at roughness length, uz0 -! v at roughness length, vz0 -! shelter rh max, maxrhshltr -! shelter rh min, minrhshltr -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & -!$omp& shared(sfcevp,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - sfcevp(i,j) = spval - acsnom(i,j) = spval - qz0(i,j) = spval - uz0(i,j) = spval - vz0(i,j) = spval - enddo - enddo - -! GFS does not have mixing length,el_pbl -! exchange coefficient, exch_h - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h,ista_2l,iend_2u) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - el_pbl(i,j,l) = spval - exch_h(i,j,l) = spval - enddo - enddo - enddo - -! GFS does not have deep convective cloud top and bottom fields -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & -!$omp& shared(htopd,hbotd,htops,hbots,cuppt) - do j=jsta_2l,jend_2u - do i=ista_2l,iend_2u - htopd(i,j) = SPVAL - hbotd(i,j) = SPVAL - htops(i,j) = SPVAL - hbots(i,j) = SPVAL - cuppt(i,j) = SPVAL - enddo - enddo ! ! get inital date sdat(1) = wrt_int_state%idate(2) !month @@ -1114,17 +993,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif - ! total aod - if(trim(fieldname)=='aodtot') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aodtot,arrayr42d,fillValue,spval) - do j=jsta,jend - do i=ista, iend - aodtot(i,j)=arrayr42d(i,j) - if(abs(arrayr42d(i,j)-fillValue) < small) aodtot(i,j)=spval - enddo - enddo - endif - ! biomass burning emissions if(trim(fieldname)=='ebb_smoke_hr') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ebb,arrayr42d,fillValue,spval) @@ -1367,6 +1235,28 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif + !time step snow (in m) + if(trim(fieldname)=='snow') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snownc,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + snownc(i,j) = arrayr42d(i,j) + if (abs(arrayr42d(i,j)-fillValue) < small) snownc(i,j) = spval + enddo + enddo + endif + + !time step graupel (in m) + if(trim(fieldname)=='graupel') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,graupelnc,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + graupelnc(i,j) = arrayr42d(i,j) + if (abs(arrayr42d(i,j)-fillValue) < small) graupelnc(i,j) = spval + enddo + enddo + endif + ! max hourly surface precipitation rate if(trim(fieldname)=='pratemax') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,prate_max,arrayr42d,sm,fillValue) @@ -1736,6 +1626,69 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif + if(nsoil==9) then + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill5') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,5) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,5) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,5) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill6') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,6) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,6) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,6) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill7') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,7) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,7) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,7) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill8') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,8) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,8) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,8) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill9') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm,fillValue) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,9) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue) < small) sh2o(i,j,9) = spval + if (sm(i,j) /= 0.0) sh2o(i,j,9) = spval + enddo + enddo + endif + + endif !nsoil + ! volumetric soil moisture if(trim(fieldname)=='soilw1') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm,fillValue) @@ -2350,25 +2303,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) endif if(modelname=='FV3R')then - !acsnow - if(trim(fieldname)=='accswe_land') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,accswe_land,arrayr42d,fillvalue,spval) - do j=jsta,jend - do i=ista, iend - accswe_land(i,j) = arrayr42d(i,j) - if(abs(arrayr42d(i,j)-fillvalue) Date: Fri, 28 Jul 2023 08:59:39 -0400 Subject: [PATCH 11/48] Ignore empty output bundle (#679) * If the output bundle has no fields do not attempt to get a grid * Comment out return status check after recover_fields --- fv3_cap.F90 | 14 ++++++++++---- io/module_wrt_grid_comp.F90 | 20 ++++++++++++++++---- 2 files changed, 26 insertions(+), 8 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 50ad49104..3cab15268 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -1097,6 +1097,7 @@ subroutine ModelAdvance_phase2(gcomp, rc) character(240) :: msgString type(ESMF_Clock) :: clock, clock_out + integer :: fieldCount !----------------------------------------------------------------------------- @@ -1147,12 +1148,17 @@ subroutine ModelAdvance_phase2(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif - ! execute the routehandle from fcstFB -> wrtFB (either Regrid() or Redist()) - call ESMF_FieldBundleSMM(fcstFB(j), wrtFB(j,n_group), & - routehandle=routehandle(j, n_group), & - termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + ! execute the routehandle from fcstFB -> wrtFB (either Regrid() or Redist()), only if there are fields in the bundle + call ESMF_FieldBundleGet(fcstFB(j), fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fieldCount > 0) then + call ESMF_FieldBundleSMM(fcstFB(j), wrtFB(j,n_group), & + routehandle=routehandle(j, n_group), & + termorderflag=(/ESMF_TERMORDER_SRCSEQ/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + enddo call ESMF_VMEpochExit(rc=rc) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 3cd17002f..a9622d1fe 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -876,11 +876,14 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif ! deal with all of the Fields inside this fcstFB - call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, grid=fcstGrid, rc=rc) + call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (fieldCount > 0) then + call ESMF_FieldBundleGet(fcstFB, grid=fcstGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(fcstField(fieldCount)) call ESMF_FieldBundleGet(fcstFB, fieldList=fcstField, & itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) @@ -1979,6 +1982,11 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !recover fields from cartesian vector and sfc pressure call recover_fields(file_bundle,rc) + ! FIXME rrfs_smoke_conus13km_fast_phy32_qr crashes with teh following error in recover_fields + ! 20230720 121647.816 ERROR PET147 ESMF_Grid.F90:20442 ESMF_GridGetCoord2DR8 Arguments are incompatible - - farrayPtr typekind does not match Grid typekind + ! 20230720 121647.816 ERROR PET147 module_wrt_grid_comp.F90:2450 Arguments are incompatible - Passing error in return code + + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo ! !----------------------------------------------------------------------- @@ -2426,10 +2434,14 @@ subroutine recover_fields(file_bundle,rc) real(ESMF_KIND_R8) :: coslon, sinlon, sinlat ! ! get filed count - call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, & - grid=fieldGrid, rc=rc) + call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + + if (fieldCount == 0) return + + call ESMF_FieldBundleGet(file_bundle, grid=fieldGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite("call recover field on wrt comp",ESMF_LOGMSG_INFO,rc=RC) call ESMF_GridGet(fieldgrid, dimCount=gridDimCount, rc=rc) From f595b972ab0a099a8ef13ddad313ec2c0d8672d4 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Mon, 31 Jul 2023 15:17:42 -0400 Subject: [PATCH 12/48] Use inline post with cubed sphere history output (#680) * Add option to output top parent history file on cubed sphere grid * Rename module_configure parameter, history_file_on_native_grid --- fv3_cap.F90 | 9 +- io/module_write_netcdf.F90 | 58 +++++------ io/module_wrt_grid_comp.F90 | 172 ++++++++++++++++++++----------- io/post_fv3.F90 | 4 +- module_fcst_grid_comp.F90 | 198 ++++++++++++++---------------------- 5 files changed, 228 insertions(+), 213 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 3cab15268..1bca9b004 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -209,7 +209,7 @@ subroutine InitializeAdvertise(gcomp, rc) integer :: wrttasks_per_group_from_parent, wrtLocalPet, num_threads character(len=64) :: rh_filename logical :: use_saved_routehandles, rh_file_exist - logical :: fieldbundle_is_restart = .false. + logical :: fieldbundle_uses_redist = .false. integer :: sloc type(ESMF_StaggerLoc) :: staggerloc @@ -698,11 +698,12 @@ subroutine InitializeAdvertise(gcomp, rc) if(mype == 0) print *,'af get wrtfb=',"output_"//trim(fcstItemNameList(j)),' rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - fieldbundle_is_restart = .false. + fieldbundle_uses_redist = .false. + ! if (fcstItemNameList(j)(1:8) == "restart_" .or. fcstItemNameList(j)(1:18) == "cubed_sphere_grid_") then if (fcstItemNameList(j)(1:8) == "restart_") then ! restart output forecast bundles, no need to set regridmethod ! Redist will be used instead of Regrid - fieldbundle_is_restart = .true. + fieldbundle_uses_redist = .true. else ! history output forecast bundles ! determine regridmethod @@ -739,7 +740,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else ! this is a Store() for the first wrtComp -> must do the Store() - if (fieldbundle_is_restart) then + if (fieldbundle_uses_redist) then call ESMF_TraceRegionEnter("ESMF_FieldBundleRedistStore()", rc=rc) call ESMF_FieldBundleRedistStore(fcstFB(j), wrtFB(j,1), & routehandle=routehandle(j,1), & diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 380ea5975..4b0506549 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -11,7 +11,7 @@ module module_write_netcdf use netcdf use module_fv3_io_def,only : ideflate, nbits, & ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d, & - output_grid,dx,dy,lon1,lat1,lon2,lat2, & + dx,dy,lon1,lat1,lon2,lat2, & time_unlimited use mpi @@ -95,6 +95,7 @@ subroutine write_netcdf(wrtfb, filename, & integer, dimension(:), allocatable :: deToTileMap, localDeToDeMap logical :: do_io integer :: par_access + character(len=ESMF_MAXSTR) :: output_grid_name ! is_cubed_sphere = .false. tileCount = 0 @@ -106,13 +107,15 @@ subroutine write_netcdf(wrtfb, filename, & do_io = par .or. (mype==0) call ESMF_FieldBundleGet(wrtfb, fieldCount=fieldCount, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_AttributeGet(wrtfb, convention="NetCDF", purpose="FV3", & + name='grid', value=output_grid_name, rc=rc); ESMF_ERR_RETURN(rc) allocate(compress_err(fieldCount)); compress_err=-999. allocate(fldlev(fieldCount)) ; fldlev = 0 allocate(fcstField(fieldCount)) allocate(varids(fieldCount)) - call ESMF_FieldBundleGet(wrtfb, fieldList=fcstField, grid=wrtGrid, & + call ESMF_FieldBundleGet(wrtfb, fieldList=fcstField, grid=wrtgrid, & ! itemorderflag=ESMF_ITEMORDER_ADDORDER, & rc=rc); ESMF_ERR_RETURN(rc) @@ -162,6 +165,10 @@ subroutine write_netcdf(wrtfb, filename, & start_i = 1 start_j = 1 end if + if (is_cubed_sphere) then + start_i = mod(start_i, im) + start_j = mod(start_j, jm) + end if end if if (fieldDimCount > gridDimCount) then @@ -240,21 +247,18 @@ subroutine write_netcdf(wrtfb, filename, & ncerr = nf90_put_att(ncid, timeiso_varid, "_Encoding", "UTF-8"); NC_ERR_STOP(ncerr) ! coordinate variable attributes based on output_grid type - if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & - trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon_moving') then + if (trim(output_grid_name) == 'gaussian' .or. & + trim(output_grid_name) == 'latlon') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "T-cell longitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "degrees_E"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "T-cell latiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "rotated T-cell longiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "degrees"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "rotated T-cell latiitude"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "units", "degrees"); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then ncerr = nf90_put_att(ncid, im_varid, "long_name", "x-coordinate of projection"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, "units", "meters"); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, "long_name", "y-coordinate of projection"); NC_ERR_STOP(ncerr) @@ -466,10 +470,10 @@ subroutine write_netcdf(wrtfb, filename, & ! write lon (lon_varid) if (par) then - call ESMF_GridGetCoord(wrtGrid, coordDim=1, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=1, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) ncerr = nf90_put_var(ncid, lon_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) else - call ESMF_GridGetCoord(wrtGrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=1, array=array, rc=rc); ESMF_ERR_RETURN(rc) if (is_cubed_sphere) then do t=1,tileCount call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) @@ -491,39 +495,35 @@ subroutine write_netcdf(wrtfb, filename, & ! write grid_xt (im_varid) if (do_io) then allocate (x(im)) - if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & - trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon_moving') then + if (trim(output_grid_name) == 'gaussian' .or. trim(output_grid_name) == 'latlon') then ncerr = nf90_put_var(ncid, im_varid, values=array_r8(:,jstart), start=[istart], count=[iend-istart+1]); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon') then do i=1,im x(i) = lon1(grid_id) + (lon2(grid_id)-lon1(grid_id))/(im-1) * (i-1) end do ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then do i=1,im x(i) = dx(grid_id) * (i-1) end do ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + else if (trim(output_grid_name) == 'cubed_sphere') then do i=1,im x(i) = i end do ncerr = nf90_put_var(ncid, im_varid, values=x); NC_ERR_STOP(ncerr) else - if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid(grid_id)) + if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid_name) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if end if ! write lat (lat_varid) if (par) then - call ESMF_GridGetCoord(wrtGrid, coordDim=2, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=2, farrayPtr=array_r8, rc=rc); ESMF_ERR_RETURN(rc) ncerr = nf90_put_var(ncid, lat_varid, values=array_r8, start=start_idx); NC_ERR_STOP(ncerr) else - call ESMF_GridGetCoord(wrtGrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc) + call ESMF_GridGetCoord(wrtgrid, coordDim=2, array=array, rc=rc); ESMF_ERR_RETURN(rc) if (is_cubed_sphere) then do t=1,tileCount call ESMF_ArrayGather(array, array_r8_cube(:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) @@ -542,29 +542,25 @@ subroutine write_netcdf(wrtfb, filename, & ! write grid_yt (jm_varid) if (do_io) then allocate (y(jm)) - if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & - trim(output_grid(grid_id)) == 'global_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon_moving') then + if (trim(output_grid_name) == 'gaussian' .or. trim(output_grid_name) == 'latlon') then ncerr = nf90_put_var(ncid, jm_varid, values=array_r8(istart,:), start=[jstart], count=[jend-jstart+1]); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'rotated_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon') then do j=1,jm y(j) = lat1(grid_id) + (lat2(grid_id)-lat1(grid_id))/(jm-1) * (j-1) end do ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then do j=1,jm y(j) = dy(grid_id) * (j-1) end do ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) - else if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + else if (trim(output_grid_name) == 'cubed_sphere') then do j=1,jm y(j) = j end do ncerr = nf90_put_var(ncid, jm_varid, values=y); NC_ERR_STOP(ncerr) else - if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid(grid_id)) + if (mype==0) write(0,*)'unknown output_grid ', trim(output_grid_name) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if end if diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index a9622d1fe..97dcf2d1b 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -163,6 +163,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, type(ESMF_DELayout) :: delayout type(ESMF_Grid) :: fcstGrid type(ESMF_Grid), allocatable :: wrtGrid(:) + type(ESMF_Grid) :: wrtGrid_cubed_sphere + logical :: create_wrtGrid_cubed_sphere = .true. type(ESMF_Grid) :: actualWrtGrid type(ESMF_Array) :: array type(ESMF_Field) :: field_work, field @@ -208,6 +210,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, type(ESMF_DistGrid) :: acceptorDG, newAcceptorDG integer :: grid_id + + logical :: history_file_on_native_grid + character(len=esmf_maxstr) :: output_grid_name ! !----------------------------------------------------------------------- !*********************************************************************** @@ -480,10 +485,35 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif + call ESMF_ConfigGetAttribute(config=CF, value=history_file_on_native_grid, default=.false., & + label='history_file_on_native_grid:', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +#if 1 + if (n == 1 .and. top_parent_is_global .and. history_file_on_native_grid) then + do tl=1,6 + decomptile(1,tl) = 1 + decomptile(2,tl) = jidx + decompflagPTile(:,tl) = (/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/) + enddo + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & + name="gridfile", value=gridfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + wrtGrid_cubed_sphere = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & + regDecompPTile=decomptile,tileFilePath="INPUT/", & + decompflagPTile=decompflagPTile, & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & + name='wrt_grid', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + create_wrtGrid_cubed_sphere = .false. + endif +#endif + if ( trim(output_grid(n)) == 'cubed_sphere_grid' ) then !*** Create cubed sphere grid from file - if (top_parent_is_global .and. n==1) then - gridfile = 'grid_spec.nc' ! global top-level parent + if (top_parent_is_global .and. n == 1) then do tl=1,6 decomptile(1,tl) = 1 decomptile(2,tl) = jidx @@ -493,7 +523,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="gridfile", value=gridfile, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) wrtGrid(n) = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & regDecompPTile=decomptile,tileFilePath="INPUT/", & decompflagPTile=decompflagPTile, & @@ -528,8 +557,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (lprnt) print *,'in nested/regional cubed_sphere grid, regDecomp=',regDecomp,' PetMap=',petMap(1),petMap(ntasks), & - 'gridfile=',trim(gridfile) deallocate(petMap) endif else ! non 'cubed_sphere_grid' @@ -869,7 +896,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_StateAdd(imp_state_write, (/mirrorFB/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! copy the fcstFB Attributes to the 'mirror_' FieldBundle + ! copy the fcstFB Attributes to the 'mirror_' FieldBundle call ESMF_AttributeCopy(fcstFB, mirrorFB, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -889,12 +916,31 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - actualWrtGrid = wrtGrid(grid_id) + if (fcstItemNameList(i)(1:18) == 'cubed_sphere_grid_') then + + if (create_wrtGrid_cubed_sphere) then + ! create a grid from fcstGrid on forecast grid comp, by rebalancing distgrid to the local PETs + ! access the acceptor DistGrid + call ESMF_GridGet(fcstGrid, distgrid=acceptorDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! rebalance the acceptor DistGrid across the local PETs + newAcceptorDG = ESMF_DistGridCreate(acceptorDG, balanceflag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + wrtGrid_cubed_sphere = ESMF_GridCreate(fcstGrid, newAcceptorDG, copyAttributes=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + create_wrtGrid_cubed_sphere = .false. + end if + + actualWrtGrid = wrtGrid_cubed_sphere + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", name="output_grid", value="cubed_sphere_grid", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + else if (fcstItemNameList(i)(1:8) == 'restart_') then + ! If this is a 'restart' bundle the actual grid that the output field ('field_work' below) is created on + ! must be the same grid as forecast grid, not the output grid for this grid_id (wrtGrid(grid_id)). + ! For 'cubed_sphere_grid' these are the same, but for all other output grids (like Lambert) they are not. - ! If this is a 'restart' bundle the actual grid that the output field ('field_work' below) is created on - ! must be the same grid as forecast grid, not the output grid for this grid_id (wrtGrid(grid_id)). - ! For 'cubed_sphere_grid' these are the same, but for all other output grids (like Lambert) they are not. - if (fcstItemNameList(i)(1:8) == 'restart_') then ! create a grid from fcstGrid on forecast grid comp, by rebalancing distgrid to the local PETs ! access the acceptor DistGrid call ESMF_GridGet(fcstGrid, distgrid=acceptorDG, rc=rc) @@ -904,7 +950,11 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return actualWrtGrid = ESMF_GridCreate(fcstGrid, newAcceptorDG, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if ! end of setting actualWrtGrid for restart bundle + else + actualWrtGrid = wrtGrid(grid_id) + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", name="output_grid", value=output_grid(grid_id), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if do j=1, fieldCount @@ -928,7 +978,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! 'gridToFieldMap=',gridToFieldMap,'ungriddedLBound=',ungriddedLBound, & ! 'ungriddedUBound=',ungriddedUBound,'rc=',rc -! create the output field on output grid + ! create the output field on output grid field_work = ESMF_FieldCreate(actualWrtGrid, typekind, name=fieldName, & ! use actualWrtGrid instead of wrtGrid(grid_id) staggerloc=staggerloc, & gridToFieldMap=gridToFieldMap, & @@ -939,7 +989,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeCopy(fcstField(j), field_work, attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! get output file name + ! get output file name call ESMF_AttributeGet(fcstField(j), convention="NetCDF", purpose="FV3", & name="output_file", value=outfile_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -950,13 +1000,13 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif call ESMF_LogWrite("af fcstfield, get output_file",ESMF_LOGMSG_INFO,rc=RC) -! if (lprnt) print *,' i=',i,' j=',j,' outfilename=',trim(outfilename(j,i)) + ! if (lprnt) print *,' i=',i,' j=',j,' outfilename=',trim(outfilename(j,i)) -! add the output field to the 'output_' FieldBundle + ! add the output field to the 'output_' FieldBundle call ESMF_FieldBundleAdd(fieldbundle, (/field_work/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! deal with grids for which 'is_moving' is .true. + ! deal with grids for which 'is_moving' is .true. if (is_moving(grid_id)) then ! create an empty field that will serve as acceptor for GridTransfer of fcstGrid field_work = ESMF_FieldEmptyCreate(name=fieldName, rc=rc) @@ -984,11 +1034,10 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif -! local garbage collection + ! local garbage collection deallocate(gridToFieldMap, ungriddedLBound, ungriddedUBound) enddo -! - ! call ESMF_AttributeCopy(fcstGrid, wrtGrid(grid_id), & + call ESMF_AttributeCopy(fcstGrid, actualWrtGrid , & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1003,15 +1052,13 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, return endif -!end FBCount - enddo -! -!loop over all items in the imp_state_write and count output FieldBundles + enddo !FBCount + + !loop over all items in the imp_state_write and count output FieldBundles call get_outfile(FBCount, outfilename, FBlist_outfilename, noutfile) wrt_int_state%FBCount = noutfile -! -!create output field bundles + !create output field bundles allocate(wrt_int_state%wrtFB(wrt_int_state%FBCount)) ! if (lprnt) write(0,*)'wrt_initialize_p1: allocated ',wrt_int_state%FBCount, ' wrt_int_state%wrtFB' @@ -1019,7 +1066,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, wrt_int_state%wrtFB(i) = ESMF_FieldBundleCreate(name=trim(FBlist_outfilename(i)), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! if (lprnt) write(0,*)'wrt_initialize_p1: created wrtFB ',i, ' with name ', trim(wrt_int_state%wrtFB_names(i)) + ! if (lprnt) write(0,*)'wrt_initialize_p1: created wrtFB ',i, ' with name ', trim(FBlist_outfilename(i)) ! if (lprnt) write(0,*)'wrt_initialize_p1: loop over ', FBCount, ' forecast bundles' do n=1, FBCount @@ -1032,9 +1079,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! if (lprnt) write(0,*)'wrt_initialize_p1: is ', trim(fcstItemNameList(n)), ' == ', trim(FBlist_outfilename(i)) if (trim_regridmethod_suffix(fcstItemNameList(n)) == trim_regridmethod_suffix(FBlist_outfilename(i))) then -! -! copy the fcstfield bundle Attributes to the output field bundle - ! if (lprnt) write(0,*)'wrt_initialize_p1: copy atts/fields from ', "output_"//trim(fcstItemNameList(n)), ' to ', trim(wrt_int_state%wrtFB_names(i)) + + ! copy the fcstfield bundle Attributes to the output field bundle + ! if (lprnt) write(0,*)'wrt_initialize_p1: copy atts/fields from ', "output_"//trim(fcstItemNameList(n)), ' to ', trim(FBlist_outfilename(i)) call ESMF_AttributeCopy(fcstFB, wrt_int_state%wrtFB(i), & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) @@ -1062,10 +1109,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if (lprnt) print *,'in wrt,add field,i=',i,'n=',n,' j=',j, & -! 'fieldname=',trim(fieldnamelist(j)), ' outfile_name=',trim(outfile_name), & -! ' field bundle name, FBlist_outfilename(i)=',trim(FBlist_outfilename(i)) - if( trim(outfile_name) == trim(FBlist_outfilename(i))) then call ESMF_FieldBundleAdd(wrt_int_state%wrtFB(i), (/fcstField(j)/), rc=rc) @@ -1077,21 +1120,26 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif ! index(trim(fcstItemNameList(n)),trim(FBlist_outfilename(i))) - enddo ! end FBCount + enddo ! FBCount -! add output grid related attributes + ! add output grid related attributes, only for history files(bundles), skip restart + if (FBlist_outfilename(i)(1:8) /= 'restart_') then + + call ESMF_AttributeGet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3-nooutput", & + name="output_grid", value=output_grid_name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & attrList=(/"source","grid "/), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="source", value="FV3GFS", rc=rc) - if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + if (trim(output_grid_name) == 'cubed_sphere_grid') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="cubed_sphere", rc=rc) - else if (trim(output_grid(grid_id)) == 'gaussian_grid') then + else if (trim(output_grid_name) == 'gaussian_grid') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="gaussian", rc=rc) @@ -1102,9 +1150,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="jm", value=jmo(grid_id), rc=rc) - else if (trim(output_grid(grid_id)) == 'regional_latlon' & - .or. trim(output_grid(grid_id)) == 'regional_latlon_moving' & - .or. trim(output_grid(grid_id)) == 'global_latlon') then + else if (trim(output_grid_name) == 'regional_latlon' & + .or. trim(output_grid_name) == 'regional_latlon_moving' & + .or. trim(output_grid_name) == 'global_latlon') then ! for 'regional_latlon_moving' lon1/2 and lat1/2 will be overwritten in run phase call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1115,7 +1163,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="dlon", value=dlon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="dlat", value=dlat(grid_id), rc=rc) - if (trim(output_grid(grid_id)) /= 'regional_latlon_moving') then + if (trim(output_grid_name) /= 'regional_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lon1", value=lon1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1125,8 +1173,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lat2", value=lat2(grid_id), rc=rc) endif - else if (trim(output_grid(grid_id)) == 'rotated_latlon' & - .or. trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + else if (trim(output_grid_name) == 'rotated_latlon' & + .or. trim(output_grid_name) == 'rotated_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="rotated_latlon", rc=rc) @@ -1148,7 +1196,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="dlon", value=dlon(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="dlat", value=dlat(grid_id), rc=rc) - if (trim(output_grid(grid_id)) /= 'rotated_latlon_moving') then + if (trim(output_grid_name) /= 'rotated_latlon_moving') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lon1", value=lon1(grid_id), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1158,7 +1206,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="lat2", value=lat2(grid_id), rc=rc) endif - else if (trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid_name) == 'lambert_conformal') then call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & name="grid", value="lambert_conformal", rc=rc) @@ -1195,6 +1243,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, name="dy", value=dy(grid_id), rc=rc) end if + end if enddo ! end wrt_int_state%FBCount ! @@ -1238,14 +1287,19 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif enddo - do n = 1, ngrids -! add the transfer attributes from importState to grid + ! add the transfer attributes from importState to grid call ESMF_AttributeAdd(wrtGrid(n), convention="NetCDF", purpose="FV3", & attrList=attNameList(1:j-1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! add the transfer attributes from importState to special cubed_sphere grid + if (n == 1 .and. top_parent_is_global .and. history_file_on_native_grid) then + call ESMF_AttributeAdd(wrtGrid_cubed_sphere, convention="NetCDF", purpose="FV3", & + attrList=attNameList(1:j-1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + ! loop over the added attributes, access the value (only scalar allowed), ! and set them on the grid do i=1, j-1 @@ -1269,9 +1323,14 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, endif call ESMF_AttributeSet(wrtGrid(n), convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (n == 1 .and. top_parent_is_global .and. history_file_on_native_grid) then + call ESMF_AttributeSet(wrtGrid_cubed_sphere, convention="NetCDF", purpose="FV3", & + name=trim(attNameList(i)), value=valueS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + else if (typekindList(i) == ESMF_TYPEKIND_I4) then call ESMF_AttributeGet(imp_state_write, & convention="NetCDF", purpose="FV3", & @@ -1807,6 +1866,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) fieldbundle=mirror_bundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if (fcstItemNameList(i)(1:8) == "restart_" .or. fcstItemNameList(i)(1:18) == 'cubed_sphere_grid_') then if (fcstItemNameList(i)(1:8) == "restart_") then ! restart output forecast bundles, use Redist instead of Regrid @@ -2012,6 +2072,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle call mask_fields(wrt_int_state%wrtFB(nbdl),rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -3302,7 +3363,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) trim(tileFileName), ESMF_LOGMSG_INFO, rc=rc) if (status == ESMF_FILESTATUS_OLD) then - ! This writes the vectical coordinates and the time dimension into the + ! This writes the vertical coordinates and the time dimension into the ! file. Doing this before the large data sets are written, assuming that ! the first time coming into ioCompRun() with this tileFileName, only ! the grid info is written. Second time in, with ESMF_FILESTATUS_OLD, @@ -3326,7 +3387,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) ncerr = nf90_open(tileFileName, NF90_WRITE, ncid=ncid) if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - ! loop over all the fields in the bundle and handle their vectical dims + ! loop over all the fields in the bundle and handle their vertical dims thereAreVerticals = .false. do i=1, fieldCount @@ -3459,7 +3520,6 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) attName = attNameList(i) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), typekind=typekind, rc=rc) -! print *,'in esmf call, att name=',trim(attNameList(i)) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -3467,7 +3527,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueS, rc=rc) -! print *,'in esmf call, att string value=',trim(valueS) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ncerr = nf90_put_att(ncid, varid, & @@ -3480,7 +3540,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueI4, rc=rc) -! print *,'in esmf call, att I4 value=',valueR8 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ncerr = nf90_put_att(ncid, varid, & trim(attName(6:len(attName))), values=valueI4) @@ -3491,7 +3551,6 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR4, rc=rc) -! print *,'in esmf call, att r4 value=',valueR8 if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -3504,7 +3563,6 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR8, rc=rc) -! print *,'in esmf call, att r8 value=',valueR8 if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ncerr = nf90_put_att(ncid, varid, & diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index f8dcc80de..696a6b026 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -258,6 +258,7 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle ! set grid spec: ! if(mype==0) print*,'in post_getattr_lam,output_grid=',trim(output_grid(grid_id)),'nfb=',nfb @@ -775,7 +776,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return if (wrtFBName(1:8) == 'restart_') cycle - + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle call ESMF_AttributeGet(wrt_int_state%wrtFB(ibdl), convention="NetCDF", purpose="FV3", & name="grid_id", value=bundle_grid_id, rc=rc) @@ -866,6 +867,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) line=__LINE__, file=__FILE__)) return ! bail out if (wrtFBName(1:8) == 'restart_') cycle + if (wrtFBName(1:18) == 'cubed_sphere_grid_') cycle call ESMF_AttributeGet(wrt_int_state%wrtFB(ibdl), convention="NetCDF", purpose="FV3", & name="grid_id", value=bundle_grid_id, rc=rc) diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 6557f76f8..1c2c628ed 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -317,9 +317,11 @@ subroutine init_dyn_fb(nest, importState, exportState, clock, rc) integer,intent(out) :: rc type(ESMF_Grid) :: grid - integer :: itemCount - character(len=ESMF_MAXSTR) :: itemNameList(1), fb_name - type(ESMF_FieldBundle) :: fb, fcstFB + integer :: itemCount, i + character(len=ESMF_MAXSTR), allocatable :: itemNameList(:) + character(len=ESMF_MAXSTR) :: fb_name + type(ESMF_FieldBundle), allocatable :: fbList(:) + type(ESMF_FieldBundle) :: fcstFB call ESMF_GridCompGet(nest, grid=grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -327,42 +329,43 @@ subroutine init_dyn_fb(nest, importState, exportState, clock, rc) call ESMF_StateGet(importState, itemCount=itemCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (itemCount /= 1) then - ! error condition, expect exactly one dynamics field bundle - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="Expecting exactly one dynamics field bundle.", line=__LINE__, file=__FILE__) - endif + allocate(itemNameList(itemCount), fbList(itemCount)) call ESMF_StateGet(importState, itemNameList=itemNameList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_StateGet(importState, itemName=itemNameList(1), fieldbundle=fcstFB, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + do i=1, itemCount + call ESMF_StateGet(importState, itemName=itemNameList(i), fieldbundle=fcstFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - fb = ESMF_FieldBundleCreate(name=itemNameList(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + fbList(i) = ESMF_FieldBundleCreate(name=itemNameList(i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeCopy(fcstFB, fb, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeCopy(fcstFB, fbList(i), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_StateAdd(exportState,(/fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_StateAdd(exportState, (/fbList(i)/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo - call ESMF_FieldBundleGet(fb, name=fb_name, rc=rc) + ! get the name of the first field bundle and based on that determine if it's a history or restart bundles + call ESMF_FieldBundleGet(fbList(1), name=fb_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (fb_name(1:19) == 'restart_fv_core.res') then - call fv_core_restart_bundle_setup(fb, grid, rc=rc) + call fv_core_restart_bundle_setup(fbList(1), grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else if (fb_name(1:22) == 'restart_fv_srf_wnd.res') then - call fv_srf_wnd_restart_bundle_setup(fb, grid, rc=rc) + call fv_srf_wnd_restart_bundle_setup(fbList(1), grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else if (fb_name(1:21) == 'restart_fv_tracer.res') then - call fv_tracer_restart_bundle_setup(fb, grid, rc=rc) + call fv_tracer_restart_bundle_setup(fbList(1), grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else - call fv_dyn_bundle_setup(Atmos%axes, fb, grid, quilting=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + do i=1, itemCount + call fv_dyn_bundle_setup(Atmos%axes, fbList(i), grid, quilting=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do endif end subroutine init_dyn_fb @@ -541,10 +544,6 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) character(256) :: gridfile character(8) :: bundle_grid - type(ESMF_FieldBundle),dimension(:), allocatable :: fieldbundle ! dynamics hystory bundles - type(ESMF_FieldBundle),dimension(:,:), allocatable :: fieldbundle_dyn_restart ! dynamics restart bundles - type(ESMF_FieldBundle),dimension(:,:), allocatable :: fieldbundlephys ! physics hystory bundles - type(ESMF_FieldBundle),dimension(:,:), allocatable :: fieldbundle_phy_restart ! physics restart bundles real(kind=8) :: mpi_wtime, timeis @@ -564,6 +563,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) integer :: layout(2), nx, ny integer, pointer :: pelist(:) => null() logical :: top_parent_is_global + logical :: history_file_on_native_grid integer :: num_restart_interval, restart_starttime real,dimension(:),allocatable :: restart_interval @@ -985,12 +985,10 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! Create FieldBundle for Fields that need to be regridded bilinear if( quilting ) then - allocate(fieldbundle(ngrids)) - nbdlphys = 2 - allocate(fieldbundlephys(nbdlphys,ngrids)) + call ESMF_ConfigGetAttribute(config=CF, value=history_file_on_native_grid, default=.false., label='history_file_on_native_grid:', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(fieldbundle_dyn_restart(ngrids,3)) ! fv_core.res fv_srf_wnd.res fv_tracer.res - allocate(fieldbundle_phy_restart(ngrids,2)) ! phy_data sfc_data + nbdlphys = 2 do n=1,ngrids bundle_grid='' @@ -1005,69 +1003,41 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name_FB = trim(filename_base(i)) // trim(bundle_grid) ! - if( i==1 ) then -! for dyn + if (i == 1) then ! for dyn name_FB1 = trim(name_FB)//'_bilinear' - fieldbundle(n) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle(n), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB1), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(fieldbundle(n), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle(n), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle(n), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateAdd(tempState, (/fieldbundle(n)/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (n == 1 .AND. top_parent_is_global .AND. history_file_on_native_grid) then + call create_bundle_and_add_it_to_state('cubed_sphere_grid_'//trim(name_FB1), tempState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState,& - exportState=exportState, phase=1, userrc=urc, rc=rc) + exportState=exportState, phase=1, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - else if( i==2 ) then -! for phys + else if (i == 2) then ! for phys + do j=1, nbdlphys - if( j==1 ) then + if (j == 1) then name_FB1 = trim(name_FB)//'_nearest_stod' else name_FB1 = trim(name_FB)//'_bilinear' endif - fieldbundlephys(j,n) = ESMF_FieldBundleCreate(name=trim(name_FB1),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB1), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeAdd(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundlephys(j,n), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (n == 1 .AND. top_parent_is_global .AND. history_file_on_native_grid) then + call create_bundle_and_add_it_to_state('cubed_sphere_grid_'//trim(name_FB1), tempState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif - call ESMF_StateAdd(tempState, (/fieldbundlephys(j,n)/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState,& - exportState=exportState, phase=2, userrc=urc, rc=rc) + exportState=exportState, phase=2, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -1106,26 +1076,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name_FB = trim(name_FB)//nest_suffix endif - fieldbundle_dyn_restart(n,i) = ESMF_FieldBundleCreate(name=trim(name_FB),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_dyn_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateAdd(tempState, (/fieldbundle_dyn_restart(n,i)/), rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState, & @@ -1157,26 +1108,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) name_FB = trim(name_FB)//nest_suffix endif - fieldbundle_phy_restart(n,i) = ESMF_FieldBundleCreate(name=trim(name_FB),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3", & - attrList=(/"grid_id"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3", & - name="grid_id", value=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - attrList=(/"frestart"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeSet(fieldbundle_phy_restart(n,i), convention="NetCDF", purpose="FV3-nooutput", & - name="frestart", valueList=frestart, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_StateAdd(tempState, (/fieldbundle_phy_restart(n,i)/), rc=rc) + call create_bundle_and_add_it_to_state(trim(name_FB), tempState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompInitialize(fcstGridComp(n), importState=tempState, & @@ -1192,11 +1124,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) enddo ! ngrids - ! total number of field bundles created is ngrids * (1(atm) + 2(phy) + 3(dyn_rest) +2(phy_rest) - if (mype == 0) write(*,*)'fcst_initialize: total number of field bundles: ', ngrids*(1+2+0+2) - -!end qulting - endif + endif ! quilting call get_atmos_model_ungridded_dim(nlev=numLevels, & nsoillev=numSoilLayers, & @@ -1206,6 +1134,36 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! !----------------------------------------------------------------------- ! + contains + + subroutine create_bundle_and_add_it_to_state(name_fb, state, rc) + + character(len=*), intent(in) :: name_fb + type(ESMF_State), intent(inout) :: state + integer, intent(out) :: rc + + type(ESMF_FieldBundle) :: fieldbundle + + fieldbundle = ESMF_FieldBundleCreate(name=trim(name_fb), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeAdd(fieldbundle, convention="NetCDF", purpose="FV3", attrList=(/"grid_id"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3", name="grid_id", value=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeAdd(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", attrList=(/"frestart"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeSet(fieldbundle, convention="NetCDF", purpose="FV3-nooutput", name="frestart", valueList=frestart, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateAdd(state, (/fieldbundle/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine create_bundle_and_add_it_to_state + end subroutine fcst_initialize ! !----------------------------------------------------------------------- From deeac5f0acb875f8a282200ebdc69d6157232163 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 14 Aug 2023 16:16:38 -0400 Subject: [PATCH 13/48] Change signs of exported fields from ATM (#675) * switch sign on mean momentum fluxes * send mean momentum fluxes to mediator w/ correct sign for coupling * fix variable alignment in module_block_data * change sign of exported sensible heat flux * add evap fields for atm export * change sign for exported latent heat flux --- atmos_model.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 6725b1809..2fa6788cd 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -2923,19 +2923,19 @@ subroutine setup_exportdata(rc) call block_data_copy(datar82d, GFS_data(nb)%coupling%v10mi_cpl, Atm_block, nb, rc=localrc) ! Instantaneous Zonal compt of momentum flux (N/m**2) case ('inst_zonal_moment_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Merid compt of momentum flux (N/m**2) case ('inst_merid_moment_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Sensible heat flux (W/m**2) case ('inst_sensi_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Latent heat flux (W/m**2) case ('inst_laten_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, -one, spval, rc=localrc) ! Instantaneous Evap flux (kg/m**2/s) case ('inst_evap_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, revap, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, -revap, spval, rc=localrc) ! Instantaneous Downward long wave radiation flux (W/m**2) case ('inst_down_lw_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfci_cpl, Atm_block, nb, rc=localrc) @@ -2993,19 +2993,19 @@ subroutine setup_exportdata(rc) !--- Mean quantities ! MEAN Zonal compt of momentum flux (N/m**2) case ('mean_zonal_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Merid compt of momentum flux (N/m**2) case ('mean_merid_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Sensible heat flux (W/m**2) case ('mean_sensi_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Latent heat flux (W/m**2) case ('mean_laten_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, -rtime, spval, rc=localrc) ! MEAN Evap rate (kg/m**2/s) case ('mean_evap_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime*revap, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, -rtime*revap, spval, rc=localrc) ! MEAN Downward LW heat flux (W/m**2) case ('mean_down_lw_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) From 7b2d88ac3849a3d813975bde20428260b0f07737 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 18 Aug 2023 11:03:09 -0400 Subject: [PATCH 14/48] Few small fixes to Thompson MP (#654) * point to Greg's bugfix branch: few small fixes to Thompson MP --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 9b6997449..af890d4ee 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9b69974496a208e26feef30d0b0e405ac4e023b9 +Subproject commit af890d4ee181c503b09dc0e035820a2af040b14b From 94a49f8e74c59851473b5f0bde9d97e7f6afc33f Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Tue, 22 Aug 2023 09:42:43 -0400 Subject: [PATCH 15/48] Changes to Logging and Initialization of the CLM Lake Model (#681) * Changes to logging and initialization of the CLM Lake Model. 1. Use ice thickness hice(i) to find the level in the lake where ice is zero. 2. Do not allow lake temperature to be below freezing point if there is no ice. 3. If there is no snow or ice, do not allow surface lake temperature to be below freezing point. These changes fixed the problem with large errors in the energy budget at the beginning of the cold-start run with lakes. 4. Added flag to turn on debug print statements in the CLM lake model. * merge ccpp-physics #91 (UFS-SRW v3.0.0 SciDoc updates) --- ccpp/data/GFS_typedefs.F90 | 8 ++++++-- ccpp/data/GFS_typedefs.meta | 6 ++++++ ccpp/driver/GFS_diagnostics.F90 | 4 ++-- ccpp/physics | 2 +- 4 files changed, 15 insertions(+), 5 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d0b19327c..80826ba42 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1082,6 +1082,7 @@ module GFS_typedefs real(kind_phys) :: clm_lake_depth_default !< minimum lake elevation in clm lake model logical :: clm_lake_use_lakedepth !< initialize lake from lakedepth logical :: clm_lake_debug !< verbose debugging in clm_lake + logical :: clm_debug_print !< enables prints in clm_lakedebugging in clm_laki !--- tuning parameters for physical parameterizations logical :: ras !< flag for ras convection scheme @@ -3461,6 +3462,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind_phys) :: clm_lake_depth_default = 50 !< default lake depth in clm lake model logical :: clm_lake_use_lakedepth = .true. !< initialize depth from lakedepth logical :: clm_lake_debug = .false. !< verbose debugging in clm_lake + logical :: clm_debug_print = .false. !< enables prints in clm_lake !--- land/surface model parameters integer :: lsm = 1 !< flag for land surface model to use =0 for osu lsm; =1 for noah lsm; =2 for noah mp lsm; =3 for RUC lsm @@ -3706,7 +3708,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid = .false. !< flag for fractional grid - logical :: frac_ice = .false. !< flag for fractional ice when fractional grid is not in use + logical :: frac_ice = .true. !< flag for lake fractional ice when fractional grid is not in use logical :: ignore_lake = .true. !< flag for ignoring lakes real(kind=kind_phys) :: min_lakeice = 0.15d0 !< minimum lake ice value real(kind=kind_phys) :: min_seaice = 1.0d-11 !< minimum sea ice value @@ -3915,7 +3917,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- lake model control lkm, iopt_lake, lakedepth_threshold, lakefrac_threshold, & clm_lake_depth_default, clm_lake_use_lakedepth, & - clm_lake_debug, use_lake2m, & + clm_lake_debug, clm_debug_print, use_lake2m, & !--- physical parameterizations ras, trans_trac, old_monin, cnvgwd, mstrat, moist_adj, & cscnv, cal_pre, do_aw, do_shoc, shocaftcnv, shoc_cld, & @@ -4649,6 +4651,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%clm_lake_depth_default = clm_lake_depth_default Model%clm_lake_use_lakedepth = clm_lake_use_lakedepth Model%clm_lake_debug = clm_lake_debug + Model%clm_debug_print = clm_debug_print ! Noah MP options from namelist ! @@ -5640,6 +5643,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' clm_lake_use_lakedepth = ',Model%clm_lake_use_lakedepth print *,' clm_lake_depth_default = ',Model%clm_lake_depth_default print *,' clm_lake_debug = ',Model%clm_lake_debug + print *,' clm_debug_print = ',Model%clm_debug_print print *,' nlevlake_clm_lake = ',Model%nlevlake_clm_lake print *,' nlevsoil_clm_lake = ',Model%nlevsoil_clm_lake print *,' nlevsnow_clm_lake = ',Model%nlevsnow_clm_lake diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 64e7ae5b7..9b54e5c2c 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -7147,6 +7147,12 @@ units = flag dimensions = () type = logical +[clm_debug_print] + standard_name = flag_for_printing_in_clm_lake_model + long_name = flag for printing in clm lake model + units = flag + dimensions = () + type = logical [fire_aux_data_levels] standard_name = fire_auxiliary_data_extent long_name = number of levels of fire auxiliary data diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index f14773d34..71c125bfe 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2696,8 +2696,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'lake_q2m' - ExtDiag(idx)%desc = 'Humidity at 2 m from Lake Model' - ExtDiag(idx)%unit = '%' + ExtDiag(idx)%desc = '2m specific humidity from Lake Model' + ExtDiag(idx)%unit = 'kg/kg' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) diff --git a/ccpp/physics b/ccpp/physics index af890d4ee..5b946850a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit af890d4ee181c503b09dc0e035820a2af040b14b +Subproject commit 5b946850af58e1cea8c37661158b661df21e9390 From 51e570cc9316911038c8a8f32c9d591ad317ee51 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Tue, 29 Aug 2023 10:47:34 -0400 Subject: [PATCH 16/48] Bug fixes for 32-bit physics & correct the lake scheme in FV3_HRRR_c3 & FV3_HRRR_gf (#692) * fix fortran coding error in dynamical core * use clm lake in fv3_hrrr_c3 * initialize arrays after allocation * ressurect FV3_HRRR_gf suite and give it the clm lake model * bug fix from Dusan to use the correct type kind when reading lan & lon in quilt server --- ccpp/suites/suite_FV3_HRRR_c3.xml | 2 +- .../suite_FV3_HRRR_gf.xml | 2 +- io/fv3atm_clm_lake_io.F90 | 60 ++++++++++++++++++- io/fv3atm_restart_io.F90 | 3 + io/module_wrt_grid_comp.F90 | 49 ++++++++++++--- 5 files changed, 104 insertions(+), 12 deletions(-) rename ccpp/{suites_not_used => suites}/suite_FV3_HRRR_gf.xml (98%) diff --git a/ccpp/suites/suite_FV3_HRRR_c3.xml b/ccpp/suites/suite_FV3_HRRR_c3.xml index ec55ee1ec..fe4feedc7 100644 --- a/ccpp/suites/suite_FV3_HRRR_c3.xml +++ b/ccpp/suites/suite_FV3_HRRR_c3.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/ccpp/suites_not_used/suite_FV3_HRRR_gf.xml b/ccpp/suites/suite_FV3_HRRR_gf.xml similarity index 98% rename from ccpp/suites_not_used/suite_FV3_HRRR_gf.xml rename to ccpp/suites/suite_FV3_HRRR_gf.xml index f8aade231..7e594e621 100644 --- a/ccpp/suites_not_used/suite_FV3_HRRR_gf.xml +++ b/ccpp/suites/suite_FV3_HRRR_gf.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/io/fv3atm_clm_lake_io.F90 b/io/fv3atm_clm_lake_io.F90 index 5c61a26be..80c7bb586 100644 --- a/io/fv3atm_clm_lake_io.F90 +++ b/io/fv3atm_clm_lake_io.F90 @@ -22,7 +22,7 @@ module fv3atm_clm_lake_io public :: clm_lake_data_type, clm_lake_register_axes, clm_lake_allocate_data, & clm_lake_register_fields, clm_lake_deallocate_data, clm_lake_write_axes, & clm_lake_copy_from_grid, clm_lake_copy_to_grid, clm_lake_bundle_fields, & - clm_lake_final + clm_lake_final, clm_lake_fill_data !>\defgroup CLM Lake Model restart public interface !> @{ @@ -73,6 +73,9 @@ module fv3atm_clm_lake_io ! each axis, containing the appropriate information procedure, public :: write_axes => clm_lake_write_axes + ! fills internal arrays with zero: + procedure, public :: fill_data => clm_lake_fill_data + ! copy_from_grid copies from Sfcprop to internal pointers (declared above) procedure, public :: copy_from_grid => clm_lake_copy_from_grid @@ -194,6 +197,61 @@ subroutine clm_lake_write_axes(clm_lake, Model, Sfc_restart) call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', clm_lake%levsnowsoil1_clm_lake) end subroutine clm_lake_write_axes + !>@ This is clm_lake%fill_data. It fills internal arrays with zero + !! Terrible things will happen if you don't call + !! clm_lake%allocate_data first. + subroutine clm_lake_fill_data(clm_lake, Model, Atm_block, Sfcprop) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + real(kind_phys), parameter :: zero = 0 + integer :: nb, ix, isc, jsc, i, j + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + 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 + + clm_lake%T_snow(i,j) = zero + clm_lake%T_ice(i,j) = zero + clm_lake%lake_snl2d(i,j) = zero + clm_lake%lake_h2osno2d(i,j) = zero + clm_lake%lake_tsfc(i,j) = zero + clm_lake%lake_savedtke12d(i,j) = zero + clm_lake%lake_sndpth2d(i,j) = zero + clm_lake%clm_lakedepth(i,j) = zero + clm_lake%clm_lake_initialized(i,j) = zero + + clm_lake%lake_z3d(i,j,:) = zero + clm_lake%lake_dz3d(i,j,:) = zero + clm_lake%lake_soil_watsat3d(i,j,:) = zero + clm_lake%lake_csol3d(i,j,:) = zero + clm_lake%lake_soil_tkmg3d(i,j,:) = zero + clm_lake%lake_soil_tkdry3d(i,j,:) = zero + clm_lake%lake_soil_tksatu3d(i,j,:) = zero + clm_lake%lake_snow_z3d(i,j,:) = zero + clm_lake%lake_snow_dz3d(i,j,:) = zero + clm_lake%lake_snow_zi3d(i,j,:) = zero + clm_lake%lake_h2osoi_vol3d(i,j,:) = zero + clm_lake%lake_h2osoi_liq3d(i,j,:) = zero + clm_lake%lake_h2osoi_ice3d(i,j,:) = zero + clm_lake%lake_t_soisno3d(i,j,:) = zero + clm_lake%lake_t_lake3d(i,j,:) = zero + clm_lake%lake_icefrac3d(i,j,:) = zero + clm_lake%lake_clay3d(i,j,:) = zero + clm_lake%lake_sand3d(i,j,:) = zero + enddo + enddo + end subroutine clm_lake_fill_data + !>@ This is clm_lake%copy_from_grid. It copies from Sfcprop !! variables to the corresponding data temporary variables. !! Terrible things will happen if you don't call diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index ccdc6d719..487722601 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -651,6 +651,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! Tell CLM Lake to allocate data, and register its axes and fields if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%allocate_data(Model) + call clm_lake%fill_data(Model,Atm_block,Sfcprop) call clm_lake%copy_from_grid(Model,Atm_block,Sfcprop) call clm_lake%register_axes(Model, Sfc_restart) call clm_lake%register_fields(Sfc_restart) @@ -985,10 +986,12 @@ subroutine fv3atm_restart_register (Sfcprop, GFS_restart, Atm_block, Model) if(Model%iopt_lake == 2 .and. Model%lkm > 0) then call clm_lake_quilt%allocate_data(Model) + call clm_lake_quilt%fill_data(Model, Atm_block, Sfcprop) endif if(Model%rrfs_sd) then call rrfs_sd_quilt%allocate_data(Model) + call rrfs_sd_quilt%fill_data(Model, Atm_block, Sfcprop) endif end subroutine fv3atm_restart_register diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 97dcf2d1b..c8fc139e2 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -2040,13 +2040,10 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif -!recover fields from cartesian vector and sfc pressure + !recover fields from cartesian vector and sfc pressure call recover_fields(file_bundle,rc) - ! FIXME rrfs_smoke_conus13km_fast_phy32_qr crashes with teh following error in recover_fields - ! 20230720 121647.816 ERROR PET147 ESMF_Grid.F90:20442 ESMF_GridGetCoord2DR8 Arguments are incompatible - - farrayPtr typekind does not match Grid typekind - ! 20230720 121647.816 ERROR PET147 module_wrt_grid_comp.F90:2450 Arguments are incompatible - Passing error in return code + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo ! !----------------------------------------------------------------------- @@ -2485,6 +2482,7 @@ subroutine recover_fields(file_bundle,rc) type(ESMF_TypeKind_Flag) typekind character(100) fieldName,uwindname,vwindname type(ESMF_Field), allocatable :: fcstField(:) + real(ESMF_KIND_R4), dimension(:,:), pointer :: lonr4, latr4 real(ESMF_KIND_R8), dimension(:,:), pointer :: lon, lat real(ESMF_KIND_R8), dimension(:,:), pointer :: lonloc, latloc real(ESMF_KIND_R4), dimension(:,:), pointer :: pressfc @@ -2493,6 +2491,8 @@ subroutine recover_fields(file_bundle,rc) real(ESMF_KIND_R4), dimension(:,:,:), pointer :: cart3dPtr2dr4 real(ESMF_KIND_R4), dimension(:,:,:,:), pointer :: cart3dPtr3dr4 real(ESMF_KIND_R8) :: coslon, sinlon, sinlat + + type(ESMF_Array) :: lon_array, lat_array ! ! get filed count call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, rc=rc) @@ -2510,10 +2510,26 @@ subroutine recover_fields(file_bundle,rc) call ESMF_LogWrite("call recover field get coord 1",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) - + call ESMF_GridGetCoord(fieldgrid, coordDim=1, array=lon_array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(lon_array, typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lonr4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(lon(lbound(lonr4,1):ubound(lonr4,1),lbound(lonr4,2):ubound(lonr4,2))) + lon = lonr4 + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + write(0,*)'lon_array unknown typekind' + rc = 1 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + allocate(lonloc(lbound(lon,1):ubound(lon,1),lbound(lon,2):ubound(lon,2))) istart = lbound(lon,1) iend = ubound(lon,1) @@ -2529,9 +2545,24 @@ subroutine recover_fields(file_bundle,rc) call ESMF_LogWrite("call recover field get coord 2",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) - + call ESMF_GridGetCoord(fieldgrid, coordDim=2, array=lat_array, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(lat_array, typekind=typekind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=latr4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(lat(lbound(latr4,1):ubound(latr4,1),lbound(latr4,2):ubound(latr4,2))) + lat = latr4 + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + write(0,*)'lon_array unknown typekind' + rc = 1 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif allocate(latloc(lbound(lat,1):ubound(lat,1),lbound(lat,2):ubound(lat,2))) istart = lbound(lat,1) From d9525db44bc4fbc97cfd976970fa71bd721aa4f9 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Thu, 31 Aug 2023 15:43:09 -0400 Subject: [PATCH 17/48] Use optional chunksizes argument in register_restart_field calls (#595) * Change the format of domain restart files to netcdf4 and set chunksizes * Remove nc_format="netcdf4" argument when opening restart files * Set chunksize of zaxis and time axis to 1 * Update clm_lake and rrfs_sd modules to support chunksizes * Make quilting restart files identical to fms files --- atmos_cubed_sphere | 2 +- io/fv3atm_clm_lake_io.F90 | 64 +++++++++++++++++------------- io/fv3atm_restart_io.F90 | 9 +++-- io/fv3atm_rrfs_sd_io.F90 | 23 +++++++---- io/fv3atm_sfc_io.F90 | 42 ++++++++++++++------ io/module_write_restart_netcdf.F90 | 7 +++- 6 files changed, 94 insertions(+), 53 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 49f15ecbb..52bf918c1 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 49f15ecbbc16405025fae8d672dced19c2073d9e +Subproject commit 52bf918c194b7d906776447c6324bc75558133db diff --git a/io/fv3atm_clm_lake_io.F90 b/io/fv3atm_clm_lake_io.F90 index 80c7bb586..c930e1df9 100644 --- a/io/fv3atm_clm_lake_io.F90 +++ b/io/fv3atm_clm_lake_io.F90 @@ -12,7 +12,7 @@ module fv3atm_clm_lake_io use block_control_mod, only: block_control_type use fms2_io_mod, only: FmsNetcdfDomainFile_t, register_axis, & register_restart_field, write_data, & - register_variable_attribute, register_field + register_variable_attribute, register_field, get_dimension_size use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & create_3d_field_and_add_to_bundle @@ -370,81 +370,89 @@ subroutine clm_lake_register_fields(clm_lake, Sfc_restart) class(clm_lake_data_type) :: clm_lake type(FmsNetcdfDomainFile_t) :: Sfc_restart + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes2d(3), chunksizes3d(4) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + chunksizes2d = (/xaxis_1_chunk, yaxis_1_chunk, 1/) + chunksizes3d = (/xaxis_1_chunk, yaxis_1_chunk, 1, 1/) + ! Register 2D fields call register_restart_field(Sfc_restart, 'T_snow', clm_lake%T_snow, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'T_ice', clm_lake%T_ice, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_snl2d', clm_lake%lake_snl2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_h2osno2d', clm_lake%lake_h2osno2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_tsfc', clm_lake%lake_tsfc, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_savedtke12d', clm_lake%lake_savedtke12d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_sndpth2d', clm_lake%lake_sndpth2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lakedepth', clm_lake%clm_lakedepth, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lake_initialized', clm_lake%clm_lake_initialized, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) ! Register 3D fields call register_restart_field(Sfc_restart, 'lake_z3d', clm_lake%lake_z3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_dz3d', clm_lake%lake_dz3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_soil_watsat3d', clm_lake%lake_soil_watsat3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_csol3d', clm_lake%lake_csol3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_soil_tkmg3d', clm_lake%lake_soil_tkmg3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_soil_tkdry3d', clm_lake%lake_soil_tkdry3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_soil_tksatu3d', clm_lake%lake_soil_tksatu3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_z3d', clm_lake%lake_snow_z3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_dz3d', clm_lake%lake_snow_dz3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_zi3d', clm_lake%lake_snow_zi3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) + 'levsnowsoil_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_h2osoi_vol3d', clm_lake%lake_h2osoi_vol3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_h2osoi_liq3d', clm_lake%lake_h2osoi_liq3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_h2osoi_ice3d', clm_lake%lake_h2osoi_ice3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_soisno3d', clm_lake%lake_t_soisno3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_lake3d', clm_lake%lake_t_lake3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_icefrac3d', clm_lake%lake_icefrac3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_clay3d', clm_lake%lake_clay3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) + 'levsoil_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_sand3d', clm_lake%lake_sand3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) + 'levsoil_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) end subroutine clm_lake_register_fields !>@ This is clm_lake%bundle_fields, and it is only used in the diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index 487722601..1edb985a8 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -14,7 +14,7 @@ module fv3atm_restart_io_mod register_axis, register_restart_field, & register_variable_attribute, register_field, & read_restart, write_restart, write_data, & - get_global_io_domain_indices + get_global_io_domain_indices, get_dimension_size use mpp_domains_mod, only: domain2d use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & create_3d_field_and_add_to_bundle, copy_from_gfs_data @@ -891,6 +891,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta character(7) :: indir='RESTART' character(72) :: infile logical :: amiopen, allocated_something + integer :: xaxis_1_chunk, yaxis_1_chunk type(phy_data_type) :: phy type(FmsNetcdfDomainFile_t) :: Phy_restart @@ -917,6 +918,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta 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 get_dimension_size(Phy_restart, 'xaxis_1', xaxis_1_chunk) call register_axis(Phy_restart, 'yaxis_1', 'Y') call register_field(Phy_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) @@ -924,6 +926,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta 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 get_dimension_size(Phy_restart, 'yaxis_1', yaxis_1_chunk) call register_axis(Phy_restart, 'zaxis_1', phy%npz) call register_field(Phy_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) @@ -946,12 +949,12 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta do num = 1,phy%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.) + & chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1/), is_optional=.true.) enddo do num = 1,phy%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.) + & chunksizes=(/xaxis_1_chunk,yaxis_1_chunk,1,1/), is_optional=.true.) enddo nullify(var2_p) nullify(var3_p) diff --git a/io/fv3atm_rrfs_sd_io.F90 b/io/fv3atm_rrfs_sd_io.F90 index c6dc44e34..16410c8be 100644 --- a/io/fv3atm_rrfs_sd_io.F90 +++ b/io/fv3atm_rrfs_sd_io.F90 @@ -6,7 +6,8 @@ module fv3atm_rrfs_sd_io use block_control_mod, only: block_control_type use fms2_io_mod, only: FmsNetcdfDomainFile_t, write_data, & register_axis, register_restart_field, & - register_variable_attribute, register_field + register_variable_attribute, register_field, & + get_dimension_size use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys use fv3atm_common_io, only: get_nx_ny_from_atm, create_2d_field_and_add_to_bundle, & create_3d_field_and_add_to_bundle @@ -193,23 +194,31 @@ subroutine rrfs_sd_state_register_fields(data,Sfc_restart) class(rrfs_sd_state_type) :: data type(FmsNetcdfDomainFile_t) :: Sfc_restart + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes2d(3), chunksizes3d(4) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + chunksizes2d = (/xaxis_1_chunk, yaxis_1_chunk, 1/) + chunksizes3d = (/xaxis_1_chunk, yaxis_1_chunk, 1, 1/) + ! Register 2D fields call register_restart_field(Sfc_restart, 'emdust', data%emdust, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'emseas', data%emseas, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'emanoc', data%emanoc, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'fhist', data%fhist, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'coef_bb_dc', data%coef_bb_dc, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) ! Register 3D field call register_restart_field(Sfc_restart, 'fire_in', data%fire_in, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'fire_aux_data_levels', 'Time '/), & - is_optional=.true.) + chunksizes=chunksizes3d, is_optional=.true.) end subroutine rrfs_sd_state_register_fields ! -------------------------------------------------------------------- diff --git a/io/fv3atm_sfc_io.F90 b/io/fv3atm_sfc_io.F90 index 6cd007761..90942e211 100644 --- a/io/fv3atm_sfc_io.F90 +++ b/io/fv3atm_sfc_io.F90 @@ -9,7 +9,8 @@ module fv3atm_sfc_io use fms2_io_mod, only: FmsNetcdfDomainFile_t, unlimited, write_data,& register_axis, register_restart_field, & register_variable_attribute, register_field, & - get_global_io_domain_indices, variable_exists + get_global_io_domain_indices, variable_exists, & + get_dimension_size use fv3atm_common_io, only: GFS_Data_transfer, & create_2d_field_and_add_to_bundle, create_3d_field_and_add_to_bundle use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys @@ -575,8 +576,15 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) character(len=7) :: time2d(3) + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes2d(3) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + if(.not.reading) then time2d=(/'xaxis_1','yaxis_1','Time '/) + chunksizes2d=(/xaxis_1_chunk, yaxis_1_chunk, 1/) else time2d=(/'Time ','yaxis_1','xaxis_1'/) endif @@ -599,13 +607,13 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) 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=time2d,& - &is_optional=.true.) + & chunksizes=chunksizes2d, is_optional=.true.) end if else if(reading .and. sfc%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=time2d) + call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=time2d, chunksizes=chunksizes2d) end if endif enddo @@ -618,7 +626,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%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=time2d, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, chunksizes=chunksizes2d, is_optional=.not.mand) endif enddo endif @@ -629,7 +637,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%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=time2d) + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, chunksizes=chunksizes2d) end if enddo endif ! mp/ruc @@ -643,7 +651,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%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=time2d, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d, chunksizes=chunksizes2d, is_optional=.not.mand) end if enddo endif ! noahmp @@ -656,7 +664,7 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) if(sfc%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=time2d, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name2(num),var2_p,dimensions=time2d, chunksizes=chunksizes2d, is_optional=.not.mand) endif enddo endif @@ -684,9 +692,17 @@ subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) character(len=7), parameter :: xyz3_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/) character(len=7), parameter :: xyz4_time(4) = (/'xaxis_1', 'yaxis_1', 'zaxis_4', 'Time '/) + integer :: xaxis_1_chunk, yaxis_1_chunk + integer :: chunksizes3d(4) + + call get_dimension_size(Sfc_restart, 'xaxis_1', xaxis_1_chunk) + call get_dimension_size(Sfc_restart, 'yaxis_1', yaxis_1_chunk) + + chunksizes3d = (/xaxis_1_chunk, yaxis_1_chunk, 1, 1/) + !--- register the 3D fields var3_p => sfc%var3ice(:,:,:) - call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, is_optional=.true.) + call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, chunksizes=chunksizes3d, is_optional=.true.) if(reading) then do num = 1,sfc%nvar3 @@ -706,13 +722,13 @@ subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) elseif(Model%lsm == Model%lsm_ruc) then do num = 1,sfc%nvar3 var3_p => sfc%var3(:,:,:,num) - call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz1_time) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz1_time, chunksizes=chunksizes3d) enddo nullify(var3_p) else ! writing something other than ruc do num = 1,sfc%nvar3 var3_p => sfc%var3(:,:,:,num) - call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz2_time) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p, dimensions=xyz2_time, chunksizes=chunksizes3d) enddo nullify(var3_p) endif @@ -721,14 +737,14 @@ subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) mand = .not.reading do num = sfc%nvar3+1,sfc%nvar3+3 var3_p1 => sfc%var3sn(:,:,:,num) - call register_restart_field(Sfc_restart, sfc%name3(num), var3_p1, dimensions=xyz3_time, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name3(num), var3_p1, dimensions=xyz3_time, chunksizes=chunksizes3d, is_optional=.not.mand) enddo var3_p2 => sfc%var3eq(:,:,:,7) - call register_restart_field(Sfc_restart, sfc%name3(7), var3_p2, dimensions=xyz2_time, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name3(7), var3_p2, dimensions=xyz2_time, chunksizes=chunksizes3d, is_optional=.not.mand) var3_p3 => sfc%var3zn(:,:,:,8) - call register_restart_field(Sfc_restart, sfc%name3(8), var3_p3, dimensions=xyz4_time, is_optional=.not.mand) + call register_restart_field(Sfc_restart, sfc%name3(8), var3_p3, dimensions=xyz4_time, chunksizes=chunksizes3d, is_optional=.not.mand) endif !mp end subroutine Sfc_io_register_3d_fields diff --git a/io/module_write_restart_netcdf.F90 b/io/module_write_restart_netcdf.F90 index 259079bb2..53a1f719c 100644 --- a/io/module_write_restart_netcdf.F90 +++ b/io/module_write_restart_netcdf.F90 @@ -565,7 +565,12 @@ subroutine write_out_ungridded_dim_atts_from_field(field, dimLabel, dimid, rc) ncerr = nf90_def_dim(ncid, trim(dimLabel), valueCount, dimid=dimid); NC_ERR_STOP(ncerr); NC_ERR_STOP(ncerr) endif if( typekind == ESMF_TYPEKIND_R4 ) then - ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_FLOAT, dimids=(/dimid/), varid=varid); NC_ERR_STOP(ncerr) + !!! FIXME Use NF90_DOUBLE as axis type, even though axis data are float + !!! This is needed to make phy/sfc restart files identical to FMS + !!! restart files which always defines all axis as double + + ! ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_FLOAT, dimids=(/dimid/), varid=varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_DOUBLE, dimids=(/dimid/), varid=varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, varid, trim(axis_attr_name), "Z"); NC_ERR_STOP(ncerr) ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) ncerr = nf90_put_var(ncid, varid, values=valueListr4); NC_ERR_STOP(ncerr) From 379ef21b1a117848fca255de4da048778e561c95 Mon Sep 17 00:00:00 2001 From: lisa-bengtsson <54411948+lisa-bengtsson@users.noreply.github.com> Date: Tue, 5 Sep 2023 10:46:53 -0600 Subject: [PATCH 18/48] 2D advection of cellular automata (#686) * 2D advection of cellular automata --- atmos_model.F90 | 2 +- ccpp/data/GFS_typedefs.F90 | 6 +++++- ccpp/data/GFS_typedefs.meta | 6 ++++++ .../stochastic_physics_wrapper.F90 | 20 +++++++++++++++++-- 4 files changed, 30 insertions(+), 4 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 2fa6788cd..e2e776030 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -748,7 +748,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call fv3atm_restart_read (GFS_data, GFS_restart_var, Atm_block, GFS_control, Atmos%domain_for_read, & Atm(mygrid)%flagstruct%warm_start, ignore_rst_cksum) if(GFS_control%do_ca .and. Atm(mygrid)%flagstruct%warm_start)then - call read_ca_restart (Atmos%domain,GFS_control%ncells,GFS_control%nca,GFS_control%ncells_g,GFS_control%nca_g) + call read_ca_restart (Atmos%domain,3,GFS_control%ncells,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. diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 80826ba42..ec3893ba9 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1328,6 +1328,7 @@ module GFS_typedefs integer :: nseed !< cellular automata seed frequency integer :: nseed_g !< cellular automata seed frequency logical :: do_ca !< cellular automata main switch + logical :: ca_advect !< Advection of cellular automata logical :: ca_sgs !< switch for sgs ca logical :: ca_global !< switch for global ca logical :: ca_smooth !< switch for gaussian spatial filter @@ -3765,6 +3766,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: iseed_ca = 1 integer :: nspinup = 1 logical :: do_ca = .false. + logical :: ca_advect = .false. logical :: ca_sgs = .false. logical :: ca_global = .false. logical :: ca_smooth = .false. @@ -3974,7 +3976,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & h0facu, h0facs, & !--- cellular automata nca, ncells, nlives, nca_g, ncells_g, nlives_g, nfracseed, & - nseed, nseed_g, nthresh, do_ca, & + nseed, nseed_g, nthresh, do_ca, ca_advect, & ca_sgs, ca_global,iseed_ca,ca_smooth, & nspinup,ca_amplitude,nsmooth,ca_closure,ca_entr,ca_trigger, & !--- IAU @@ -4943,6 +4945,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nseed_g = nseed_g Model%ca_global = ca_global Model%do_ca = do_ca + Model%ca_advect = ca_advect Model%ca_sgs = ca_sgs Model%iseed_ca = iseed_ca Model%ca_smooth = ca_smooth @@ -6705,6 +6708,7 @@ subroutine control_print(Model) print *, ' ca_global : ', Model%ca_global print *, ' ca_sgs : ', Model%ca_sgs print *, ' do_ca : ', Model%do_ca + print *, ' ca_advect : ', Model%ca_advect print *, ' iseed_ca : ', Model%iseed_ca print *, ' ca_smooth : ', Model%ca_smooth print *, ' nspinup : ', Model%nspinup diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 9b54e5c2c..635112ad4 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -5698,6 +5698,12 @@ units = flag dimensions = () type = logical +[ca_advect] + standard_name = flag_for_cellular_automata_advection + long_name = cellular automata main switch + units = flag + dimensions = () + type = logical [ca_sgs] standard_name = flag_for_sgs_cellular_automata long_name = switch for sgs ca diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 8096ddbb4..3bae38fe3 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -37,6 +37,10 @@ module stochastic_physics_wrapper_mod real(kind=kind_phys), dimension(:,:), allocatable, save :: sst real(kind=kind_phys), dimension(:,:), allocatable, save :: lmsk real(kind=kind_phys), dimension(:,:), allocatable, save :: lake + real(kind=kind_phys), dimension(:,:,:), allocatable, save :: uwind + real(kind=kind_phys), dimension(:,:,:), allocatable, save :: vwind + real(kind=kind_phys), dimension(:,:,:), allocatable, save :: height + real(kind=kind_phys), dimension(:,:), allocatable, save :: dx 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 :: ca1_cpl, ca2_cpl, ca3_cpl @@ -189,7 +193,11 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) allocate(sst (1:nblks, maxblk)) allocate(lmsk (1:nblks, maxblk)) allocate(lake (1:nblks, maxblk)) + allocate(uwind (1:nblks, maxblk, 1:levs)) + allocate(vwind (1:nblks, maxblk, 1:levs)) + allocate(height (1:nblks, maxblk, 1:levs)) allocate(condition (1:nblks, maxblk)) + allocate(dx (1:nblks, maxblk)) allocate(ca_deep_cpl (1:nblks, maxblk)) allocate(ca_turb_cpl (1:nblks, maxblk)) allocate(ca_shal_cpl (1:nblks, maxblk)) @@ -374,16 +382,20 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) lake (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%lakefrac(:) + uwind (nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Statein%ugrs(:,:) + vwind (nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Statein%vgrs(:,:) + height (nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Statein%phil(:,:) + dx (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%dx(:) condition (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%condition(:) ca_deep_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_deep(:) 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%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, & + sst,lmsk,lake,uwind,vwind,height,dx,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%tile_num,GFS_Control%nca,GFS_Control%ncells,GFS_Control%nlives, & - GFS_Control%nfracseed, GFS_Control%nseed,GFS_Control%iseed_ca, & + GFS_Control%nfracseed, GFS_Control%nseed,GFS_Control%iseed_ca,GFS_Control%ca_advect, & 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 @@ -461,6 +473,10 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) deallocate(sst ) deallocate(lmsk ) deallocate(lake ) + deallocate(uwind ) + deallocate(vwind ) + deallocate(height ) + deallocate(dx ) deallocate(condition ) deallocate(ca_deep_cpl ) deallocate(ca_turb_cpl ) From a9fa26e3c03b2ae4d9294225c043ffd962028e72 Mon Sep 17 00:00:00 2001 From: Jun Wang <37633869+junwang-noaa@users.noreply.github.com> Date: Thu, 7 Sep 2023 16:00:46 -0400 Subject: [PATCH 19/48] Add run time info and upp (#678) * update missing value * adding timing information * add write_runtimelog option * update upp and not include dycore updates that change results --- fv3_cap.F90 | 41 +++++++++++++++++++++++++++++++++---- io/module_wrt_grid_comp.F90 | 10 ++++++--- io/post_fv3.F90 | 28 +++++++++++++++++-------- upp | 2 +- 4 files changed, 64 insertions(+), 17 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 1bca9b004..fa8a549d6 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -70,11 +70,14 @@ module fv3atm_cap_mod logical, allocatable :: is_moving_FB(:) logical :: profile_memory = .true. + logical :: write_runtimelog = .false. + logical :: lprint = .false. integer :: mype = -1 integer :: dbug = 0 integer :: frestart(999) = -1 + real(kind=8) :: timere, timep2re !----------------------------------------------------------------------- contains @@ -246,6 +249,11 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return profile_memory = (trim(value)/="false") + call ESMF_AttributeGet(gcomp, name="RunTimeLog", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write_runtimelog = (trim(value)=="true") + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -347,6 +355,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return first_kdt = 1 + if( mype == 0) lprint = .true. ! !####################################################################### ! set up fcst grid component @@ -486,6 +495,7 @@ subroutine InitializeAdvertise(gcomp, rc) enddo k = k + wrttasks_per_group_from_parent last_wrttask(i) = k - 1 + if( mype == lead_wrttask(i) ) lprint = .true. ! if(mype==0)print *,'af wrtComp(i)=',i,'k=',k ! prepare name of the wrtComp(i) @@ -971,8 +981,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' - if(mype==0) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis + if(write_runtimelog .and. lprint) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis,mype !----------------------------------------------------------------------- ! end subroutine InitializeAdvertise @@ -989,7 +998,10 @@ subroutine InitializeRealize(gcomp, rc) type(ESMF_State) :: importState, exportState integer :: urc + real(8) :: MPI_Wtime, timeirs + rc = ESMF_SUCCESS + timeirs = MPI_Wtime() ! query for importState and exportState call NUOPC_ModelGet(gcomp, driverClock=clock, importState=importState, exportState=exportState, rc=rc) @@ -1004,6 +1016,11 @@ subroutine InitializeRealize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + timere = 0. + timep2re = 0. + + if(write_runtimelog .and. lprint) print *,'in fv3_cap, initirealz time=',MPI_Wtime()-timeirs,mype + end subroutine InitializeRealize !----------------------------------------------------------------------------- @@ -1012,10 +1029,13 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc + real(kind=8) :: MPI_Wtime, timers !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timers = MPI_Wtime() + if(write_runtimelog .and. timere>0. .and. lprint) print *,'in fv3_cap, time between fv3 run step=', timers-timere,mype if (profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance: ") @@ -1027,6 +1047,9 @@ subroutine ModelAdvance(gcomp, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance: ") + timere = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap, time in fv3 run step=', timere-timers, mype + end subroutine ModelAdvance !----------------------------------------------------------------------------- @@ -1041,10 +1064,13 @@ subroutine ModelAdvance_phase1(gcomp, rc) logical :: fcstpe character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase1)' character(240) :: msgString + real(kind=8) :: MPI_Wtime, timep1rs, timep1re !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timep1rs = MPI_Wtime() + if(write_runtimelog .and. timep2re>0. .and. lprint) print *,'in fv3_cap, time between fv3 run phase2 and phase1 ', timep1rs-timep2re,mype if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase1: ") @@ -1074,6 +1100,8 @@ subroutine ModelAdvance_phase1(gcomp, rc) call diagnose_cplFields(gcomp, clock, fcstpe, cplprint_flag, dbug, 'import') endif + timep1re = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap,modeladvance phase1 time ', timep1re-timep1rs,mype if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase1: ") end subroutine ModelAdvance_phase1 @@ -1100,9 +1128,12 @@ subroutine ModelAdvance_phase2(gcomp, rc) type(ESMF_Clock) :: clock, clock_out integer :: fieldCount + real(kind=8) :: MPI_Wtime, timep2rs + !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timep2rs = MPI_Wtime() if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase2: ") @@ -1206,6 +1237,8 @@ subroutine ModelAdvance_phase2(gcomp, rc) call diagnose_cplFields(gcomp, clock_out, fcstpe, cplprint_flag, dbug, 'export') end if + timep2re = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap,modeladvance phase2 time ', timep2re-timep2rs, mype if(profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase2: ") end subroutine ModelAdvance_phase2 @@ -1380,8 +1413,8 @@ subroutine ModelFinalize(gcomp, rc) !----------------------------------------------------------------------------- !*** finialize forecast - timeffs = MPI_Wtime() rc = ESMF_SUCCESS + timeffs = MPI_Wtime() ! call ESMF_GridCompGet(gcomp,vm=vm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1414,7 +1447,7 @@ subroutine ModelFinalize(gcomp, rc) call ESMF_GridCompDestroy(fcstComp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! - if(mype==0)print *,' wrt grid comp destroy time=',MPI_Wtime()-timeffs + if(write_runtimelog .and. lprint) print *,'in fv3_cap, finalize time=',MPI_Wtime()-timeffs, mype end subroutine ModelFinalize ! diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index c8fc139e2..162362466 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -2090,7 +2090,9 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (mype == lead_write_task) then !** write out inline post log file open(newunit=nolog,file='log.atm.inlinepost.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"('completed: fv3atm')") + write(nolog,"('forecast hour: ',f10.3)") nfhour + write(nolog,"('valid time: ',6(i4,2x))") wrt_int_state%fdate(1:6) close(nolog) endif if (lprnt) then @@ -2224,7 +2226,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) endif call mpi_bcast(kchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif - if (wrt_int_state%mype == 0) then + if (lprnt) then print *,'ichunk2d,jchunk2d',ichunk2d(grid_id),jchunk2d(grid_id) print *,'ichunk3d,jchunk3d,kchunk3d',ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id) endif @@ -2393,7 +2395,9 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (out_phase == 1 .and. mype == lead_write_task) then !** write out log file open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"('completed: fv3atm')") + write(nolog,"('forecast hour: ',f10.3)") nfhour + write(nolog,"('valid time: ',6(i4,2x))") wrt_int_state%fdate(1:6) close(nolog) endif enddo two_phase_loop diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 696a6b026..2026b67d9 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -93,7 +93,7 @@ subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & its = wrt_int_state%out_grid_info(grid_id)%i_start !<-- Starting I of this write task's subsection ite = wrt_int_state%out_grid_info(grid_id)%i_end !<-- Ending I of this write task's subsection - if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg, & + if(mype==0) print *,'in post_run, numx=',numx,'its=',its,'ite=',ite,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'wrt_int_state%FBCount=',wrt_int_state%FBCount ! @@ -508,7 +508,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, qqni, qqnr, qqnwfa, & + pint, exch_h, ref_10cm, qqni, qqnr, qqnw, qqnwfa, & qqnifa, effri, effrl, effrs, aextc55, taod5503d, & duem, dusd, dudp, duwt, dusv, ssem, sssd, ssdp, & sswt, sssv, bcem, bcsd, bcdp, bcwt, bcsv, ocem, & @@ -3642,8 +3642,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) endif if(imp_physics == 8) then - ! model level rain number - if(trim(fieldname)=='ncrain') then + ! model level rain water number + if(trim(fieldname)=='rain_nc') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d,spval,fillvalue) do l=1,lm do j=jsta,jend @@ -3655,8 +3655,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif - ! model level rain number - if(trim(fieldname)=='ncice') then + ! model level cloud ice number + if(trim(fieldname)=='nicp') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d,spval,fillvalue) do l=1,lm do j=jsta,jend @@ -3668,6 +3668,19 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif + ! model level cloud water number + if(trim(fieldname)=='water_nc') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d,spval,fillvalue) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l)=arrayr43d(i,j,l) + if(abs(arrayr43d(i,j,l)-fillvalue) Date: Fri, 8 Sep 2023 13:04:44 -0400 Subject: [PATCH 20/48] add SPP support to G-F deep convection (#688) * add SPP support to G-F deep convection --- ccpp/data/GFS_typedefs.F90 | 7 ++++++- ccpp/data/GFS_typedefs.meta | 16 +++++++++++++++- ccpp/driver/GFS_diagnostics.F90 | 13 +++++++++++++ ccpp/physics | 2 +- .../stochastic_physics_wrapper.F90 | 6 ++++++ 5 files changed, 41 insertions(+), 3 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index ec3893ba9..171591a53 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -612,6 +612,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: spp_wts_mp (:,:) => null() ! spp-mp-perts real (kind=kind_phys), pointer :: spp_wts_gwd (:,:) => null() ! spp-gwd-perts real (kind=kind_phys), pointer :: spp_wts_rad (:,:) => null() ! spp-rad-perts + real (kind=kind_phys), pointer :: spp_wts_cu_deep (:,:) => null() ! spp-cu-deep-perts !--- aerosol surface emissions for Thompson microphysics real (kind=kind_phys), pointer :: nwfa2d (:) => null() !< instantaneous water-friendly sfc aerosol source @@ -1370,8 +1371,9 @@ module GFS_typedefs integer :: spp_mp integer :: spp_rad integer :: spp_gwd + integer :: spp_cu_deep integer :: n_var_spp - character(len=3) , pointer :: spp_var_list(:) + character(len=10) , pointer :: spp_var_list(:) real(kind=kind_phys), pointer :: spp_prt_list(:) real(kind=kind_phys), pointer :: spp_stddev_cutoff(:) @@ -3121,6 +3123,8 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%spp_wts_gwd = clear_val allocate (Coupling%spp_wts_rad (IM,Model%levs)) Coupling%spp_wts_rad = clear_val + allocate (Coupling%spp_wts_cu_deep (IM,Model%levs)) + Coupling%spp_wts_cu_deep = clear_val endif !--- needed for Thompson's aerosol option @@ -3817,6 +3821,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: spp_mp = 0 integer :: spp_rad = 0 integer :: spp_gwd = 0 + integer :: spp_cu_deep = 0 logical :: do_spp = .false. integer :: ichoice = 0 !< flag for closure of C3/GF deep convection diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 635112ad4..a8ce4f016 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2938,6 +2938,14 @@ type = real kind = kind_phys active = (do_stochastically_perturbed_parameterizations) +[spp_wts_cu_deep] + standard_name = spp_weights_for_cu_deep_scheme + long_name = spp weights for cu deep scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (do_stochastically_perturbed_parameterizations) [sfc_wts] standard_name = surface_stochastic_weights_from_coupled_process long_name = weights for stochastic surface physics perturbation @@ -5859,7 +5867,7 @@ units = none dimensions = (number_of_perturbed_spp_schemes) type = character - kind = len=3 + kind = len=10 active = (do_stochastically_perturbed_parameterizations) [spp_pbl] standard_name = control_for_pbl_spp_perturbations @@ -5891,6 +5899,12 @@ units = count dimensions = () type = integer +[spp_cu_deep] + standard_name = control_for_deep_convection_spp_perturbations + long_name = control for deep convection spp perturbations + units = count + dimensions = () + type = integer [ntrac] standard_name = number_of_tracers long_name = number of tracers diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 71c125bfe..0974fdc8d 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2510,6 +2510,19 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo endif + if (Model%do_spp) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'spp_wts_cu_deep' + ExtDiag(idx)%desc = 'spp cu deep perturbation wts' + ExtDiag(idx)%unit = 'm/s' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%spp_wts_cu_deep(:,:) + enddo + endif + if (Model%lndp_type /= 0) then idx = idx + 1 ExtDiag(idx)%axes = 3 diff --git a/ccpp/physics b/ccpp/physics index 5b946850a..7efb112e0 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5b946850af58e1cea8c37661158b661df21e9390 +Subproject commit 7efb112e0e1a57fdf54c4a07574b8acd7a55ece6 diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 3bae38fe3..b76c52a39 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -141,6 +141,8 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) GFS_Control%spp_rad = 1 case('gwd') GFS_Control%spp_gwd = 1 + case('cu_deep') + GFS_Control%spp_cu_deep = 1 end select end do end if @@ -257,6 +259,10 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) do nb=1,Atm_block%nblks GFS_Data(nb)%Coupling%spp_wts_rad(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) end do + case('cu_deep') + do nb=1,Atm_block%nblks + GFS_Data(nb)%Coupling%spp_wts_cu_deep(:,:) = spp_wts(nb,1:GFS_Control%blksz(nb),:,n) + end do end select end do end if From bbc5bf849cab2ff86035bbe706b0c09616bb5838 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 14 Sep 2023 10:25:47 -0400 Subject: [PATCH 21/48] MYNN SFC OpenACC acceleration (#693) * MYNN SFC OpenACC directives --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 7efb112e0..31a99de05 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 7efb112e0e1a57fdf54c4a07574b8acd7a55ece6 +Subproject commit 31a99de05048187b61a2ea8381417b8dbd8db7e0 From 3b4423cde80275355cc088f977f5b36d9b8ae859 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Tue, 26 Sep 2023 08:08:34 -0400 Subject: [PATCH 22/48] Use the same real kind for axis variables in restart files as real kind used for data variables. (#697) * Write netcdf axis variables using the same real kind as data variables --- atmos_cubed_sphere | 2 +- io/fv3atm_clm_lake_io.F90 | 10 +++++----- io/fv3atm_common_io.F90 | 6 ++++++ io/fv3atm_restart_io.F90 | 10 +++++----- io/fv3atm_rrfs_sd_io.F90 | 4 ++-- io/fv3atm_sfc_io.F90 | 16 +++++++-------- io/module_write_restart_netcdf.F90 | 32 +++++++++++++++++------------- 7 files changed, 45 insertions(+), 35 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 52bf918c1..9616e4e38 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 52bf918c194b7d906776447c6324bc75558133db +Subproject commit 9616e4e383ed716838fa543d6e98d792e9b861ca diff --git a/io/fv3atm_clm_lake_io.F90 b/io/fv3atm_clm_lake_io.F90 index c930e1df9..10fa5a81c 100644 --- a/io/fv3atm_clm_lake_io.F90 +++ b/io/fv3atm_clm_lake_io.F90 @@ -14,7 +14,7 @@ module fv3atm_clm_lake_io register_restart_field, write_data, & register_variable_attribute, register_field, get_dimension_size use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & - create_3d_field_and_add_to_bundle + create_3d_field_and_add_to_bundle, axis_type implicit none @@ -179,16 +179,16 @@ subroutine clm_lake_write_axes(clm_lake, Model, Sfc_restart) type(GFS_control_type), intent(in) :: Model type(FmsNetcdfDomainFile_t) :: Sfc_restart integer :: i - call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) + call register_field(Sfc_restart, 'levlake_clm_lake', axis_type, (/'levlake_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - call register_field(Sfc_restart, 'levsoil_clm_lake', 'double', (/'levsoil_clm_lake'/)) + call register_field(Sfc_restart, 'levsoil_clm_lake', axis_type, (/'levsoil_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - call register_field(Sfc_restart, 'levsnowsoil_clm_lake', 'double', (/'levsnowsoil_clm_lake'/)) + call register_field(Sfc_restart, 'levsnowsoil_clm_lake', axis_type, (/'levsnowsoil_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', 'double', (/'levsnowsoil1_clm_lake'/)) + call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', axis_type, (/'levsnowsoil1_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) call write_data(Sfc_restart, 'levlake_clm_lake', clm_lake%levlake_clm_lake) diff --git a/io/fv3atm_common_io.F90 b/io/fv3atm_common_io.F90 index 1143f23ac..faee19306 100644 --- a/io/fv3atm_common_io.F90 +++ b/io/fv3atm_common_io.F90 @@ -31,6 +31,12 @@ module fv3atm_common_io public :: get_nx_ny_from_atm +#ifdef CCPP_32BIT + character(len=5), parameter, public :: axis_type = 'float' +#else + character(len=6), parameter, public :: axis_type = 'double' +#endif + !>\defgroup fv3atm_common_io FV3ATM Common I/O Utilities Module !> @{ diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index 1edb985a8..39d2131b9 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -17,7 +17,7 @@ module fv3atm_restart_io_mod get_global_io_domain_indices, get_dimension_size use mpp_domains_mod, only: domain2d use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & - create_3d_field_and_add_to_bundle, copy_from_gfs_data + create_3d_field_and_add_to_bundle, copy_from_gfs_data, axis_type use fv3atm_sfc_io use fv3atm_rrfs_sd_io use fv3atm_clm_lake_io @@ -913,7 +913,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta 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_field(Phy_restart, 'xaxis_1', axis_type, (/'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) @@ -921,7 +921,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta call get_dimension_size(Phy_restart, 'xaxis_1', xaxis_1_chunk) call register_axis(Phy_restart, 'yaxis_1', 'Y') - call register_field(Phy_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_field(Phy_restart, 'yaxis_1', axis_type, (/'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) @@ -929,7 +929,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta call get_dimension_size(Phy_restart, 'yaxis_1', yaxis_1_chunk) call register_axis(Phy_restart, 'zaxis_1', phy%npz) - call register_field(Phy_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_field(Phy_restart, 'zaxis_1', axis_type, (/'zaxis_1'/)) call register_variable_attribute(Phy_restart, 'zaxis_1', 'cartesian_axis', 'Z', str_len=1) allocate( buffer(phy%npz) ) do i=1, phy%npz @@ -939,7 +939,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta deallocate(buffer) call register_axis(Phy_restart, 'Time', unlimited) - call register_field(Phy_restart, 'Time', 'double', (/'Time'/)) + call register_field(Phy_restart, 'Time', axis_type, (/'Time'/)) call register_variable_attribute(Phy_restart, 'Time', 'cartesian_axis', 'T', str_len=1) call write_data(Phy_restart, "Time", 1) else diff --git a/io/fv3atm_rrfs_sd_io.F90 b/io/fv3atm_rrfs_sd_io.F90 index 16410c8be..780153208 100644 --- a/io/fv3atm_rrfs_sd_io.F90 +++ b/io/fv3atm_rrfs_sd_io.F90 @@ -10,7 +10,7 @@ module fv3atm_rrfs_sd_io get_dimension_size use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys use fv3atm_common_io, only: get_nx_ny_from_atm, create_2d_field_and_add_to_bundle, & - create_3d_field_and_add_to_bundle + create_3d_field_and_add_to_bundle, axis_type implicit none @@ -114,7 +114,7 @@ subroutine rrfs_sd_state_write_axis(data,Model,Sfc_restart) type(FmsNetcdfDomainFile_t) :: Sfc_restart type(GFS_control_type), intent(in) :: Model - call register_field(Sfc_restart, 'fire_aux_data_levels', 'double', (/'fire_aux_data_levels'/)) + call register_field(Sfc_restart, 'fire_aux_data_levels', axis_type, (/'fire_aux_data_levels'/)) call register_variable_attribute(Sfc_restart, 'fire_aux_data_levels', 'cartesian_axis' ,'Z', str_len=1) call write_data(Sfc_restart, 'fire_aux_data_levels', data%fire_aux_data_levels) end subroutine rrfs_sd_state_write_axis diff --git a/io/fv3atm_sfc_io.F90 b/io/fv3atm_sfc_io.F90 index 90942e211..c0bfcf6d9 100644 --- a/io/fv3atm_sfc_io.F90 +++ b/io/fv3atm_sfc_io.F90 @@ -11,7 +11,7 @@ module fv3atm_sfc_io register_variable_attribute, register_field, & get_global_io_domain_indices, variable_exists, & get_dimension_size - use fv3atm_common_io, only: GFS_Data_transfer, & + use fv3atm_common_io, only: GFS_Data_transfer, axis_type, & create_2d_field_and_add_to_bundle, create_3d_field_and_add_to_bundle use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, kind_phys use mpp_mod, only: mpp_error, NOTE @@ -309,19 +309,19 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) integer :: i, is, ie logical :: mand - call register_field(Sfc_restart, 'xaxis_1', 'double', (/'xaxis_1'/)) + call register_field(Sfc_restart, 'xaxis_1', axis_type, (/'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_field(Sfc_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_field(Sfc_restart, 'yaxis_1', axis_type, (/'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_field(Sfc_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_field(Sfc_restart, 'zaxis_1', axis_type, (/'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 @@ -331,7 +331,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) deallocate(buffer) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then - call register_field(Sfc_restart, 'zaxis_2', 'double', (/'zaxis_2'/)) + call register_field(Sfc_restart, 'zaxis_2', axis_type, (/'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 @@ -342,7 +342,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) endif if(Model%lsm == Model%lsm_noahmp) then - call register_field(Sfc_restart, 'zaxis_3', 'double', (/'zaxis_3'/)) + call register_field(Sfc_restart, 'zaxis_3', axis_type, (/'zaxis_3'/)) call register_variable_attribute(Sfc_restart, 'zaxis_3', 'cartesian_axis', 'Z', str_len=1) allocate(buffer(3)) do i=1, 3 @@ -351,7 +351,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) call write_data(Sfc_restart, 'zaxis_3', buffer) deallocate(buffer) - call register_field(Sfc_restart, 'zaxis_4', 'double', (/'zaxis_4'/)) + call register_field(Sfc_restart, 'zaxis_4', axis_type, (/'zaxis_4'/)) call register_variable_attribute(Sfc_restart, 'zaxis_4', 'cartesian_axis' ,'Z', str_len=1) allocate(buffer(7)) do i=1, 7 @@ -360,7 +360,7 @@ subroutine Sfc_io_write_axes(sfc, Model, Sfc_restart) call write_data(Sfc_restart, 'zaxis_4', buffer) deallocate(buffer) end if - call register_field(Sfc_restart, 'Time', 'double', (/'Time'/)) + call register_field(Sfc_restart, 'Time', axis_type, (/'Time'/)) call register_variable_attribute(Sfc_restart, 'Time', 'cartesian_axis', 'T', str_len=1) call write_data( Sfc_restart, 'Time', 1) end subroutine Sfc_io_write_axes diff --git a/io/module_write_restart_netcdf.F90 b/io/module_write_restart_netcdf.F90 index 53a1f719c..7904fe4cd 100644 --- a/io/module_write_restart_netcdf.F90 +++ b/io/module_write_restart_netcdf.F90 @@ -74,7 +74,7 @@ subroutine write_restart_netcdf(wrtfb, filename, & integer :: ncerr,ierr integer :: ncid integer :: oldMode - integer :: dimid + integer :: dimid, dimtype integer :: im_dimid, im_p1_dimid, jm_dimid, jm_p1_dimid, time_dimid integer :: im_varid, im_p1_varid, jm_varid, jm_p1_varid, time_varid integer, dimension(:), allocatable :: dimids_2d, dimids_3d @@ -188,6 +188,15 @@ subroutine write_restart_netcdf(wrtfb, filename, & deallocate(maxIndexPTile) deallocate(deToTileMap) deallocate(localDeToDeMap) + + if (typekind == ESMF_TYPEKIND_R4) then + dimtype = NF90_FLOAT + else if (typekind == ESMF_TYPEKIND_R8) then + dimtype = NF90_DOUBLE + else + if (mype==0) write(0,*)'Unsupported typekind ', typekind + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if end if if (fieldDimCount > gridDimCount) then @@ -236,29 +245,29 @@ subroutine write_restart_netcdf(wrtfb, filename, & if ( .not.is_restart_core ) then ncerr = nf90_def_dim(ncid, "xaxis_1", im, im_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "xaxis_1", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "xaxis_1", dimtype, im_dimid, im_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, trim(axis_attr_name), "X"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "yaxis_1", jm, jm_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "yaxis_1", NF90_DOUBLE, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "yaxis_1", dimtype, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, trim(axis_attr_name), "Y"); NC_ERR_STOP(ncerr) else ncerr = nf90_def_dim(ncid, "xaxis_1", im, im_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "xaxis_1", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "xaxis_1", dimtype, im_dimid, im_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_varid, trim(axis_attr_name), "X"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "xaxis_2", im+1, im_p1_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "xaxis_2", NF90_DOUBLE, im_p1_dimid, im_p1_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "xaxis_2", dimtype, im_p1_dimid, im_p1_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, im_p1_varid, trim(axis_attr_name), "X"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "yaxis_1", jm+1, jm_p1_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "yaxis_1", NF90_DOUBLE, jm_p1_dimid, jm_p1_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "yaxis_1", dimtype, jm_p1_dimid, jm_p1_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_p1_varid, trim(axis_attr_name), "Y"); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "yaxis_2", jm, jm_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "yaxis_2", NF90_DOUBLE, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "yaxis_2", dimtype, jm_dimid, jm_varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, jm_varid, trim(axis_attr_name), "Y"); NC_ERR_STOP(ncerr) end if @@ -291,7 +300,7 @@ subroutine write_restart_netcdf(wrtfb, filename, & ncerr = nf90_def_dim(ncid, "Time", NF90_UNLIMITED, time_dimid); NC_ERR_STOP(ncerr) ! ncerr = nf90_def_dim(ncid, "Time", 1, time_dimid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, "Time", NF90_DOUBLE, time_dimid, time_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, "Time", dimtype, time_dimid, time_varid); NC_ERR_STOP(ncerr) if (par) then ncerr = nf90_var_par_access(ncid, time_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) end if @@ -565,12 +574,7 @@ subroutine write_out_ungridded_dim_atts_from_field(field, dimLabel, dimid, rc) ncerr = nf90_def_dim(ncid, trim(dimLabel), valueCount, dimid=dimid); NC_ERR_STOP(ncerr); NC_ERR_STOP(ncerr) endif if( typekind == ESMF_TYPEKIND_R4 ) then - !!! FIXME Use NF90_DOUBLE as axis type, even though axis data are float - !!! This is needed to make phy/sfc restart files identical to FMS - !!! restart files which always defines all axis as double - - ! ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_FLOAT, dimids=(/dimid/), varid=varid); NC_ERR_STOP(ncerr) - ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_DOUBLE, dimids=(/dimid/), varid=varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_FLOAT, dimids=(/dimid/), varid=varid); NC_ERR_STOP(ncerr) ncerr = nf90_put_att(ncid, varid, trim(axis_attr_name), "Z"); NC_ERR_STOP(ncerr) ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) ncerr = nf90_put_var(ncid, varid, values=valueListr4); NC_ERR_STOP(ncerr) From bba7da5dcbb12f5de3e154cf2dfc318bdcd4fbf9 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Tue, 3 Oct 2023 12:12:10 -0400 Subject: [PATCH 23/48] Quartet of bug fixes for: c3 scheme, quilting restart with 32-bit physics, and string length mismatch in dycore plus PR #705 and #699 (#695) * GFDL_atmos_cubed_sphere: consistent string lengths in array * stop FV3_HRRR_c3 from crashing with gnu debug * in dycore, initialize srf_wnd_var2 and tracers_var3 arrays * Write netcdf axis variables using the same real kind as data variables * "GF radar reflectivity, dust bug fix, C3 updates, more fluxes output" * Fix race condition in GFS_phys_time_vary.fv3.F90 error detection * More bug fixes to GFS_phys_time_vary.fv3.F90: 1. detect empty errmsg from subroutines 2. Initialize err variables in set_soilveg.f, which is called from GFS_phys_time_vary.fv3.F90 * initialize errmsg & errflg in noahmp_tables.f90 * only read h2odata, ozdata and noahmp table when they are needed * remove all constant 3D variables from clm lake * calculate clm lake constants only once per i loop --------- Co-authored-by: Dusan Jovic Co-authored-by: Haiqin.Li --- atmos_cubed_sphere | 2 +- ccpp/data/GFS_typedefs.F90 | 43 ++++----- ccpp/data/GFS_typedefs.meta | 93 ++++++------------ ccpp/driver/GFS_diagnostics.F90 | 80 +++++++++------- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml | 2 + io/fv3atm_clm_lake_io.F90 | 119 +++--------------------- io/module_wrt_grid_comp.F90 | 8 +- 8 files changed, 109 insertions(+), 240 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 9616e4e38..caba092f6 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 9616e4e383ed716838fa543d6e98d792e9b861ca +Subproject commit caba092f682c9713a485e782b8f9ba6480adaca2 diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 171591a53..580101d68 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -431,13 +431,7 @@ module GFS_typedefs ! CLM Lake model internal variables: real (kind=kind_phys), pointer :: lake_albedo(:) => null() ! - real (kind=kind_phys), pointer :: lake_z3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_dz3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_watsat3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_csol3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_tkmg3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_tkdry3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_soil_tksatu3d(:,:) => null() ! + real (kind=kind_phys), pointer :: input_lakedepth(:) => null() ! real (kind=kind_phys), pointer :: lake_h2osno2d(:) => null() ! real (kind=kind_phys), pointer :: lake_sndpth2d(:) => null() ! real (kind=kind_phys), pointer :: lake_snl2d(:) => null() ! @@ -454,8 +448,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_icefrac3d(:,:)=> null() real (kind=kind_phys), pointer :: lake_rho0(:)=> null() real (kind=kind_phys), pointer :: lake_ht(:)=> null() - real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() - real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() integer, pointer :: lake_is_salty(:) => null() integer, pointer :: lake_cannot_freeze(:) => null() real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called @@ -1501,6 +1493,9 @@ module GFS_typedefs integer :: ncnvwind !< the index of surface wind enhancement due to convection for MYNN SFC and RAS CNV in phy f2d !-- nml variables for RRFS-SD + real(kind=kind_phys) :: dust_drylimit_factor !< factor for drylimit parameterization in fengsha + real(kind=kind_phys) :: dust_moist_correction !< factor to tune volumetric soil moisture + integer :: dust_moist_opt !< dust moisture option 1:fecan 2:shao real(kind=kind_phys) :: dust_alpha !< alpha parameter for fengsha dust scheme real(kind=kind_phys) :: dust_gamma !< gamma parameter for fengsha dust scheme real(kind=kind_phys) :: wetdep_ls_alpha !< alpha parameter for wet deposition @@ -2715,13 +2710,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%lake_t2m(IM)) allocate(Sfcprop%lake_q2m(IM)) allocate(Sfcprop%lake_albedo(IM)) - allocate(Sfcprop%lake_z3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_dz3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_watsat3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_csol3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_tkmg3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_tkdry3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_soil_tksatu3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%input_lakedepth(IM)) allocate(Sfcprop%lake_h2osno2d(IM)) allocate(Sfcprop%lake_sndpth2d(IM)) allocate(Sfcprop%lake_snl2d(IM)) @@ -2738,8 +2727,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%lake_icefrac3d(IM,Model%nlevlake_clm_lake)) allocate(Sfcprop%lake_rho0(IM)) allocate(Sfcprop%lake_ht(IM)) - allocate(Sfcprop%lake_clay3d(IM,Model%nlevsoil_clm_lake)) - allocate(Sfcprop%lake_sand3d(IM,Model%nlevsoil_clm_lake)) allocate(Sfcprop%lake_is_salty(IM)) allocate(Sfcprop%lake_cannot_freeze(IM)) allocate(Sfcprop%clm_lake_initialized(IM)) @@ -2747,13 +2734,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lake_t2m = clear_val Sfcprop%lake_q2m = clear_val Sfcprop%lake_albedo = clear_val - Sfcprop%lake_z3d = clear_val - Sfcprop%lake_dz3d = clear_val - Sfcprop%lake_soil_watsat3d = clear_val - Sfcprop%lake_csol3d = clear_val - Sfcprop%lake_soil_tkmg3d = clear_val - Sfcprop%lake_soil_tkdry3d = clear_val - Sfcprop%lake_soil_tksatu3d = clear_val + Sfcprop%input_lakedepth = clear_val Sfcprop%lake_h2osno2d = clear_val Sfcprop%lake_sndpth2d = clear_val Sfcprop%lake_snl2d = clear_val @@ -2770,8 +2751,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lake_icefrac3d = clear_val Sfcprop%lake_rho0 = -111 Sfcprop%lake_ht = -111 - Sfcprop%lake_clay3d = clear_val - Sfcprop%lake_sand3d = clear_val Sfcprop%lake_is_salty = zero Sfcprop%lake_cannot_freeze = zero Sfcprop%clm_lake_initialized = zero @@ -3829,9 +3808,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: ichoice_s = 3 !< flag for closure of C3/GF shallow convection !-- chem nml variables for RRFS-SD + real(kind=kind_phys) :: dust_drylimit_factor = 1.0 + real(kind=kind_phys) :: dust_moist_correction = 1.0 real(kind=kind_phys) :: dust_alpha = 0. real(kind=kind_phys) :: dust_gamma = 0. real(kind=kind_phys) :: wetdep_ls_alpha = 0. + integer :: dust_moist_opt = 1 ! fecan :1 else shao integer :: seas_opt = 2 integer :: dust_opt = 5 integer :: drydep_opt = 1 @@ -3995,6 +3977,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- aerosol scavenging factors ('name:value' string array) fscav_aero, & !--- RRFS-SD namelist + dust_drylimit_factor, dust_moist_correction, dust_moist_opt, & dust_alpha, dust_gamma, wetdep_ls_alpha, & seas_opt, dust_opt, drydep_opt, coarsepm_settling, & wetdep_ls_opt, smoke_forecast, aero_ind_fdb, aero_dir_fdb, & @@ -4214,6 +4197,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- RRFS-SD Model%rrfs_sd = rrfs_sd + Model%dust_drylimit_factor = dust_drylimit_factor + Model%dust_moist_correction = dust_moist_correction + Model%dust_moist_opt = dust_moist_opt Model%dust_alpha = dust_alpha Model%dust_gamma = dust_gamma Model%wetdep_ls_alpha = wetdep_ls_alpha @@ -6314,6 +6300,9 @@ subroutine control_print(Model) if(model%rrfs_sd) then print *, ' ' print *, 'smoke parameters' + print *, 'dust_drylimit_factor: ',Model%dust_drylimit_factor + print *, 'dust_moist_correction: ',Model%dust_moist_correction + print *, 'dust_moist_opt : ',Model%dust_moist_opt print *, 'dust_alpha : ',Model%dust_alpha print *, 'dust_gamma : ',Model%dust_gamma print *, 'wetdep_ls_alpha : ',Model%wetdep_ls_alpha diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index a8ce4f016..a4a941074 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2034,59 +2034,11 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_z3d] - standard_name = depth_of_lake_interface_layers - long_name = depth of lake interface layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_dz3d] - standard_name = thickness_of_lake_layers - long_name = thickness of lake layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_watsat3d] - standard_name = saturated_volumetric_soil_water_in_lake_model - long_name = saturated volumetric soil water in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_csol3d] - standard_name = soil_heat_capacity_in_lake_model - long_name = soil heat capacity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_tkmg3d] - standard_name = soil_mineral_thermal_conductivity_in_lake_model - long_name = soil mineral thermal conductivity in lake model +[input_lakedepth] + standard_name = lake_depth_before_correction + long_name = lake depth_before_correction units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_tkdry3d] - standard_name = dry_soil_thermal_conductivity_in_lake_model - long_name = dry soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_soil_tksatu3d] - standard_name = saturated_soil_thermal_conductivity_in_lake_model - long_name = saturated soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) @@ -2218,20 +2170,6 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_clay3d] - standard_name = clm_lake_percent_clay - long_name = percent clay in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) -[lake_sand3d] - standard_name = clm_lake_percent_sand - long_name = percent sand in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer - active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_is_salty] standard_name = clm_lake_is_salty long_name = lake at this point is salty (1) or not (0) @@ -6462,6 +6400,29 @@ type = real kind = kind_phys active = (do_smoke_coupling) +[dust_moist_correction] + standard_name = dust_moist_correction_fengsha_dust_scheme + long_name = moisture correction term for fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) +[dust_drylimit_factor] + standard_name = dust_drylimit_factor_fengsha_dust_scheme + long_name = moisture correction term for drylimit in fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) +[dust_moist_opt] + standard_name = control_for_dust_soil_moisture_option + long_name = smoke dust moisture parameterization 1 - fecan 2 - shao + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) [dust_alpha] standard_name = alpha_fengsha_dust_scheme long_name = alpha paramter for fengsha dust scheme diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 0974fdc8d..e3512528c 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -4061,6 +4061,50 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%wetness(:) enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'nirbmdi' + ExtDiag(idx)%desc = 'sfc nir beam sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nirbmdi(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'nirdfdi' + ExtDiag(idx)%desc = 'sfc nir diff sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nirdfdi(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'visbmdi' + ExtDiag(idx)%desc = 'sfc uv+vis beam sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%visbmdi(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'visdfdi' + ExtDiag(idx)%desc = ' sfc uv+vis diff sw downward flux' + ExtDiag(idx)%unit = 'W/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%visdfdi(:) + enddo + if (Model%rdlai) then idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -5086,42 +5130,6 @@ subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, integer :: nk, idx0, iblk - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_z3d, 'lake_z3d', 'lake_depth_on_interface_levels', 'm') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_clay3d, 'lake_clay3d', 'percent clay on soil levels in clm lake model', '%') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_sand3d, 'lake_sand3d', 'percent sand on soil levels in clm lake model', '%') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_dz3d, 'lake_dz3d', 'lake level thickness', 'm') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_watsat3d, 'lake_soil_watsat3d', 'saturated volumetric soil water', 'm3 m-3') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_csol3d, 'lake_csol3d', 'soil heat capacity', 'J m-3 K-1') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_tkmg3d, 'lake_soil_tkmg3d', 'soil thermal conductivity, minerals', 'W m-1 K-1') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_tkdry3d, 'lake_soil_tkdry3d', 'soil thermal conductivity, dry soil', 'W m-1 K-1') - enddo - - do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_soil_tksatu3d, 'lake_soil_tksatu3d', 'soil thermal conductivity, saturated soil', 'W m-1 K-1') - enddo - do iblk=1,nblks call link_all_levels(Sfcprop(iblk)%lake_snow_z3d, 'lake_snow_z3d', 'lake snow level depth', 'm') enddo diff --git a/ccpp/physics b/ccpp/physics index 31a99de05..dd91c3af6 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 31a99de05048187b61a2ea8381417b8dbd8db7e0 +Subproject commit dd91c3af6296f69c4b3630f774374d51d928887c diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml index a79f37f7f..d93060d5a 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml @@ -13,6 +13,7 @@ GFS_suite_interstitial_rad_reset + sgscloud_radpre GFS_rrtmg_pre GFS_radiation_surface rad_sw_pre @@ -20,6 +21,7 @@ rrtmg_sw_post rrtmg_lw_pre rrtmg_lw + sgscloud_radpost rrtmg_lw_post GFS_rrtmg_post diff --git a/io/fv3atm_clm_lake_io.F90 b/io/fv3atm_clm_lake_io.F90 index 10fa5a81c..37c221597 100644 --- a/io/fv3atm_clm_lake_io.F90 +++ b/io/fv3atm_clm_lake_io.F90 @@ -39,21 +39,19 @@ module fv3atm_clm_lake_io real(kind_phys), pointer, private, dimension(:,:) :: & T_snow=>null(), T_ice=>null(), & lake_snl2d=>null(), lake_h2osno2d=>null(), lake_tsfc=>null(), clm_lakedepth=>null(), & - lake_savedtke12d=>null(), lake_sndpth2d=>null(), clm_lake_initialized=>null() + lake_savedtke12d=>null(), lake_sndpth2d=>null(), clm_lake_initialized=>null(), & + input_lakedepth=>null() ! All 3D variables needed for a restart real(kind_phys), pointer, private, dimension(:,:,:) :: & - lake_z3d=>null(), lake_dz3d=>null(), lake_soil_watsat3d=>null(), & - lake_csol3d=>null(), lake_soil_tkmg3d=>null(), lake_soil_tkdry3d=>null(), & - lake_soil_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & + lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & lake_snow_zi3d=>null(), lake_h2osoi_vol3d=>null(), lake_h2osoi_liq3d=>null(), & lake_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & - lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() + lake_icefrac3d=>null() ! Axis indices in 1-based array, containing non-1-based indices real(kind_phys), pointer, private, dimension(:) :: & - levlake_clm_lake, levsoil_clm_lake, levsnowsoil_clm_lake, & - levsnowsoil1_clm_lake + levlake_clm_lake, levsnowsoil_clm_lake, levsnowsoil1_clm_lake contains ! register_axes calls registers_axis on Sfc_restart for all required axes @@ -117,14 +115,8 @@ subroutine clm_lake_allocate_data(clm_lake,Model) allocate(clm_lake%lake_sndpth2d(nx,ny)) allocate(clm_lake%clm_lakedepth(nx,ny)) allocate(clm_lake%clm_lake_initialized(nx,ny)) + allocate(clm_lake%input_lakedepth(nx,ny)) - allocate(clm_lake%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_watsat3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_soil_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) allocate(clm_lake%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(clm_lake%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(clm_lake%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) @@ -134,20 +126,14 @@ subroutine clm_lake_allocate_data(clm_lake,Model) allocate(clm_lake%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(clm_lake%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) allocate(clm_lake%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(clm_lake%lake_clay3d(nx,ny,Model%nlevsoil_clm_lake)) - allocate(clm_lake%lake_sand3d(nx,ny,Model%nlevsoil_clm_lake)) allocate(clm_lake%levlake_clm_lake(Model%nlevlake_clm_lake)) - allocate(clm_lake%levsoil_clm_lake(Model%nlevsoil_clm_lake)) allocate(clm_lake%levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake)) allocate(clm_lake%levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake)) do i=1,Model%nlevlake_clm_lake clm_lake%levlake_clm_lake(i) = i enddo - do i=1,Model%nlevsoil_clm_lake - clm_lake%levsoil_clm_lake(i) = i - enddo do i=-Model%nlevsnow_clm_lake,Model%nlevsoil_clm_lake clm_lake%levsnowsoil_clm_lake(i+Model%nlevsnow_clm_lake+1) = i enddo @@ -165,7 +151,6 @@ subroutine clm_lake_register_axes(clm_lake,Model,Sfc_restart) type(FmsNetcdfDomainFile_t) :: Sfc_restart call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) - call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) call register_axis(Sfc_restart, 'levsnowsoil_clm_lake', dimension_length=Model%nlevsnowsoil_clm_lake) call register_axis(Sfc_restart, 'levsnowsoil1_clm_lake', dimension_length=Model%nlevsnowsoil1_clm_lake) end subroutine clm_lake_register_axes @@ -182,9 +167,6 @@ subroutine clm_lake_write_axes(clm_lake, Model, Sfc_restart) call register_field(Sfc_restart, 'levlake_clm_lake', axis_type, (/'levlake_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - call register_field(Sfc_restart, 'levsoil_clm_lake', axis_type, (/'levsoil_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - call register_field(Sfc_restart, 'levsnowsoil_clm_lake', axis_type, (/'levsnowsoil_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) @@ -192,7 +174,6 @@ subroutine clm_lake_write_axes(clm_lake, Model, Sfc_restart) call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) call write_data(Sfc_restart, 'levlake_clm_lake', clm_lake%levlake_clm_lake) - call write_data(Sfc_restart, 'levsoil_clm_lake', clm_lake%levsoil_clm_lake) call write_data(Sfc_restart, 'levsnowsoil_clm_lake', clm_lake%levsnowsoil_clm_lake) call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', clm_lake%levsnowsoil1_clm_lake) end subroutine clm_lake_write_axes @@ -229,14 +210,8 @@ subroutine clm_lake_fill_data(clm_lake, Model, Atm_block, Sfcprop) clm_lake%lake_sndpth2d(i,j) = zero clm_lake%clm_lakedepth(i,j) = zero clm_lake%clm_lake_initialized(i,j) = zero + clm_lake%input_lakedepth(i,j) = zero - clm_lake%lake_z3d(i,j,:) = zero - clm_lake%lake_dz3d(i,j,:) = zero - clm_lake%lake_soil_watsat3d(i,j,:) = zero - clm_lake%lake_csol3d(i,j,:) = zero - clm_lake%lake_soil_tkmg3d(i,j,:) = zero - clm_lake%lake_soil_tkdry3d(i,j,:) = zero - clm_lake%lake_soil_tksatu3d(i,j,:) = zero clm_lake%lake_snow_z3d(i,j,:) = zero clm_lake%lake_snow_dz3d(i,j,:) = zero clm_lake%lake_snow_zi3d(i,j,:) = zero @@ -246,8 +221,6 @@ subroutine clm_lake_fill_data(clm_lake, Model, Atm_block, Sfcprop) clm_lake%lake_t_soisno3d(i,j,:) = zero clm_lake%lake_t_lake3d(i,j,:) = zero clm_lake%lake_icefrac3d(i,j,:) = zero - clm_lake%lake_clay3d(i,j,:) = zero - clm_lake%lake_sand3d(i,j,:) = zero enddo enddo end subroutine clm_lake_fill_data @@ -284,14 +257,8 @@ subroutine clm_lake_copy_from_grid(clm_lake, Model, Atm_block, Sfcprop) clm_lake%lake_sndpth2d(i,j) = Sfcprop(nb)%lake_sndpth2d(ix) clm_lake%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) clm_lake%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) + clm_lake%input_lakedepth(i,j) = Sfcprop(nb)%input_lakedepth(ix) - clm_lake%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) - clm_lake%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) - clm_lake%lake_soil_watsat3d(i,j,:) = Sfcprop(nb)%lake_soil_watsat3d(ix,:) - clm_lake%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) - clm_lake%lake_soil_tkmg3d(i,j,:) = Sfcprop(nb)%lake_soil_tkmg3d(ix,:) - clm_lake%lake_soil_tkdry3d(i,j,:) = Sfcprop(nb)%lake_soil_tkdry3d(ix,:) - clm_lake%lake_soil_tksatu3d(i,j,:) = Sfcprop(nb)%lake_soil_tksatu3d(ix,:) clm_lake%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) clm_lake%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) clm_lake%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) @@ -301,8 +268,6 @@ subroutine clm_lake_copy_from_grid(clm_lake, Model, Atm_block, Sfcprop) clm_lake%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) clm_lake%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) clm_lake%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) - clm_lake%lake_clay3d(i,j,:) = Sfcprop(nb)%lake_clay3d(ix,:) - clm_lake%lake_sand3d(i,j,:) = Sfcprop(nb)%lake_sand3d(ix,:) enddo enddo end subroutine clm_lake_copy_from_grid @@ -338,14 +303,8 @@ subroutine clm_lake_copy_to_grid(clm_lake, Model, Atm_block, Sfcprop) Sfcprop(nb)%lake_sndpth2d(ix) = clm_lake%lake_sndpth2d(i,j) Sfcprop(nb)%clm_lakedepth(ix) = clm_lake%clm_lakedepth(i,j) Sfcprop(nb)%clm_lake_initialized(ix) = clm_lake%clm_lake_initialized(i,j) + Sfcprop(nb)%input_lakedepth(ix) = clm_lake%input_lakedepth(i,j) - Sfcprop(nb)%lake_z3d(ix,:) = clm_lake%lake_z3d(i,j,:) - Sfcprop(nb)%lake_dz3d(ix,:) = clm_lake%lake_dz3d(i,j,:) - Sfcprop(nb)%lake_soil_watsat3d(ix,:) = clm_lake%lake_soil_watsat3d(i,j,:) - Sfcprop(nb)%lake_csol3d(ix,:) = clm_lake%lake_csol3d(i,j,:) - Sfcprop(nb)%lake_soil_tkmg3d(ix,:) = clm_lake%lake_soil_tkmg3d(i,j,:) - Sfcprop(nb)%lake_soil_tkdry3d(ix,:) = clm_lake%lake_soil_tkdry3d(i,j,:) - Sfcprop(nb)%lake_soil_tksatu3d(ix,:) = clm_lake%lake_soil_tksatu3d(i,j,:) Sfcprop(nb)%lake_snow_z3d(ix,:) = clm_lake%lake_snow_z3d(i,j,:) Sfcprop(nb)%lake_snow_dz3d(ix,:) = clm_lake%lake_snow_dz3d(i,j,:) Sfcprop(nb)%lake_snow_zi3d(ix,:) = clm_lake%lake_snow_zi3d(i,j,:) @@ -355,8 +314,6 @@ subroutine clm_lake_copy_to_grid(clm_lake, Model, Atm_block, Sfcprop) Sfcprop(nb)%lake_t_soisno3d(ix,:) = clm_lake%lake_t_soisno3d(i,j,:) Sfcprop(nb)%lake_t_lake3d(ix,:) = clm_lake%lake_t_lake3d(i,j,:) Sfcprop(nb)%lake_icefrac3d(ix,:) = clm_lake%lake_icefrac3d(i,j,:) - Sfcprop(nb)%lake_clay3d(ix,:) = clm_lake%lake_clay3d(i,j,:) - Sfcprop(nb)%lake_sand3d(ix,:) = clm_lake%lake_sand3d(i,j,:) enddo enddo end subroutine clm_lake_copy_to_grid @@ -397,29 +354,10 @@ subroutine clm_lake_register_fields(clm_lake, Sfc_restart) dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lake_initialized', clm_lake%clm_lake_initialized, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) + call register_restart_field(Sfc_restart, 'input_lakedepth', clm_lake%input_lakedepth, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), chunksizes=chunksizes2d, is_optional=.true.) ! Register 3D fields - call register_restart_field(Sfc_restart, 'lake_z3d', clm_lake%lake_z3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_dz3d', clm_lake%lake_dz3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_watsat3d', clm_lake%lake_soil_watsat3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_csol3d', clm_lake%lake_csol3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tkmg3d', clm_lake%lake_soil_tkmg3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tkdry3d', clm_lake%lake_soil_tkdry3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_soil_tksatu3d', clm_lake%lake_soil_tksatu3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_z3d', clm_lake%lake_snow_z3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levsnowsoil1_clm_lake', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) @@ -447,12 +385,6 @@ subroutine clm_lake_register_fields(clm_lake, Sfc_restart) call register_restart_field(Sfc_restart,'lake_icefrac3d', clm_lake%lake_icefrac3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levlake_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_clay3d', clm_lake%lake_clay3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_sand3d', clm_lake%lake_sand3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), chunksizes=chunksizes3d, is_optional=.true.) end subroutine clm_lake_register_fields !>@ This is clm_lake%bundle_fields, and it is only used in the @@ -484,22 +416,9 @@ subroutine clm_lake_bundle_fields(clm_lake, bundle, grid, Model, outputfile) call create_2d_field_and_add_to_bundle(clm_lake%lake_sndpth2d, "lake_sndpth2d", trim(outputfile), grid, bundle) call create_2d_field_and_add_to_bundle(clm_lake%clm_lakedepth, "clm_lakedepth", trim(outputfile), grid, bundle) call create_2d_field_and_add_to_bundle(clm_lake%clm_lake_initialized, "clm_lake_initialized", trim(outputfile), grid, bundle) + call create_2d_field_and_add_to_bundle(clm_lake%input_lakedepth, "input_lakedepth", trim(outputfile), grid, bundle) ! Register 3D fields - call create_3d_field_and_add_to_bundle(clm_lake%lake_z3d, 'lake_z3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_dz3d, 'lake_dz3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_watsat3d, 'lake_soil_watsat3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_csol3d, 'lake_csol3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tkmg3d, 'lake_soil_tkmg3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tkdry3d, 'lake_soil_tkdry3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_soil_tksatu3d, 'lake_soil_tksatu3d', 'levlake_clm_lake', & - clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) call create_3d_field_and_add_to_bundle(clm_lake%lake_snow_z3d, 'lake_snow_z3d', 'levsnowsoil1_clm_lake', & clm_lake%levsnowsoil1_clm_lake, trim(outputfile), grid, bundle) call create_3d_field_and_add_to_bundle(clm_lake%lake_snow_dz3d, 'lake_snow_dz3d', 'levsnowsoil1_clm_lake', & @@ -518,10 +437,6 @@ subroutine clm_lake_bundle_fields(clm_lake, bundle, grid, Model, outputfile) clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) call create_3d_field_and_add_to_bundle(clm_lake%lake_icefrac3d, 'lake_icefrac3d', 'levlake_clm_lake', & clm_lake%levlake_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_clay3d, 'lake_clay3d', 'levsoil_clm_lake', & - clm_lake%levsoil_clm_lake, trim(outputfile), grid, bundle) - call create_3d_field_and_add_to_bundle(clm_lake%lake_sand3d, 'lake_sand3d', 'levsoil_clm_lake', & - clm_lake%levsoil_clm_lake, trim(outputfile), grid, bundle) end subroutine Clm_lake_bundle_fields @@ -560,14 +475,8 @@ subroutine clm_lake_deallocate_data(clm_lake) IF_ASSOC_DEALLOC_NULL(lake_sndpth2d) IF_ASSOC_DEALLOC_NULL(clm_lakedepth) IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) + IF_ASSOC_DEALLOC_NULL(input_lakedepth) - IF_ASSOC_DEALLOC_NULL(lake_z3d) - IF_ASSOC_DEALLOC_NULL(lake_dz3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_watsat3d) - IF_ASSOC_DEALLOC_NULL(lake_csol3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tkmg3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tkdry3d) - IF_ASSOC_DEALLOC_NULL(lake_soil_tksatu3d) IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) @@ -577,8 +486,6 @@ subroutine clm_lake_deallocate_data(clm_lake) IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) - IF_ASSOC_DEALLOC_NULL(lake_clay3d) - IF_ASSOC_DEALLOC_NULL(lake_sand3d) #undef IF_ASSOC_DEALLOC_NULL end subroutine clm_lake_deallocate_data diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 162362466..781d62685 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -2040,9 +2040,11 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif - !recover fields from cartesian vector and sfc pressure - call recover_fields(file_bundle,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fcstItemNameList(i)(1:8) /= "restart_") then + !recover fields from cartesian vector and sfc pressure + call recover_fields(file_bundle,rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if enddo ! From a13a239a746cb95c74bbe5841f300cb75f8b80d9 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 10 Oct 2023 14:49:45 -0400 Subject: [PATCH 24/48] mean to inst field names, part I (#704) * change mean->inst for fields going to ATM * switch 'mean' prec fields to be inst --- atmos_model.F90 | 34 +++++++++++++++++----------------- cpl/module_cplfields.F90 | 22 +++++++++++----------- 2 files changed, 28 insertions(+), 28 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index e2e776030..25cc61a88 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -2015,7 +2015,7 @@ subroutine assign_importdata(jdat, rc) ! get upward LW flux: for sea ice covered area !---------------------------------------------- - fldname = 'mean_up_lw_flx_ice' + fldname = 'lwup_flx_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2042,7 +2042,7 @@ subroutine assign_importdata(jdat, rc) ! get latent heat flux: for sea ice covered area !------------------------------------------------ - fldname = 'mean_laten_heat_flx_atm_into_ice' + fldname = 'laten_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2062,7 +2062,7 @@ subroutine assign_importdata(jdat, rc) ! get sensible heat flux: for sea ice covered area !-------------------------------------------------- - fldname = 'mean_sensi_heat_flx_atm_into_ice' + fldname = 'sensi_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2122,7 +2122,7 @@ subroutine assign_importdata(jdat, rc) ! get sea ice volume: for sea ice covered area !---------------------------------------------- - fldname = 'mean_ice_volume' + fldname = 'sea_ice_volume' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2143,7 +2143,7 @@ subroutine assign_importdata(jdat, rc) ! get snow volume: for sea ice covered area !------------------------------------------- - fldname = 'mean_snow_volume' + fldname = 'snow_volume_on_sea_ice' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2251,7 +2251,7 @@ subroutine assign_importdata(jdat, rc) ! get upward LW flux: for open ocean !---------------------------------------------- - fldname = 'mean_up_lw_flx_ocn' + fldname = 'lwup_flx_ocn' if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2271,7 +2271,7 @@ subroutine assign_importdata(jdat, rc) ! get latent heat flux: for open ocean !------------------------------------------------ - fldname = 'mean_laten_heat_flx_atm_into_ocn' + fldname = 'laten_heat_flx_atm_into_ocn' if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2291,7 +2291,7 @@ subroutine assign_importdata(jdat, rc) ! get sensible heat flux: for open ocean !-------------------------------------------------- - fldname = 'mean_sensi_heat_flx_atm_into_ocn' + fldname = 'sensi_heat_flx_atm_into_ocn' if (trim(impfield_name) == trim(fldname) .and. GFS_control%use_med_flux) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then @@ -2936,6 +2936,15 @@ subroutine setup_exportdata(rc) ! Instantaneous Evap flux (kg/m**2/s) case ('inst_evap_rate') call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, -revap, spval, rc=localrc) + ! Instantaneous precipitation rate (kg/m2/s) + case ('inst_prec_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, rtimek, spval, rc=localrc) + ! Instantaneous convective precipitation rate (kg/m2/s) + case ('inst_prec_rate_conv') + call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, rtimek, spval, rc=localrc) + ! Instaneous snow precipitation rate (kg/m2/s) + case ('inst_fprec_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! Instantaneous Downward long wave radiation flux (W/m**2) case ('inst_down_lw_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfci_cpl, Atm_block, nb, rc=localrc) @@ -3042,15 +3051,6 @@ subroutine setup_exportdata(rc) ! MEAN NET sfc uv+vis diffused flux (W/m**2) case ('mean_net_sw_vis_dif_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) - ! MEAN precipitation rate (kg/m2/s) - case ('mean_prec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, rtimek, spval, rc=localrc) - ! MEAN convective precipitation rate (kg/m2/s) - case ('mean_prec_rate_conv') - call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, rtimek, spval, rc=localrc) - ! MEAN snow precipitation rate (kg/m2/s) - case ('mean_fprec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! oceanfrac used by atm to calculate fluxes case ('openwater_frac_in_atm') call block_data_combine_fractions(datar82d, GFS_data(nb)%sfcprop%oceanfrac, GFS_Data(nb)%sfcprop%fice, Atm_block, nb, rc=localrc) diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 884a3bdeb..83d62ee30 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -64,7 +64,7 @@ module module_cplfields FieldInfo("mean_evap_rate ", "s"), & FieldInfo("mean_down_lw_flx ", "s"), & FieldInfo("mean_down_sw_flx ", "s"), & - FieldInfo("mean_prec_rate ", "s"), & + FieldInfo("inst_prec_rate ", "s"), & FieldInfo("inst_zonal_moment_flx ", "s"), & FieldInfo("inst_merid_moment_flx ", "s"), & FieldInfo("inst_sensi_heat_flx ", "s"), & @@ -106,7 +106,7 @@ module module_cplfields FieldInfo("inst_merid_wind_height_lowest ", "s"), & FieldInfo("inst_pres_height_lowest ", "s"), & FieldInfo("inst_height_lowest ", "s"), & - FieldInfo("mean_fprec_rate ", "s"), & + FieldInfo("inst_fprec_rate ", "s"), & FieldInfo("openwater_frac_in_atm ", "s"), & FieldInfo("ice_fraction_in_atm ", "s"), & FieldInfo("lake_fraction ", "s"), & @@ -122,7 +122,7 @@ module module_cplfields FieldInfo("inst_merid_wind_height_lowest_from_phys ", "s"), & FieldInfo("inst_pres_height_lowest_from_phys ", "s"), & FieldInfo("inst_spec_humid_height_lowest_from_phys ", "s"), & - FieldInfo("mean_prec_rate_conv ", "s"), & + FieldInfo("inst_prec_rate_conv ", "s"), & FieldInfo("inst_temp_height_lowest_from_phys ", "s"), & FieldInfo("inst_exner_function_height_lowest ", "s"), & FieldInfo("surface_friction_velocity ", "s"), & @@ -168,13 +168,13 @@ module module_cplfields FieldInfo("sea_ice_surface_temperature ", "s"), & FieldInfo("sea_surface_temperature ", "s"), & FieldInfo("ice_fraction ", "s"), & - FieldInfo("mean_up_lw_flx_ice ", "s"), & - FieldInfo("mean_laten_heat_flx_atm_into_ice ", "s"), & - FieldInfo("mean_sensi_heat_flx_atm_into_ice ", "s"), & + FieldInfo("lwup_flx_ice ", "s"), & + FieldInfo("laten_heat_flx_atm_into_ice ", "s"), & + FieldInfo("sensi_heat_flx_atm_into_ice ", "s"), & FieldInfo("stress_on_air_ice_zonal ", "s"), & FieldInfo("stress_on_air_ice_merid ", "s"), & - FieldInfo("mean_ice_volume ", "s"), & - FieldInfo("mean_snow_volume ", "s"), & + FieldInfo("sea_ice_volume ", "s"), & + FieldInfo("snow_volume_on_sea_ice ", "s"), & FieldInfo("inst_ice_ir_dif_albedo ", "s"), & FieldInfo("inst_ice_ir_dir_albedo ", "s"), & FieldInfo("inst_ice_vis_dif_albedo ", "s"), & @@ -185,9 +185,9 @@ module module_cplfields ! For receiving fluxes from mediator FieldInfo("stress_on_air_ocn_zonal ", "s"), & FieldInfo("stress_on_air_ocn_merid ", "s"), & - FieldInfo("mean_laten_heat_flx_atm_into_ocn ", "s"), & - FieldInfo("mean_sensi_heat_flx_atm_into_ocn ", "s"), & - FieldInfo("mean_up_lw_flx_ocn ", "s"), & + FieldInfo("laten_heat_flx_atm_into_ocn ", "s"), & + FieldInfo("sensi_heat_flx_atm_into_ocn ", "s"), & + FieldInfo("lwup_flx_ocn ", "s"), & ! For JEDI ! dynamics From eadb52f6953502d8f5fc6ee3d07b257571013345 Mon Sep 17 00:00:00 2001 From: AnningCheng-NOAA <48297505+AnningCheng-NOAA@users.noreply.github.com> Date: Tue, 17 Oct 2023 15:58:59 -0400 Subject: [PATCH 25/48] bug fixed for mraerosol (#700) * bug fixed for mraerosol * update upp revision --- ccpp/physics | 2 +- upp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index dd91c3af6..69c9764f3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit dd91c3af6296f69c4b3630f774374d51d928887c +Subproject commit 69c9764f3ad33ec94ecc5c45891ad9745da5c569 diff --git a/upp b/upp index 520cc233f..fae617ba4 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit 520cc233f7919dbbe5dc7fc0246354ae95caa2dc +Subproject commit fae617ba485dbbadc8fc10f512a6a0c29c81741a From 1a5ad28a3cdeee181ea198d4e3736da3fb40917b Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 20 Oct 2023 13:20:54 -0400 Subject: [PATCH 26/48] allow cpllnd to use inst lw and sw down (#711) * allow cpllnd to use inst lw and sw down * change print statements to use ufs, not nems * update active attributes in GFS_typedefs.meta * add flag_for_land_coupling to active value for both dlwsfci_cpl and dswsfci_cpl * update ccpp and revert gitmodules --- ccpp/data/GFS_typedefs.F90 | 146 ++++++++++++++++++------------------ ccpp/data/GFS_typedefs.meta | 18 ++--- ccpp/physics | 2 +- fv3_cap.F90 | 8 +- module_fcst_grid_comp.F90 | 4 +- 5 files changed, 89 insertions(+), 89 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 580101d68..bfb6af571 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -135,7 +135,7 @@ module GFS_typedefs integer, pointer :: tracer_types(:) !< tracers types: 0=generic, 1=chem,prog, 2=chem,diag character(len=64) :: fn_nml !< namelist filename character(len=:), pointer, dimension(:) :: input_nml_file => null() !< character string containing full namelist - !< for use with internal file reads + !< for use with internal file reads end type GFS_init_type @@ -217,19 +217,19 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth [ m ] real (kind=kind_phys), pointer :: clm_lakedepth(:) => null() !< clm internal lake depth [ m ] integer, pointer :: use_lake_model(:) => null()!1=run lake, 2=run lake&nsst, 0=no lake - real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model + real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model real (kind=kind_phys), pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model - real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] - real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K - real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] - real (kind=kind_phys), pointer :: h_talb(:) => null() !the thermally active layer depth of the bottom sediments [m] - real (kind=kind_phys), pointer :: t_talb(:) => null() !Temperature at the bottom of the sediment upper layer [K] - real (kind=kind_phys), pointer :: t_bot1(:) => null() !Temperature at the water-bottom sediment interface [K] + real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] + real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K + real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] + real (kind=kind_phys), pointer :: h_talb(:) => null() !the thermally active layer depth of the bottom sediments [m] + real (kind=kind_phys), pointer :: t_talb(:) => null() !Temperature at the bottom of the sediment upper layer [K] + real (kind=kind_phys), pointer :: t_bot1(:) => null() !Temperature at the water-bottom sediment interface [K] real (kind=kind_phys), pointer :: t_bot2(:) => null() !Temperature for bottom layer of water [K] - real (kind=kind_phys), pointer :: c_t(:) => null() !Shape factor of water temperature vertical profile - real (kind=kind_phys), pointer :: T_snow(:) => null() !temperature of snow on a lake [K] - real (kind=kind_phys), pointer :: T_ice(:) => null() !temperature of ice on a lake [K] + real (kind=kind_phys), pointer :: c_t(:) => null() !Shape factor of water temperature vertical profile + real (kind=kind_phys), pointer :: T_snow(:) => null() !temperature of snow on a lake [K] + real (kind=kind_phys), pointer :: T_ice(:) => null() !temperature of ice on a lake [K] real (kind=kind_phys), pointer :: tsfc (:) => null() !< surface air temperature in K real (kind=kind_phys), pointer :: vegtype_frac (:,:) => null() !< fractions [0:1] of veg. categories @@ -525,7 +525,7 @@ module GFS_typedefs ! real (kind=kind_phys), pointer :: sfc_alb_vis_dif_cpl(:) => null() !< sfc vis albedo for diffuse rad !--- only variable needed for cplwav2atm=.TRUE. ! real (kind=kind_phys), pointer :: zorlwav_cpl(:) => null() !< roughness length from wave model - !--- also needed for ice/ocn coupling + !--- also needed for ice/ocn coupling real (kind=kind_phys), pointer :: slimskin_cpl(:)=> null() !< aoi_fld%slimskin(item,lan) !--- variables needed for use_med_flux =.TRUE. real (kind=kind_phys), pointer :: dusfcin_med(:) => null() !< sfc u momentum flux over ocean @@ -604,7 +604,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: spp_wts_mp (:,:) => null() ! spp-mp-perts real (kind=kind_phys), pointer :: spp_wts_gwd (:,:) => null() ! spp-gwd-perts real (kind=kind_phys), pointer :: spp_wts_rad (:,:) => null() ! spp-rad-perts - real (kind=kind_phys), pointer :: spp_wts_cu_deep (:,:) => null() ! spp-cu-deep-perts + real (kind=kind_phys), pointer :: spp_wts_cu_deep (:,:) => null() ! spp-cu-deep-perts !--- aerosol surface emissions for Thompson microphysics real (kind=kind_phys), pointer :: nwfa2d (:) => null() !< instantaneous water-friendly sfc aerosol source @@ -837,7 +837,7 @@ module GFS_typedefs !< 1: K day-1 - 2: K s-1 logical :: inc_minor_gas !< Include minor trace gases in RRTMG radiation calculation? integer :: ipsd0 !< initial permutaion seed for mcica radiation - integer :: ipsdlim !< limit initial permutaion seed for mcica radiation + integer :: ipsdlim !< limit initial permutaion seed for mcica radiation logical :: lrseeds !< flag to use host-provided random seeds integer :: nrstreams !< number of random number streams in host-provided random seed array logical :: lextop !< flag for using an extra top layer for radiation @@ -869,10 +869,10 @@ module GFS_typedefs real(kind_phys) :: lfnc_p0 !< Logistic function transition level (Pa) logical :: doGP_lwscat !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics logical :: doGP_sgs_cnv !< If true, include SubGridScale convective cloud in RRTMGP - logical :: doGP_sgs_mynn !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP + logical :: doGP_sgs_mynn !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP integer :: rrtmgp_lw_phys_blksz !< Number of columns to pass to RRTMGP LW per block. integer :: rrtmgp_sw_phys_blksz !< Number of columns to pass to RRTMGP SW per block. - logical :: doGP_smearclds !< If true, include implicit SubGridScale clouds in RRTMGP + logical :: doGP_smearclds !< If true, include implicit SubGridScale clouds in RRTMGP real(kind_phys) :: minGPpres !< Minimum pressure allowed in RRTMGP. real(kind_phys) :: maxGPpres !< Maximum pressure allowed in RRTMGP. real(kind_phys) :: minGPtemp !< Minimum temperature allowed in RRTMGP. @@ -965,9 +965,9 @@ module GFS_typedefs real(kind=kind_phys) :: nssl_cccn !< CCN concentration (m-3) real(kind=kind_phys) :: nssl_alphah !< graupel shape parameter real(kind=kind_phys) :: nssl_alphahl !< hail shape parameter - real(kind=kind_phys) :: nssl_alphar ! shape parameter for rain (imurain=1 only) - real(kind=kind_phys) :: nssl_ehw0 ! constant or max assumed graupel-droplet collection efficiency - real(kind=kind_phys) :: nssl_ehlw0 ! constant or max assumed hail-droplet collection efficiency + real(kind=kind_phys) :: nssl_alphar ! shape parameter for rain (imurain=1 only) + real(kind=kind_phys) :: nssl_ehw0 ! constant or max assumed graupel-droplet collection efficiency + real(kind=kind_phys) :: nssl_ehlw0 ! constant or max assumed hail-droplet collection efficiency logical :: nssl_hail_on !< NSSL flag to activate the hail category logical :: nssl_ccn_on !< NSSL flag to activate the CCN category logical :: nssl_invertccn !< NSSL flag to treat CCN as activated (true) or unactivated (false) @@ -1040,7 +1040,7 @@ module GFS_typedefs integer :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) integer :: iopt_stc !snow/soil temperature time scheme (only layer 1) integer :: iopt_trs !thermal roughness scheme (1-z0h=z0m; 2-czil; 3-ec;4-kb inversed) - integer :: iopt_diag !2m t/q diagnostic approach (1->external GFS sfc_diag 2->original NoahMP 2-title 3->NoahMP + integer :: iopt_diag !2m t/q diagnostic approach (1->external GFS sfc_diag 2->original NoahMP 2-title 3->NoahMP !2-title + internal GFS sfc_diag ) ! -- RUC LSM options @@ -1146,7 +1146,7 @@ module GFS_typedefs integer :: imfshalcnv_ntiedtke = 4 !< flag for new Tiedtke scheme (CAPS) integer :: imfshalcnv_c3 = 5 !< flag for the Community Convective Cloud (C3) scheme logical :: hwrf_samfdeep !< flag for HWRF SAMF deepcnv scheme (HWRF) - logical :: progsigma !< flag for prognostic area fraction in samf ddepcnv scheme (GFS) + logical :: progsigma !< flag for prognostic area fraction in samf ddepcnv scheme (GFS) integer :: imfdeepcnv !< flag for mass-flux deep convection scheme !< 1: July 2010 version of SAS conv scheme !< current operational version as of 2016 @@ -1212,7 +1212,7 @@ module GFS_typedefs real(kind=kind_phys) :: bl_mynn_closure !< flag to determine closure level of MYNN logical :: sfclay_compute_flux!< flag for thermal roughness lengths over water in mynnsfclay logical :: sfclay_compute_diag!< flag for computing surface diagnostics in mynnsfclay - integer :: isftcflx !< flag for thermal roughness lengths over water in mynnsfclay + integer :: isftcflx !< flag for thermal roughness lengths over water in mynnsfclay integer :: iz0tlnd !< flag for thermal roughness lengths over land in mynnsfclay real(kind=kind_phys) :: var_ric real(kind=kind_phys) :: coef_ric_l @@ -1365,7 +1365,7 @@ module GFS_typedefs integer :: spp_gwd integer :: spp_cu_deep integer :: n_var_spp - character(len=10) , pointer :: spp_var_list(:) + character(len=10) , pointer :: spp_var_list(:) real(kind=kind_phys), pointer :: spp_prt_list(:) real(kind=kind_phys), pointer :: spp_stddev_cutoff(:) @@ -1429,7 +1429,7 @@ module GFS_typedefs integer :: ntgv !< tracer index for graupel particle volume integer :: nthv !< tracer index for hail particle volume integer :: ntke !< tracer index for kinetic energy - integer :: ntsigma !< tracer index for updraft area fraction + integer :: ntsigma !< tracer index for updraft area fraction integer :: nto !< tracer index for oxygen ion integer :: nto2 !< tracer index for oxygen integer :: ntwa !< tracer index for water friendly aerosol @@ -1942,7 +1942,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: zmtnblck(:) => null() ! null() !< tracer changes due to physics @@ -2867,6 +2867,8 @@ subroutine coupling_create (Coupling, IM, Model) ! endif if (Model%cplflx .or. Model%cpllnd) then + allocate (Coupling%dlwsfci_cpl (IM)) + allocate (Coupling%dswsfci_cpl (IM)) allocate (Coupling%dlwsfc_cpl (IM)) allocate (Coupling%dswsfc_cpl (IM)) allocate (Coupling%psurfi_cpl (IM)) @@ -2881,6 +2883,8 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%nvisbm_cpl (IM)) allocate (Coupling%nvisdf_cpl (IM)) + Coupling%dlwsfci_cpl = clear_val + Coupling%dswsfci_cpl = clear_val Coupling%dlwsfc_cpl = clear_val Coupling%dswsfc_cpl = clear_val Coupling%psurfi_cpl = clear_val @@ -2971,8 +2975,6 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%dvsfci_cpl (IM)) allocate (Coupling%dtsfci_cpl (IM)) allocate (Coupling%dqsfci_cpl (IM)) - allocate (Coupling%dlwsfci_cpl (IM)) - allocate (Coupling%dswsfci_cpl (IM)) allocate (Coupling%dnirbmi_cpl (IM)) allocate (Coupling%dnirdfi_cpl (IM)) allocate (Coupling%dvisbmi_cpl (IM)) @@ -2987,8 +2989,6 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%dvsfci_cpl = clear_val Coupling%dtsfci_cpl = clear_val Coupling%dqsfci_cpl = clear_val - Coupling%dlwsfci_cpl = clear_val - Coupling%dswsfci_cpl = clear_val Coupling%dnirbmi_cpl = clear_val Coupling%dnirdfi_cpl = clear_val Coupling%dvisbmi_cpl = clear_val @@ -3083,13 +3083,13 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%skebu_wts = clear_val Coupling%skebv_wts = clear_val endif - + !--- stochastic land perturbation option if (Model%lndp_type /= 0) then allocate (Coupling%sfc_wts (IM,Model%n_var_lndp)) Coupling%sfc_wts = clear_val endif - + !--- stochastic spp perturbation option if (Model%do_spp) then allocate (Coupling%spp_wts_pbl (IM,Model%levs)) @@ -3324,7 +3324,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: swhtr = .true. !< flag to output sw heating rate (Radtend%swhc) integer :: rad_hr_units = 2 !< heating rate units are K s-1 logical :: inc_minor_gas = .true. !< Include minor trace gases in RRTMG radiation calculation - integer :: ipsd0 = 0 !< initial permutaion seed for mcica radiation + integer :: ipsd0 = 0 !< initial permutaion seed for mcica radiation integer :: ipsdlim = 1e8 !< limit initial permutaion seed for mcica radiation logical :: lrseeds = .false. !< flag to use host-provided random seeds integer :: nrstreams = 2 !< number of random number streams in host-provided random seed array @@ -3339,7 +3339,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & character(len=128) :: sw_file_gas = '' !< RRTMGP K-distribution file, coefficients to compute optics for gaseous atmosphere character(len=128) :: sw_file_clouds = '' !< RRTMGP file containing coefficients used to compute clouds optical properties integer :: rrtmgp_nBandsSW = -999 !< Number of RRTMGP SW bands. # *NOTE* - integer :: rrtmgp_nGptsSW = -999 !< Number of RRTMGP SW spectral points. # The RRTMGP spectral dimensions in the files + integer :: rrtmgp_nGptsSW = -999 !< Number of RRTMGP SW spectral points. # The RRTMGP spectral dimensions in the files integer :: rrtmgp_nBandsLW = -999 !< Number of RRTMGP LW bands. # need to be provided via namelsit. integer :: rrtmgp_nGptsLW = -999 !< Number of RRTMGP LW spectral points. # logical :: doG_cldoptics = .false. !< Use legacy RRTMG cloud-optics? @@ -3358,7 +3358,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: doGP_sgs_mynn = .false. !< If true, include SubGridScale MYNN-EDMF cloud in RRTMGP integer :: rrtmgp_lw_phys_blksz= 1 !< Number of columns for RRTMGP LW scheme to process at each instance. integer :: rrtmgp_sw_phys_blksz= 1 !< Number of columns for RRTMGP SW scheme to process at each instance. - logical :: doGP_smearclds = .true. !< If true, include implicit SubGridScale clouds in RRTMGP + logical :: doGP_smearclds = .true. !< If true, include implicit SubGridScale clouds in RRTMGP !--- Z-C microphysical parameters integer :: imp_physics = 99 !< choice of cloud scheme real(kind=kind_phys) :: psautco(2) = (/6.0d-4,3.0d-4/) !< [in] auto conversion coeff from ice to snow @@ -3411,9 +3411,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: nssl_cccn = 0.6e9 !< CCN concentration (m-3) real(kind=kind_phys) :: nssl_alphah = 0.0 !< graupel shape parameter real(kind=kind_phys) :: nssl_alphahl = 1.0 !< hail shape parameter - real(kind=kind_phys) :: nssl_alphar = 0.0 ! shape parameter for rain (imurain=1 only) - real(kind=kind_phys) :: nssl_ehw0 = 0.9 ! constant or max assumed graupel-droplet collection efficiency - real(kind=kind_phys) :: nssl_ehlw0 = 0.9 ! constant or max assumed hail-droplet collection efficiency + real(kind=kind_phys) :: nssl_alphar = 0.0 ! shape parameter for rain (imurain=1 only) + real(kind=kind_phys) :: nssl_ehw0 = 0.9 ! constant or max assumed graupel-droplet collection efficiency + real(kind=kind_phys) :: nssl_ehlw0 = 0.9 ! constant or max assumed hail-droplet collection efficiency logical :: nssl_hail_on = .false. !< NSSL flag to activate the hail category logical :: nssl_ccn_on = .true. !< NSSL flag to activate the CCN category logical :: nssl_invertccn = .true. !< NSSL flag to treat CCN as activated (true) or unactivated (false) @@ -3425,7 +3425,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: nsfullradar_diag = -999.0 !< seconds between resetting radar reflectivity calculation, set to <0 for every time step real(kind=kind_phys) :: ttendlim = -999.0 !< temperature tendency limiter, set to <0 to deactivate logical :: ext_diag_thompson = .false. !< flag for extended diagnostic output from Thompson - real(kind=kind_phys) :: dt_inner = -999.0 !< time step for the inner loop + real(kind=kind_phys) :: dt_inner = -999.0 !< time step for the inner loop logical :: sedi_semi = .false. !< flag for semi Lagrangian sedi of rain integer :: decfl = 8 !< deformed CFL factor @@ -3710,7 +3710,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: thsfc_loc = .true. !< flag for local vs. standard potential temperature !--- flux method in 2-m diagnostics logical :: diag_flux = .false. !< flag for flux method in 2-m diagnostics -!--- flux method in 2-m diagnostics (for stable conditions) +!--- flux method in 2-m diagnostics (for stable conditions) logical :: diag_log = .false. !< flag for log method in 2-m diagnostics (for stable conditions) !<.true. means use local (gridpoint) surface pressure to define potential temperature !< this is the current GFS physics approach @@ -3739,7 +3739,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: nca = 1 integer :: ncells = 5 integer :: nlives = 12 - + integer :: nca_g = 1 integer :: ncells_g = 1 integer :: nlives_g = 100 @@ -3840,7 +3840,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: radar_tten_limits(2) = (/ limit_unspecified, limit_unspecified /) integer :: itime integer :: w3kindreal,w3kindint - + !--- END NAMELIST VARIABLES NAMELIST /gfs_physics_nml/ & @@ -4503,7 +4503,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & stop end if Model%lradar = lradar - Model%nsfullradar_diag = nsfullradar_diag + Model%nsfullradar_diag = nsfullradar_diag Model%ttendlim = ttendlim Model%ext_diag_thompson= ext_diag_thompson if (dt_inner>0) then @@ -4618,7 +4618,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & (Model%imp_physics /= Model%imp_physics_gfdl .and. Model%imp_physics /= Model%imp_physics_thompson .and. & Model%imp_physics /= Model%imp_physics_nssl )) then !see GFS_MP_generic_post.F90; exticeden is only compatible with GFDL, - !Thompson, or NSSL MP + !Thompson, or NSSL MP print *,' Using exticeden = T is only valid when using GFDL, Thompson, or NSSL microphysics.' stop end if @@ -4909,7 +4909,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lndp_var_list(:) = '' Model%lndp_prt_list(:) = clear_val end if - + if (Model%do_spp) then allocate(Model%spp_var_list(Model%n_var_spp)) allocate(Model%spp_prt_list(Model%n_var_spp)) @@ -4924,7 +4924,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & allocate(Model%vfact_ca(levs)) if ( .not. ca_global ) nca_g=0 if ( .not. ca_sgs ) nca=0 - + Model%nca = nca Model%ncells = ncells Model%nlives = nlives @@ -4976,7 +4976,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & #else Model%ntoz = get_tracer_index(Model%tracer_names, 'o3mr', Model%me, Model%master, Model%debug) if( Model%ntoz <= 0 ) & - Model%ntoz = get_tracer_index(Model%tracer_names, 'spo3', Model%me, Model%master, Model%debug) + Model%ntoz = get_tracer_index(Model%tracer_names, 'spo3', Model%me, Model%master, Model%debug) #endif Model%ntcw = get_tracer_index(Model%tracer_names, 'liq_wat', Model%me, Model%master, Model%debug) Model%ntiw = get_tracer_index(Model%tracer_names, 'ice_wat', Model%me, Model%master, Model%debug) @@ -5273,7 +5273,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & call fill_dtidx(Model,dtend_select,100+Model%ntoz,Model%index_of_process_photochem,have_oz_phys) call fill_dtidx(Model,dtend_select,100+Model%ntoz,Model%index_of_process_physics,.true.) call fill_dtidx(Model,dtend_select,100+Model%ntoz,Model%index_of_process_non_physics,.true.) - + if(.not.Model%do_mynnedmf .and. .not. Model%satmedmf) then call fill_dtidx(Model,dtend_select,100+Model%ntqv,Model%index_of_process_pbl,have_pbl) call fill_dtidx(Model,dtend_select,100+Model%ntcw,Model%index_of_process_pbl,have_pbl) @@ -5331,9 +5331,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & write(*,*) 'NSSL micro: CCNA is ON' ENDIF ENDIF - + if (Model%me == Model%master) then - write(*,*) 'Model%nthl = ',Model%nthl + write(*,*) 'Model%nthl = ',Model%nthl ENDIF IF ( ( Model%nthl < 1 ) ) THEN ! check if hail is in the field_table. If not, set flag so the microphysics knows. if (Model%me == Model%master) then @@ -5343,9 +5343,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & nssl_hail_on = .false. Model%nssl_hail_on = .false. ! pretend that hail exists so that bad arrays are not passed to microphysics -! Model%nthl = Max( 1, Model%ntgl ) -! Model%nthv = Max( 1, Model%ntgv ) -! Model%nthnc = Max( 1, Model%ntgnc ) +! Model%nthl = Max( 1, Model%ntgl ) +! Model%nthv = Max( 1, Model%ntgv ) +! Model%nthnc = Max( 1, Model%ntgnc ) ELSE nssl_hail_on = .true. Model%nssl_hail_on = .true. @@ -5378,16 +5378,16 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ENDIF ENDIF - IF ( Model%ntgl < 1 .or. Model%ntgv < 1 .or. Model%ntgnc < 1 .or. & - Model%ntsw < 1 .or. Model%ntsnc < 1 .or. & - Model%ntrw < 1 .or. Model%ntrnc < 1 .or. & - Model%ntiw < 1 .or. Model%ntinc < 1 .or. & - Model%ntcw < 1 .or. Model%ntlnc < 1 & + IF ( Model%ntgl < 1 .or. Model%ntgv < 1 .or. Model%ntgnc < 1 .or. & + Model%ntsw < 1 .or. Model%ntsnc < 1 .or. & + Model%ntrw < 1 .or. Model%ntrnc < 1 .or. & + Model%ntiw < 1 .or. Model%ntinc < 1 .or. & + Model%ntcw < 1 .or. Model%ntlnc < 1 & ) THEN if (Model%me == Model%master) write(0,*) 'missing needed tracers for NSSL!' stop ENDIF - + ENDIF !} @@ -5858,7 +5858,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 - Model%nreffr = 4 + Model%nreffr = 4 Model%lradar = .true. if (.not. Model%effr_in) then print *,' NSSL MP requires effr_in to be set to .true., changing value from false to true' @@ -5896,7 +5896,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ' ttendlim =',Model%ttendlim, & ' ext_diag_thompson =',Model%ext_diag_thompson, & ' dt_inner =',Model%dt_inner, & - ' sedi_semi=',Model%sedi_semi, & + ' sedi_semi=',Model%sedi_semi, & ' decfl=',decfl, & ' effr_in =',Model%effr_in, & ' lradar =',Model%lradar, & @@ -6063,7 +6063,7 @@ subroutine control_initialize_radar_tten(Model, radar_tten_limits) ! Helper subroutine for initializing variables for radar-derived ! temperature tendency or convection suppression. - + class(GFS_control_type) :: Model real(kind_phys) :: radar_tten_limits(2) integer :: i @@ -6237,7 +6237,7 @@ subroutine control_print(Model) !--- local variables integer :: i - + if (Model%me == Model%master) then print *, ' ' print *, 'basic control parameters' @@ -6442,8 +6442,8 @@ subroutine control_print(Model) print *, ' nssl_alphah - graupel shape parameter : ', Model%nssl_alphah print *, ' nssl_alphahl - hail shape parameter : ', Model%nssl_alphahl print *, ' nssl_alphar - rain shape parameter : ', Model%nssl_alphar - print *, ' nssl_ehw0 - graupel-droplet collection effiency : ', Model%nssl_ehw0 - print *, ' nssl_ehlw0 - hail-droplet collection effiency : ', Model%nssl_ehlw0 + print *, ' nssl_ehw0 - graupel-droplet collection effiency : ', Model%nssl_ehw0 + print *, ' nssl_ehlw0 - hail-droplet collection effiency : ', Model%nssl_ehlw0 print *, ' nssl_hail_on - hail activation flag : ', Model%nssl_hail_on print *, ' lradar - radar refl. flag : ', Model%lradar print *, ' lrefres : ', Model%lrefres @@ -7341,14 +7341,14 @@ subroutine allocate_dtend_labels_and_causes(Model) implicit none type(GFS_control_type), intent(inout) :: Model integer :: i - + allocate(Model%dtend_var_labels(Model%ntracp100)) allocate(Model%dtend_process_labels(Model%nprocess)) - + Model%dtend_var_labels(1)%name = 'unallocated' Model%dtend_var_labels(1)%desc = 'unallocated tracer' Model%dtend_var_labels(1)%unit = 'kg kg-1 s-1' - + do i=2,Model%ntracp100 Model%dtend_var_labels(i)%name = 'unknown' Model%dtend_var_labels(i)%desc = 'unspecified tracer' @@ -7361,24 +7361,24 @@ subroutine allocate_dtend_labels_and_causes(Model) Model%dtend_process_labels(i)%mod_name = 'gfs_phys' enddo end subroutine allocate_dtend_labels_and_causes - + subroutine label_dtend_tracer(Model,itrac,name,desc,unit) implicit none type(GFS_control_type), intent(inout) :: Model integer, intent(in) :: itrac character(len=*), intent(in) :: name, desc character(len=*), intent(in) :: unit - + if(itrac<2) then ! Special index 1 is for unallocated tracers return endif - + Model%dtend_var_labels(itrac)%name = name Model%dtend_var_labels(itrac)%desc = desc Model%dtend_var_labels(itrac)%unit = unit end subroutine label_dtend_tracer - + subroutine label_dtend_cause(Model,icause,name,desc,mod_name,time_avg) implicit none type(GFS_control_type), intent(inout) :: Model @@ -7386,7 +7386,7 @@ subroutine label_dtend_cause(Model,icause,name,desc,mod_name,time_avg) character(len=*), intent(in) :: name, desc character(len=*), optional, intent(in) :: mod_name logical, optional, intent(in) :: time_avg - + Model%dtend_process_labels(icause)%name=name Model%dtend_process_labels(icause)%desc=desc if(present(mod_name)) then @@ -7770,7 +7770,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%evcw = zero Diag%trans = zero Diag%snowmt_land= zero - Diag%snowmt_ice = zero + Diag%snowmt_ice = zero Diag%soilm = zero Diag%tmpmin = Model%huge Diag%tmpmax = zero diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index a4a941074..4f3a757b8 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2541,7 +2541,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [dswsfci_cpl] standard_name = surface_downwelling_shortwave_flux_for_coupling long_name = instantaneous sfc downward sw flux @@ -2549,7 +2549,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [dnirbmi_cpl] standard_name = surface_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous sfc nir beam downward sw flux @@ -2845,7 +2845,7 @@ kind = kind_phys active = (do_stochastically_perturbed_parameterizations) [spp_wts_sfc] - standard_name = spp_weights_for_surface_layer_scheme + standard_name = spp_weights_for_surface_layer_scheme long_name = spp weights for surface layer scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -2854,7 +2854,7 @@ active = (do_stochastically_perturbed_parameterizations) [spp_wts_mp] standard_name = spp_weights_for_microphysics_scheme - long_name = spp weights for microphysics scheme + long_name = spp weights for microphysics scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -2862,7 +2862,7 @@ active = (do_stochastically_perturbed_parameterizations) [spp_wts_gwd] standard_name = spp_weights_for_gravity_wave_drag_scheme - long_name = spp weights for gravity wave drag scheme + long_name = spp weights for gravity wave drag scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -2870,7 +2870,7 @@ active = (do_stochastically_perturbed_parameterizations) [spp_wts_rad] standard_name = spp_weights_for_radiation_scheme - long_name = spp weights for radiation scheme + long_name = spp weights for radiation scheme units = 1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -3672,7 +3672,7 @@ type = integer [inc_minor_gas] standard_name = flag_to_include_minor_gases_in_rrtmg - long_name = flag to include minor trace gases in rrtmg + long_name = flag to include minor trace gases in rrtmg units = flag dimensions = () type = logical @@ -6283,7 +6283,7 @@ type = integer [ntbcl] standard_name = index_for_bcphilic - long_name = index for bcphilic + long_name = index for bcphilic units = index dimensions = () type = integer @@ -6295,7 +6295,7 @@ type = integer [ntocl] standard_name = index_for_ocphilic - long_name = index for ocphilic + long_name = index for ocphilic units = index dimensions = () type = integer diff --git a/ccpp/physics b/ccpp/physics index 69c9764f3..085f608bc 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 69c9764f3ad33ec94ecc5c45891ad9745da5c569 +Subproject commit 085f608bc13b691bdc8049d44f359d6253140cd7 diff --git a/fv3_cap.F90 b/fv3_cap.F90 index fa8a549d6..efd84211f 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -298,7 +298,7 @@ subroutine InitializeAdvertise(gcomp, rc) noutput_fh = ESMF_ConfigGetLen(config=CF, label ='output_fh:',rc=rc) - if(mype == 0) print *,'af nems config,quilting=',quilting,' calendar=', trim(calendar),' iau_offset=',iau_offset, & + if(mype == 0) print *,'af ufs config,quilting=',quilting,' calendar=', trim(calendar),' iau_offset=',iau_offset, & ' noutput_fh=',noutput_fh ! nfhout = 0 ; nfhmax_hf = 0 ; nfhout_hf = 0 ; nsout = 0 @@ -320,7 +320,7 @@ subroutine InitializeAdvertise(gcomp, rc) label ='isrcTermProcessing:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if(mype == 0) print *,'af nems config,quilting=',quilting,' write_groups=', & + if(mype == 0) print *,'af ufs config,quilting=',quilting,' write_groups=', & write_groups,wrttasks_per_group_from_parent,' isrcTermProcessing=', isrcTermProcessing ! call ESMF_ConfigGetAttribute(config=CF,value=num_files, & @@ -341,7 +341,7 @@ subroutine InitializeAdvertise(gcomp, rc) call ESMF_ConfigGetAttribute(config=CF, value=nsout, label ='nsout:', default=-1,rc=rc) nsout_io = nsout ! - if(mype==0) print *,'af nems config,nfhout,nsout=',nfhout,nfhmax_hf,nfhout_hf, nsout,noutput_fh + if(mype==0) print *,'af ufs config,nfhout,nsout=',nfhout,nfhmax_hf,nfhout_hf, nsout,noutput_fh call ESMF_ConfigGetAttribute(config=CF, value=time_unlimited, label ='time_unlimited:', default=.false., rc=rc) @@ -349,7 +349,7 @@ subroutine InitializeAdvertise(gcomp, rc) ! call ESMF_ConfigGetAttribute(config=CF, value=dt_atmos, label ='dt_atmos:', rc=rc) call ESMF_ConfigGetAttribute(config=CF, value=nfhmax, label ='nhours_fcst:',rc=rc) - if(mype == 0) print *,'af nems config,dt_atmos=',dt_atmos,'nfhmax=',nfhmax + if(mype == 0) print *,'af ufs config,dt_atmos=',dt_atmos,'nfhmax=',nfhmax call ESMF_TimeIntervalSet(timeStep, s=dt_atmos, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 1c2c628ed..4bc7bfe52 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -606,14 +606,14 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) num_restart_interval = ESMF_ConfigGetLen(config=CF, label ='restart_interval:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (mype == 0) print *,'af nems config,num_restart_interval=',num_restart_interval + if (mype == 0) print *,'af ufs config,num_restart_interval=',num_restart_interval if (num_restart_interval<=0) num_restart_interval = 1 allocate(restart_interval(num_restart_interval)) restart_interval = 0 call ESMF_ConfigGetAttribute(CF,valueList=restart_interval,label='restart_interval:', & count=num_restart_interval, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (mype == 0) print *,'af nems config,restart_interval=',restart_interval + if (mype == 0) print *,'af ufs config,restart_interval=',restart_interval ! call fms_init(fcst_mpi_comm) call mpp_init() From 7f941323e754b61f3368dffb89ebee3d362abeda Mon Sep 17 00:00:00 2001 From: mdtoyNOAA <73618848+mdtoyNOAA@users.noreply.github.com> Date: Mon, 23 Oct 2023 17:17:11 -0600 Subject: [PATCH 27/48] Develop meso fix new ksmax (#703) * Added 'ugwpv1' suite definition files and fixed ccpp UGWP OGWD stability issues in upper atmosphere * Corrected new 'ugwpv1' SDF's * Updated ccpp-physics to incorporate PR#115 -- 'hr3_land_upgrades' --- ccpp/physics | 2 +- .../suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml | 96 +++++++++++++++++++ ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml | 95 ++++++++++++++++++ 3 files changed, 192 insertions(+), 1 deletion(-) create mode 100644 ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml diff --git a/ccpp/physics b/ccpp/physics index 085f608bc..1db569112 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 085f608bc13b691bdc8049d44f359d6253140cd7 +Subproject commit 1db569112ed60a0074028fccf7e09d3b47ce9f92 diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml new file mode 100644 index 000000000..e9cdb1c40 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml @@ -0,0 +1,96 @@ + + + + + + + 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 + rad_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_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + 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 + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_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 + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + phys_tend + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml new file mode 100644 index 000000000..fef14b176 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + rad_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_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_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 + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + phys_tend + + + + From 1250b416f526f102c021bf1ab62f583bcba2d249 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Tue, 31 Oct 2023 16:22:57 -0400 Subject: [PATCH 28/48] Add zstandard compression (#706) * Add zstandard compression * Enable shuffling with zstandard compression * Refactor io/module_write_netcdf.F90 --- io/module_fv3_io_def.F90 | 2 +- io/module_write_netcdf.F90 | 137 ++++++++++++----------------- io/module_write_restart_netcdf.F90 | 14 ++- io/module_wrt_grid_comp.F90 | 18 +++- 4 files changed, 88 insertions(+), 83 deletions(-) diff --git a/io/module_fv3_io_def.F90 b/io/module_fv3_io_def.F90 index 30fa553f6..fd9c129e0 100644 --- a/io/module_fv3_io_def.F90 +++ b/io/module_fv3_io_def.F90 @@ -29,7 +29,7 @@ module module_fv3_io_def real,dimension(:),allocatable :: cen_lon, cen_lat real,dimension(:),allocatable :: lon1, lat1, lon2, lat2, dlon, dlat real,dimension(:),allocatable :: stdlat1, stdlat2, dx, dy - integer,dimension(:),allocatable :: ideflate, nbits + integer,dimension(:),allocatable :: ideflate, nbits, zstandard_level integer,dimension(:),allocatable :: ichunk2d, jchunk2d, ichunk3d, jchunk3d, kchunk3d end module module_fv3_io_def diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 4b0506549..86650c6e7 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -7,13 +7,13 @@ module module_write_netcdf + use mpi use esmf use netcdf - use module_fv3_io_def,only : ideflate, nbits, & + use module_fv3_io_def,only : ideflate, nbits, zstandard_level, & ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d, & dx,dy,lon1,lat1,lon2,lat2, & time_unlimited - use mpi implicit none private @@ -83,8 +83,10 @@ subroutine write_netcdf(wrtfb, filename, & integer :: oldMode integer :: im_dimid, jm_dimid, tile_dimid, pfull_dimid, phalf_dimid, time_dimid, ch_dimid integer :: im_varid, jm_varid, tile_varid, lon_varid, lat_varid, timeiso_varid - integer, dimension(:), allocatable :: dimids_2d, dimids_3d + integer, dimension(:), allocatable :: dimids_2d, dimids_3d, dimids, chunksizes integer, dimension(:), allocatable :: varids + integer :: xtype + integer :: ishuffle logical shuffle logical :: is_cubed_sphere @@ -315,86 +317,61 @@ subroutine write_netcdf(wrtfb, filename, & call ESMF_FieldGet(fcstField(i), name=fldName, rank=rank, typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) par_access = NF90_INDEPENDENT - ! define variables + if (rank == 2) then - if (typekind == ESMF_TYPEKIND_R4) then - if (ideflate(grid_id) > 0) then - if (ichunk2d(grid_id) < 0 .or. jchunk2d(grid_id) < 0) then - ! let netcdf lib choose chunksize - ! shuffle filter on for 2d fields (lossless compression) - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_2d, varids(i), & - shuffle=.true.,deflate_level=ideflate(grid_id)); NC_ERR_STOP(ncerr) - else - if (is_cubed_sphere) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_2d, varids(i), & - shuffle=.true.,deflate_level=ideflate(grid_id),& - chunksizes=[ichunk2d(grid_id),jchunk2d(grid_id),tileCount,1]); NC_ERR_STOP(ncerr) - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_2d, varids(i), & - shuffle=.true.,deflate_level=ideflate(grid_id),& - chunksizes=[ichunk2d(grid_id),jchunk2d(grid_id), 1]); NC_ERR_STOP(ncerr) - end if - end if - ! compression filters require collective access. - par_access = NF90_COLLECTIVE - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_2d, varids(i)); NC_ERR_STOP(ncerr) - end if - else if (typekind == ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & - dimids_2d, varids(i)); NC_ERR_STOP(ncerr) - else - if (mype==0) write(0,*)'Unsupported typekind ', typekind - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + dimids = dimids_2d else if (rank == 3) then - if (typekind == ESMF_TYPEKIND_R4) then - if (ideflate(grid_id) > 0) then - ! shuffle filter off for 3d fields using lossy compression - if (nbits(grid_id) > 0) then - shuffle=.false. + dimids = dimids_3d + else + if (mype==0) write(0,*)'Unsupported rank ', rank + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + if (typekind == ESMF_TYPEKIND_R4) then + xtype = NF90_FLOAT + else if (typekind == ESMF_TYPEKIND_R8) then + xtype = NF90_DOUBLE + else + if (mype==0) write(0,*)'Unsupported typekind ', typekind + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! define variable + ncerr = nf90_def_var(ncid, trim(fldName), xtype, dimids, varids(i)) ; NC_ERR_STOP(ncerr) + + ! compression, shuffling and chunking + if (ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) then + par_access = NF90_COLLECTIVE + if (rank == 2 .and. ichunk2d(grid_id) > 0 .and. jchunk2d(grid_id) > 0) then + if (is_cubed_sphere) then + chunksizes = [im, jm, tileCount, 1] else - shuffle=.true. + chunksizes = [ichunk2d(grid_id), jchunk2d(grid_id), 1] end if - if (ichunk3d(grid_id) < 0 .or. jchunk3d(grid_id) < 0 .or. kchunk3d(grid_id) < 0) then - ! let netcdf lib choose chunksize - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_3d, varids(i), & - shuffle=shuffle,deflate_level=ideflate(grid_id)); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var_chunking(ncid, varids(i), NF90_CHUNKED, chunksizes) ; NC_ERR_STOP(ncerr) + else if (rank == 3 .and. ichunk3d(grid_id) > 0 .and. jchunk3d(grid_id) > 0 .and. kchunk3d(grid_id) > 0) then + if (is_cubed_sphere) then + chunksizes = [im, jm, lm, tileCount, 1] else - if (is_cubed_sphere) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_3d, varids(i), & - shuffle=shuffle,deflate_level=ideflate(grid_id),& - chunksizes=[ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id),tileCount,1]); NC_ERR_STOP(ncerr) - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_3d, varids(i), & - shuffle=shuffle,deflate_level=ideflate(grid_id),& - chunksizes=[ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id), 1]); NC_ERR_STOP(ncerr) - end if + chunksizes = [ichunk3d(grid_id), jchunk3d(grid_id), kchunk3d(grid_id), 1] end if - ! compression filters require collective access. - par_access = NF90_COLLECTIVE - else - ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, & - dimids_3d, varids(i)); NC_ERR_STOP(ncerr) - end if - else if (typekind == ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, trim(fldName), NF90_DOUBLE, & - dimids_3d, varids(i)); NC_ERR_STOP(ncerr) - else - if (mype==0) write(0,*)'Unsupported typekind ', typekind - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - else - if (mype==0) write(0,*)'Unsupported rank ', rank - call ESMF_Finalize(endflag=ESMF_END_ABORT) + ncerr = nf90_def_var_chunking(ncid, varids(i), NF90_CHUNKED, chunksizes) ; NC_ERR_STOP(ncerr) + end if + + ishuffle = NF90_SHUFFLE + ! shuffle filter off for 3d fields using lossy compression + if (rank == 3 .and. nbits(grid_id) > 0) then + ishuffle = NF90_NOSHUFFLE + end if + if (ideflate(grid_id) > 0) then + ncerr = nf90_def_var_deflate(ncid, varids(i), ishuffle, 1, ideflate(grid_id)) ; NC_ERR_STOP(ncerr) + else if (zstandard_level(grid_id) > 0) then + ncerr = nf90_def_var_deflate(ncid, varids(i), ishuffle, 0, 0) ; NC_ERR_STOP(ncerr) + ncerr = nf90_def_var_zstandard(ncid, varids(i), zstandard_level(grid_id)) ; NC_ERR_STOP(ncerr) + end if + end if + if (par) then ncerr = nf90_var_par_access(ncid, varids(i), par_access); NC_ERR_STOP(ncerr) end if @@ -649,7 +626,7 @@ subroutine write_netcdf(wrtfb, filename, & if (typekind == ESMF_TYPEKIND_R4) then if (par) then call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=array_r4_3d, rc=rc); ESMF_ERR_RETURN(rc) - if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0) then + if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0) then dataMax = maxval(array_r4_3d) dataMin = minval(array_r4_3d) call mpi_allreduce(mpi_in_place,dataMax,1,mpi_real4,mpi_max,mpi_comm,ierr) @@ -665,7 +642,7 @@ subroutine write_netcdf(wrtfb, filename, & call ESMF_ArrayGather(array, array_r4_3d_cube(:,:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) end do if (mype==0) then - if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0) then + if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0) then call quantize_array(array_r4_3d_cube, minval(array_r4_3d_cube), maxval(array_r4_3d_cube), nbits(grid_id), compress_err(i)) end if ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d_cube, start=start_idx); NC_ERR_STOP(ncerr) @@ -673,7 +650,7 @@ subroutine write_netcdf(wrtfb, filename, & else call ESMF_FieldGather(fcstField(i), array_r4_3d, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) if (mype==0) then - if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0) then + if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0) then call quantize_array(array_r4_3d, minval(array_r4_3d), maxval(array_r4_3d), nbits(grid_id), compress_err(i)) end if ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d, start=start_idx); NC_ERR_STOP(ncerr) @@ -711,7 +688,7 @@ subroutine write_netcdf(wrtfb, filename, & end do ! end fieldCount - if (ideflate(grid_id) > 0 .and. nbits(grid_id) > 0 .and. do_io) then + if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0 .and. do_io) then ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) do i=1, fieldCount if (compress_err(i) > 0) then diff --git a/io/module_write_restart_netcdf.F90 b/io/module_write_restart_netcdf.F90 index 7904fe4cd..ec46d6f23 100644 --- a/io/module_write_restart_netcdf.F90 +++ b/io/module_write_restart_netcdf.F90 @@ -7,10 +7,12 @@ module module_write_restart_netcdf + use mpi use esmf use fms + use mpp_mod, only : mpp_chksum ! needed for fms 2023.02 use netcdf - use mpi + use module_fv3_io_def,only : zstandard_level implicit none private @@ -372,6 +374,16 @@ subroutine write_restart_netcdf(wrtfb, filename, & ncerr = nf90_var_par_access(ncid, varids(i), par_access); NC_ERR_STOP(ncerr) end if + if (zstandard_level(1) > 0) then + ncerr = nf90_def_var_zstandard(ncid, varids(i), zstandard_level(1)) + if (ncerr /= nf90_noerr) then + if (ncerr == nf90_enofilter) then + if (mype==0) write(0,*) 'Zstandard filter not found.' + end if + NC_ERR_STOP(ncerr) + end if + end if + end do ! i=1,fieldCount ncerr = nf90_put_att(ncid, NF90_GLOBAL, "NumFilesInSet", 1); NC_ERR_STOP(ncerr) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 781d62685..ec8135217 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -29,6 +29,7 @@ module module_wrt_grid_comp use mpi use esmf use fms + use mpp_mod, only : mpp_init ! needed for fms 2023.02 use write_internal_state use module_fv3_io_def, only : num_pes_fcst, & @@ -40,7 +41,7 @@ module module_wrt_grid_comp cen_lon, cen_lat, & lon1, lat1, lon2, lat2, dlon, dlat, & stdlat1, stdlat2, dx, dy, iau_offset, & - ideflate, lflname_fulltime + ideflate, zstandard_level, lflname_fulltime use module_write_netcdf, only : write_netcdf use module_write_restart_netcdf use physcons, only : pi => con_pi @@ -361,6 +362,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, allocate(kchunk3d(ngrids)) allocate(ideflate(ngrids)) allocate(nbits(ngrids)) + allocate(zstandard_level(ngrids)) allocate(wrt_int_state%out_grid_info(ngrids)) @@ -466,13 +468,27 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_ConfigGetAttribute(config=CF,value=jchunk3d(n),default=0,label ='jchunk3d:',rc=rc) call ESMF_ConfigGetAttribute(config=CF,value=kchunk3d(n),default=0,label ='kchunk3d:',rc=rc) + ! zstandard compression flag + call ESMF_ConfigGetAttribute(config=CF,value=zstandard_level(n),default=0,label ='zstandard_level:',rc=rc) + if (zstandard_level(n) < 0) zstandard_level(n)=0 + + call ESMF_ConfigGetAttribute(config=CF,value=nbits(n),default=0,label ='nbits:',rc=rc) + ! zlib compression flag call ESMF_ConfigGetAttribute(config=CF,value=ideflate(n),default=0,label ='ideflate:',rc=rc) if (ideflate(n) < 0) ideflate(n)=0 call ESMF_ConfigGetAttribute(config=CF,value=nbits(n),default=0,label ='nbits:',rc=rc) + + if (ideflate(n) > 0 .and. zstandard_level(n) > 0) then + write(0,*)"wrt_initialize_p1: zlib and zstd compression cannot be both enabled at the same time" + call ESMF_LogWrite("wrt_initialize_p1: zlib and zstd compression cannot be both enabled at the same time",ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + if (lprnt) then print *,'ideflate=',ideflate(n),' nbits=',nbits(n) + print *,'zstandard_level=',zstandard_level(n) end if ! nbits quantization level for lossy compression (must be between 1 and 31) ! 1 is most compression, 31 is least. If outside this range, set to zero From 29a9e833b9ee3ebb02523edc002aed47afe8e876 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 2 Nov 2023 07:24:01 -0600 Subject: [PATCH 29/48] FV3 changes for refactored ozone physics scheme (#661) * FV3 changes for refactored ozone physics scheme * Remove change to metadata (Not relevant for PR) * Split ozone physics into time_vary and run components * Renamed file. Update SDFs * Update ccpp-framework hash --- ccpp/config/ccpp_prebuild_config.py | 12 +-- ccpp/data/CCPP_typedefs.F90 | 3 +- ccpp/data/CCPP_typedefs.meta | 2 +- ccpp/data/GFS_typedefs.F90 | 86 ++++++++++++------- ccpp/data/GFS_typedefs.meta | 61 ++++++++++++- ccpp/framework | 2 +- ccpp/physics | 2 +- ...suite_FV3_GFS_v15_thompson_mynn_lam3km.xml | 3 +- ccpp/suites/suite_FV3_GFS_v15p2.xml | 3 +- ccpp/suites/suite_FV3_GFS_v16.xml | 3 +- ccpp/suites/suite_FV3_GFS_v16_csawmg.xml | 3 +- ccpp/suites/suite_FV3_GFS_v16_flake.xml | 3 +- ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml | 3 +- ccpp/suites/suite_FV3_GFS_v16_ras.xml | 3 +- ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml | 3 +- .../suite_FV3_GFS_v17_coupled_p8_c3.xml | 3 +- .../suite_FV3_GFS_v17_coupled_p8_sfcocn.xml | 3 +- .../suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml | 3 +- ccpp/suites/suite_FV3_GFS_v17_p8.xml | 3 +- ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml | 3 +- ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml | 3 +- ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml | 3 +- ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml | 3 +- .../suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml | 3 +- .../suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml | 3 +- ...uite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml | 3 +- ccpp/suites/suite_FV3_HRRR.xml | 3 +- ccpp/suites/suite_FV3_HRRR_c3.xml | 3 +- ccpp/suites/suite_FV3_HRRR_gf.xml | 3 +- ccpp/suites/suite_FV3_RAP.xml | 3 +- ccpp/suites/suite_FV3_RAP_cires_ugwp.xml | 3 +- ccpp/suites/suite_FV3_RAP_clm_lake.xml | 3 +- ccpp/suites/suite_FV3_RAP_flake.xml | 3 +- ccpp/suites/suite_FV3_RAP_noah.xml | 3 +- .../suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml | 3 +- ccpp/suites/suite_FV3_RAP_sfcdiff.xml | 3 +- ccpp/suites/suite_FV3_RAP_unified_ugwp.xml | 3 +- ccpp/suites/suite_FV3_RRFS_v1beta.xml | 3 +- ccpp/suites/suite_FV3_RRFS_v1nssl.xml | 3 +- ccpp/suites/suite_FV3_WoFS_v0.xml | 3 +- 40 files changed, 158 insertions(+), 109 deletions(-) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index c57fd56b2..a96b067ac 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -20,8 +20,8 @@ 'physics/physics/radsw_param.f', 'physics/physics/radlw_param.f', 'physics/physics/h2o_def.f', - 'physics/physics/ozne_def.f', 'physics/physics/radiation_surface.f', + 'physics/physics/module_ozphys.F90', 'data/CCPP_typedefs.F90', 'data/GFS_typedefs.F90', 'data/CCPP_data.F90', @@ -41,6 +41,10 @@ 'module_radlw_parameters' : { 'module_radlw_parameters' : '', }, + 'module_ozphys' : { + 'module_ozphys' : '', + 'ty_ozphys' : '', + }, 'CCPP_typedefs' : { 'GFS_interstitial_type' : 'GFS_Interstitial(cdata%thrd_no)', 'GFDL_interstitial_type' : 'GFDL_interstitial', @@ -105,6 +109,7 @@ 'physics/physics/GFS_surface_loop_control_part1.F90', 'physics/physics/GFS_surface_loop_control_part2.F90', 'physics/physics/GFS_time_vary_pre.fv3.F90', + 'physics/physics/GFS_physics_post.F90', 'physics/physics/cires_ugwp.F90', 'physics/physics/cires_ugwp_post.F90', 'physics/physics/unified_ugwp.F90', @@ -162,11 +167,8 @@ 'physics/physics/mp_thompson_pre.F90', 'physics/physics/mp_thompson.F90', 'physics/physics/mp_thompson_post.F90', - 'physics/physics/mp_nssl.F90' , - 'physics/physics/ozphys.f', - 'physics/physics/ozphys_2015.f', + 'physics/physics/mp_nssl.F90', 'physics/physics/zhaocarr_precpd.f', - 'physics/physics/phys_tend.F90', 'physics/physics/radlw_main.F90', 'physics/physics/radsw_main.F90', 'physics/physics/rascnv.F90', diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index ed27c5e37..63b7f102b 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -8,7 +8,6 @@ module CCPP_typedefs use machine, only: kind_grid, kind_dyn, kind_phys ! Constants/dimensions needed for interstitial DDTs - use ozne_def, only: oz_coeff use GFS_typedefs, only: clear_val, LTP ! Physics type defininitions needed for interstitial DDTs @@ -881,7 +880,7 @@ subroutine gfs_interstitial_create (Interstitial, IM, Model) Interstitial%nf_albd = NF_ALBD Interstitial%nspc1 = NSPC1 if (Model%oz_phys .or. Model%oz_phys_2015) then - Interstitial%oz_coeffp5 = oz_coeff+5 + Interstitial%oz_coeffp5 = Model%oz_coeff+5 else Interstitial%oz_coeffp5 = 5 endif diff --git a/ccpp/data/CCPP_typedefs.meta b/ccpp/data/CCPP_typedefs.meta index 3fd32d7c9..3ecb69be7 100644 --- a/ccpp/data/CCPP_typedefs.meta +++ b/ccpp/data/CCPP_typedefs.meta @@ -3187,7 +3187,7 @@ name = CCPP_typedefs type = module relative_path = ../physics/physics - dependencies = machine.F,ozne_def.f,radlw_param.f,radsw_param.f + dependencies = machine.F,radlw_param.f,radsw_param.f dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_optical_props.F90 dependencies = rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 dependencies = rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_rte_config.F90 diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index bfb6af571..9f4d717f6 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -9,12 +9,12 @@ module GFS_typedefs con_csol, con_epsqs, con_rocp, con_rog, & con_omega, con_rerth, con_psat, karman, rainmin,& con_c, con_plnk, con_boltz, con_solr_2008, & - con_solr_2002, con_thgni + con_solr_2002, con_thgni, con_1ovg use module_radsw_parameters, only: topfsw_type, sfcfsw_type use module_radlw_parameters, only: topflw_type, sfcflw_type - use ozne_def, only: levozp, oz_coeff use h2o_def, only: levh2o, h2o_coeff + use module_ozphys, only: ty_ozphys implicit none @@ -1113,8 +1113,6 @@ module GFS_typedefs logical :: shocaftcnv !< flag for SHOC logical :: shoc_cld !< flag for clouds logical :: uni_cld !< flag for clouds in grrad - logical :: oz_phys !< flag for old (2006) ozone physics - logical :: oz_phys_2015 !< flag for new (2015) ozone physics logical :: h2o_phys !< flag for stratosphere h2o logical :: pdfcld !< flag for pdfcld logical :: shcnvcw !< flag for shallow convective cloud @@ -1567,6 +1565,13 @@ module GFS_typedefs !--- lightning threat and diagsnostics logical :: lightning_threat !< report lightning threat indices +!--- NRL Ozone physics + logical :: oz_phys !< Flag for old (2006) ozone physics + logical :: oz_phys_2015 !< Flag for new (2015) ozone physics + type(ty_ozphys) :: ozphys !< DDT with data needed by ozone physics + integer :: levozp !< Number of vertical layers in ozone forcing data + integer :: oz_coeff !< Number of coefficients in ozone forcing data + contains procedure :: init => control_initialize procedure :: init_chemistry => control_chemistry_initialize @@ -1790,7 +1795,7 @@ module GFS_typedefs !--- In/Out (???) (physics only) real (kind=kind_phys), pointer :: swhc (:,:) => null() !< clear sky sw heating rates ( k/s ) real (kind=kind_phys), pointer :: lwhc (:,:) => null() !< clear sky lw heating rates ( k/s ) - real (kind=kind_phys), pointer :: lwhd (:,:,:) => null() !< idea sky lw heating rates ( k/s ) + real (kind=kind_phys), pointer :: lwhd (:,:,:) => null() !< idea sky lw heating rates ( k/s ) !DJS2023 THIS IS NOT USED. IT IS REFERENCED, BUT NEVER SET? contains procedure :: create => radtend_create !< allocate array data @@ -2098,6 +2103,12 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ltg2_max(:) => null() ! real (kind=kind_phys), pointer :: ltg3_max(:) => null() ! + !--- NRL Ozone physics diagnostics + real (kind=kind_phys), pointer :: do3_dt_prd(:,:) => null() + real (kind=kind_phys), pointer :: do3_dt_ozmx(:,:) => null() + real (kind=kind_phys), pointer :: do3_dt_temp(:,:) => null() + real (kind=kind_phys), pointer :: do3_dt_ohoz(:,:) => null() + contains procedure :: create => diag_create procedure :: rad_zero => diag_rad_zero @@ -3549,8 +3560,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: do_shoc = .false. !< flag for SHOC logical :: shocaftcnv = .false. !< flag for SHOC logical :: shoc_cld = .false. !< flag for SHOC in grrad - logical :: oz_phys = .true. !< flag for old (2006) ozone physics - logical :: oz_phys_2015 = .false. !< flag for new (2015) ozone physics logical :: h2o_phys = .false. !< flag for stratosphere h2o logical :: pdfcld = .false. !< flag for pdfcld logical :: shcnvcw = .false. !< flag for shallow convective cloud @@ -3833,6 +3842,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !-- Lightning threat index logical :: lightning_threat = .false. +!--- NRL Ozone physics + logical :: oz_phys = .false. !< Flag for old (2006) ozone physics + logical :: oz_phys_2015 = .true. !< Flag for new (2015) ozone physics + integer :: kozpl = 28 !< File identifier for ozone forcing data + integer :: kozc = 48 !< File identifier for ozone climotology data + !--- aerosol scavenging factors integer, parameter :: max_scav_factors = 183 character(len=40) :: fscav_aero(max_scav_factors) @@ -4007,6 +4022,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & character(len=20) :: namestr character(len=44) :: descstr +!--- NRL ozone physics + character(len=128) :: err_message + ! dtend selection: default is to match all variables: dtend_select(1)='*' do ipat=2,pat_count @@ -5391,29 +5409,23 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ENDIF !} - ! To ensure that these values match what's in the physics, - ! array sizes are compared during model init in GFS_phys_time_vary_init() - ! - ! from module ozinterp - if (Model%ntoz>0) then - if (Model%oz_phys) then - levozp = 80 - oz_coeff = 4 - else if (Model%oz_phys_2015) then - levozp = 53 - oz_coeff = 6 - else - write(*,*) 'Logic error, ntoz>0 but no ozone physics selected' - stop - end if + !--- NRL ozone physics + if (Model%ntoz > 0) then + ! Load data for ozone physics into DDT ozphys + err_message = Model%ozphys%load_o3prog('global_o3prdlos.f77',kozpl) + Model%levozp = Model%ozphys%nlev + Model%oz_coeff = Model%ozphys%ncf + + if (Model%me == Model%master) then + write(*,*) 'Reading in o3data from global_o3prdlos.f77 ' + write(*,*) ' oz_coeff = ', Model%ozphys%ncf + write(*,*) ' latsozp = ', Model%ozphys%nlat + write(*,*) ' levozp = ', Model%ozphys%nlev + write(*,*) ' timeoz = ', Model%ozphys%ntime + endif else - if (Model%oz_phys .or. Model%oz_phys_2015) then - write(*,*) 'Logic error, ozone physics are selected, but ntoz<=0' - stop - else - levozp = 1 - oz_coeff = 1 - end if + !--- Climatological ozone + err_message = Model%ozphys%load_o3clim('global_o3prdlos.f77',kozc) end if !--- quantities to be used to derive phy_f*d totals @@ -6941,10 +6953,10 @@ subroutine tbd_create (Tbd, IM, Model) endif !--- ozone and stratosphere h2o needs - allocate (Tbd%ozpl (IM,levozp,oz_coeff)) + allocate (Tbd%ozpl (IM,Model%levozp,Model%oz_coeff)) allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - Tbd%ozpl = clear_val Tbd%h2opl = clear_val + Tbd%ozpl = clear_val !--- ccn and in needs ! DH* allocate only for MG? *DH @@ -7559,6 +7571,12 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%dwn_mf (IM,Model%levs)) allocate (Diag%det_mf (IM,Model%levs)) endif + if (Model%oz_phys_2015) then + allocate(Diag%do3_dt_prd( IM, Model%levs)) + allocate(Diag%do3_dt_ozmx(IM, Model%levs)) + allocate(Diag%do3_dt_temp(IM, Model%levs)) + allocate(Diag%do3_dt_ohoz(IM, Model%levs)) + endif endif ! UGWP @@ -7897,6 +7915,12 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%dwn_mf = zero Diag%det_mf = zero endif + if (Model%oz_phys_2015) then + Diag%do3_dt_prd = zero + Diag%do3_dt_ozmx = zero + Diag%do3_dt_temp = zero + Diag%do3_dt_ohoz = zero + endif endif ! diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 4f3a757b8..e31731735 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -5053,6 +5053,12 @@ units = flag dimensions = () type = logical +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -6651,6 +6657,18 @@ units = flag dimensions = () type = logical +[levozp] + standard_name = vertical_dimension_of_ozone_forcing_data + long_name = number of vertical layers in ozone forcing data + units = count + dimensions = () + type = integer +[oz_coeff] + standard_name = number_of_coefficients_in_ozone_data + long_name = number of coefficients in ozone forcing data + units = count + dimensions = () + type = integer [ipt] standard_name = index_of_horizontal_gridpoint_for_debug_output long_name = horizontal index for point used for diagnostic printout @@ -7410,7 +7428,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) type = real kind = kind_phys [h2opl] @@ -8856,6 +8874,38 @@ type = real kind = kind_phys active = (flag_for_tracer_diagnostics_3D) +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_tracer_diagnostics_3D .and. flag_for_nrl_2015_ozone_scheme) +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_tracer_diagnostics_3D .and. flag_for_nrl_2015_ozone_scheme) +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_tracer_diagnostics_3D .and. flag_for_nrl_2015_ozone_scheme) +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (flag_for_tracer_diagnostics_3D .and. flag_for_nrl_2015_ozone_scheme) [refl_10cm] standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm @@ -9616,7 +9666,7 @@ type = module relative_path = ../physics/physics dependencies = machine.F,physcons.F90,radlw_param.f,radsw_param.f - dependencies = GFDL_parse_tracers.F90,h2o_def.f,ozne_def.f + dependencies = GFDL_parse_tracers.F90,h2o_def.f,module_ozphys.F90 [ccpp-arg-table] name = GFS_typedefs @@ -9784,6 +9834,13 @@ dimensions = () type = real kind = kind_phys +[con_1ovg] + standard_name = one_divided_by_the_gravitational_acceleration + long_name = inverse of gravitational acceleration + units = s2 m-1 + dimensions = () + type = real + kind = kind_phys [con_hvap] standard_name = latent_heat_of_vaporization_of_water_at_0C long_name = latent heat of evaporation/sublimation diff --git a/ccpp/framework b/ccpp/framework index 1b6352fb2..219f2e9c8 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 1b6352fb24f053b738bde72eed0ddf0b60ec7c0f +Subproject commit 219f2e9c88b7b774becac2bd1453696e105af1c4 diff --git a/ccpp/physics b/ccpp/physics index 1db569112..3855dccfe 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1db569112ed60a0074028fccf7e09d3b47ce9f92 +Subproject commit 3855dccfe68750b7681adc32de2c6cf2abe689d9 diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml index 3bca27630..7886743e3 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml @@ -60,7 +60,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -71,7 +70,7 @@ mp_thompson_post GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v15p2.xml b/ccpp/suites/suite_FV3_GFS_v15p2.xml index e87305c66..7b2eaac1b 100644 --- a/ccpp/suites/suite_FV3_GFS_v15p2.xml +++ b/ccpp/suites/suite_FV3_GFS_v15p2.xml @@ -66,7 +66,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -82,7 +81,7 @@ gfdl_cloud_microphys GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v16.xml b/ccpp/suites/suite_FV3_GFS_v16.xml index 122b937e1..e6ae5483f 100644 --- a/ccpp/suites/suite_FV3_GFS_v16.xml +++ b/ccpp/suites/suite_FV3_GFS_v16.xml @@ -66,7 +66,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -82,7 +81,7 @@ gfdl_cloud_microphys GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml b/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml index 8c32e3d76..3c41ef08d 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml @@ -61,7 +61,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -82,7 +81,7 @@ cs_conv_aw_adj GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_flake.xml b/ccpp/suites/suite_FV3_GFS_v16_flake.xml index 12c48225f..a99756c30 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_flake.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_flake.xml @@ -67,7 +67,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -83,7 +82,7 @@ gfdl_cloud_microphys GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml b/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml index d8cafbbd0..e540edc52 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml @@ -59,7 +59,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -80,7 +79,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_ras.xml b/ccpp/suites/suite_FV3_GFS_v16_ras.xml index be4aa4a13..31e1d29f3 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_ras.xml @@ -66,7 +66,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -82,7 +81,7 @@ gfdl_cloud_microphys GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml index 4a2cb64fc..00675097a 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml @@ -62,7 +62,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -89,7 +88,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml index f0a8d7d92..7daa7495a 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml @@ -62,7 +62,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -90,7 +89,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml index b68abf3f2..b137ed9a8 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml @@ -60,7 +60,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -87,7 +86,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml index e9cdb1c40..5b316a735 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml @@ -62,7 +62,6 @@ ugwpv1_gsldrag_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -89,7 +88,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8.xml b/ccpp/suites/suite_FV3_GFS_v17_p8.xml index c4b295a6d..37ce4d90c 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8.xml @@ -61,7 +61,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -88,7 +87,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml index d93060d5a..dd79992ce 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml @@ -63,7 +63,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -91,7 +90,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml index f77c71cc5..a5b2b3291 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml @@ -64,7 +64,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -91,7 +90,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml index 3b3acef6d..57aa71179 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_rrtmgp.xml @@ -61,7 +61,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -88,7 +87,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml index fef14b176..0d001fc45 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml @@ -61,7 +61,6 @@ ugwpv1_gsldrag_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -88,7 +87,7 @@ GFS_stochastics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml index 3dc3c8d54..e6673d7a6 100644 --- a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml +++ b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml @@ -66,7 +66,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -82,7 +81,7 @@ gfdl_cloud_microphys GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml index 254df77e0..de25bd871 100644 --- a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml +++ b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml @@ -64,7 +64,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -80,7 +79,7 @@ gfdl_cloud_microphys GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml b/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml index a5db1110b..7231ed9ac 100644 --- a/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml +++ b/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml @@ -61,7 +61,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -79,7 +78,7 @@ mp_thompson_post GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_HRRR.xml b/ccpp/suites/suite_FV3_HRRR.xml index 6ac35db14..56360ab5d 100644 --- a/ccpp/suites/suite_FV3_HRRR.xml +++ b/ccpp/suites/suite_FV3_HRRR.xml @@ -59,7 +59,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -70,7 +69,7 @@ mp_thompson_post GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_HRRR_c3.xml b/ccpp/suites/suite_FV3_HRRR_c3.xml index fe4feedc7..95a426de8 100644 --- a/ccpp/suites/suite_FV3_HRRR_c3.xml +++ b/ccpp/suites/suite_FV3_HRRR_c3.xml @@ -59,7 +59,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -76,7 +75,7 @@ GFS_MP_generic_post cu_c3_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_HRRR_gf.xml b/ccpp/suites/suite_FV3_HRRR_gf.xml index 7e594e621..8694976ac 100644 --- a/ccpp/suites/suite_FV3_HRRR_gf.xml +++ b/ccpp/suites/suite_FV3_HRRR_gf.xml @@ -59,7 +59,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -76,7 +75,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP.xml b/ccpp/suites/suite_FV3_RAP.xml index f03c1a1e8..a24476213 100644 --- a/ccpp/suites/suite_FV3_RAP.xml +++ b/ccpp/suites/suite_FV3_RAP.xml @@ -59,7 +59,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -78,7 +77,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml b/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml index 3530d16ef..6f16d0ea4 100644 --- a/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml @@ -60,7 +60,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -79,7 +78,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP_clm_lake.xml b/ccpp/suites/suite_FV3_RAP_clm_lake.xml index 9a28a6421..2bc178eae 100644 --- a/ccpp/suites/suite_FV3_RAP_clm_lake.xml +++ b/ccpp/suites/suite_FV3_RAP_clm_lake.xml @@ -60,7 +60,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -79,7 +78,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP_flake.xml b/ccpp/suites/suite_FV3_RAP_flake.xml index be66bbaa0..c60c4324b 100644 --- a/ccpp/suites/suite_FV3_RAP_flake.xml +++ b/ccpp/suites/suite_FV3_RAP_flake.xml @@ -60,7 +60,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -79,7 +78,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP_noah.xml b/ccpp/suites/suite_FV3_RAP_noah.xml index f5ce01c87..6fd994f3c 100644 --- a/ccpp/suites/suite_FV3_RAP_noah.xml +++ b/ccpp/suites/suite_FV3_RAP_noah.xml @@ -60,7 +60,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -79,7 +78,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml index b0bf553bb..a07dd850b 100644 --- a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml @@ -61,7 +61,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -80,7 +79,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP_sfcdiff.xml b/ccpp/suites/suite_FV3_RAP_sfcdiff.xml index 0793433c6..8a960e02e 100644 --- a/ccpp/suites/suite_FV3_RAP_sfcdiff.xml +++ b/ccpp/suites/suite_FV3_RAP_sfcdiff.xml @@ -59,7 +59,6 @@ drag_suite GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -78,7 +77,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml b/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml index 0b04d9622..efca314bb 100644 --- a/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml @@ -60,7 +60,6 @@ unified_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -79,7 +78,7 @@ GFS_MP_generic_post cu_gf_driver_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RRFS_v1beta.xml b/ccpp/suites/suite_FV3_RRFS_v1beta.xml index 97228c0a6..42ee00565 100644 --- a/ccpp/suites/suite_FV3_RRFS_v1beta.xml +++ b/ccpp/suites/suite_FV3_RRFS_v1beta.xml @@ -61,7 +61,6 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_suite_interstitial_3 @@ -72,7 +71,7 @@ mp_thompson_post GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_RRFS_v1nssl.xml b/ccpp/suites/suite_FV3_RRFS_v1nssl.xml index d2a2ae911..05b1edb79 100644 --- a/ccpp/suites/suite_FV3_RRFS_v1nssl.xml +++ b/ccpp/suites/suite_FV3_RRFS_v1nssl.xml @@ -61,14 +61,13 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_MP_generic_pre mp_nssl GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post diff --git a/ccpp/suites/suite_FV3_WoFS_v0.xml b/ccpp/suites/suite_FV3_WoFS_v0.xml index 1a34ba1a1..5641af472 100644 --- a/ccpp/suites/suite_FV3_WoFS_v0.xml +++ b/ccpp/suites/suite_FV3_WoFS_v0.xml @@ -61,14 +61,13 @@ cires_ugwp_post GFS_GWD_generic_post GFS_suite_stateout_update - ozphys_2015 h2ophys get_phi_fv3 GFS_MP_generic_pre mp_nssl GFS_MP_generic_post maximum_hourly_diagnostics - phys_tend + GFS_physics_post From 0dbc9ed837c3b179f545696ef93ac950e1f816ea Mon Sep 17 00:00:00 2001 From: Ted Mansell <37668594+MicroTed@users.noreply.github.com> Date: Mon, 6 Nov 2023 10:29:13 -0600 Subject: [PATCH 30/48] Support new NSSL cloud microphysics 3-moment option (#702) * Updates to support NSSL microphysics in CCPP * Switched atmos and ccpp modules to NSSL versions * Made setting of otsptflag more logical * change dimensions of flag_convective_tracer_transport_interstitial to match allocation/use * Add flags and code for 3-moment rain/graupel/hail in NSSL microphysics scheme * Update otsptflag for 3moment variables --- ccpp/data/CCPP_typedefs.F90 | 11 +++--- ccpp/data/GFS_typedefs.F90 | 42 +++++++++++++++++++--- ccpp/data/GFS_typedefs.meta | 72 +++++++++++++++++++++++++++++++++++++ ccpp/physics | 2 +- 4 files changed, 117 insertions(+), 10 deletions(-) diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index 63b7f102b..a7da2eca9 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -1057,11 +1057,12 @@ subroutine gfs_interstitial_setup_tracers(Interstitial, Model) tracers = 2 do n=2,Model%ntrac ltest = ( n /= Model%ntcw .and. n /= Model%ntiw .and. n /= Model%ntclamt .and. & - n /= Model%ntrw .and. n /= Model%ntsw .and. n /= Model%ntrnc .and. & - n /= Model%ntsnc .and. n /= Model%ntgl .and. n /= Model%ntgnc .and. & - n /= Model%nthl .and. n /= Model%nthnc .and. n /= Model%ntgv .and. & - n /= Model%nthv .and. n /= Model%ntccn .and. n /= Model%ntccna .and. & - n /= Model%ntsigma) + n /= Model%ntrw .and. n /= Model%ntsw .and. n /= Model%ntrnc .and. & + n /= Model%ntsnc .and. n /= Model%ntgl .and. n /= Model%ntgnc .and. & + n /= Model%nthl .and. n /= Model%nthnc .and. n /= Model%ntgv .and. & + n /= Model%nthv .and. n /= Model%ntccn .and. n /= Model%ntccna .and. & + n /= Model%ntrz .and. n /= Model%ntgz .and. n /= Model%nthz .and. & + n /= Model%ntsigma) Interstitial%otsptflag(n) = ltest if ( ltest ) then tracers = tracers + 1 diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 9f4d717f6..dd9505128 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -971,6 +971,7 @@ module GFS_typedefs logical :: nssl_hail_on !< NSSL flag to activate the hail category logical :: nssl_ccn_on !< NSSL flag to activate the CCN category logical :: nssl_invertccn !< NSSL flag to treat CCN as activated (true) or unactivated (false) + logical :: nssl_3moment !< NSSL flag to turn on 3-moment for rain/graupel/hail !--- Thompson's microphysical parameters logical :: ltaerosol !< flag for aerosol version @@ -1426,6 +1427,9 @@ module GFS_typedefs integer :: ntccna !< tracer index for activated CCN integer :: ntgv !< tracer index for graupel particle volume integer :: nthv !< tracer index for hail particle volume + integer :: ntrz !< tracer index for rain reflectivity + integer :: ntgz !< tracer index for graupel reflectivity + integer :: nthz !< tracer index for hail reflectivity integer :: ntke !< tracer index for kinetic energy integer :: ntsigma !< tracer index for updraft area fraction integer :: nto !< tracer index for oxygen ion @@ -3428,6 +3432,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: nssl_hail_on = .false. !< NSSL flag to activate the hail category logical :: nssl_ccn_on = .true. !< NSSL flag to activate the CCN category logical :: nssl_invertccn = .true. !< NSSL flag to treat CCN as activated (true) or unactivated (false) + logical :: nssl_3moment = .false. !< NSSL flag to turn on 3-moment for rain/graupel/hail !--- Thompson microphysical parameters logical :: ltaerosol = .false. !< flag for aerosol version @@ -3850,7 +3855,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- aerosol scavenging factors integer, parameter :: max_scav_factors = 183 - character(len=40) :: fscav_aero(max_scav_factors) + character(len=40) :: fscav_aero(max_scav_factors) = '' real(kind=kind_phys) :: radar_tten_limits(2) = (/ limit_unspecified, limit_unspecified /) integer :: itime @@ -3902,8 +3907,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ext_diag_thompson, dt_inner, lgfdlmprad, & sedi_semi, decfl, & nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_alphar, nssl_ehw0, nssl_ehlw0, & - nssl_invertccn, nssl_hail_on, nssl_ccn_on, & + nssl_alphar, nssl_ehw0, nssl_ehlw0, & + nssl_invertccn, nssl_hail_on, nssl_ccn_on, nssl_3moment, & !--- max hourly avg_max_length, & !--- land/surface model control @@ -4512,6 +4517,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nssl_hail_on = nssl_hail_on Model%nssl_ccn_on = nssl_ccn_on Model%nssl_invertccn = nssl_invertccn + Model%nssl_3moment = nssl_3moment !--- Thompson MP parameters Model%ltaerosol = ltaerosol @@ -5013,6 +5019,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ntccna = get_tracer_index(Model%tracer_names, 'ccna_nc', Model%me, Model%master, Model%debug) Model%ntgv = get_tracer_index(Model%tracer_names, 'graupel_vol',Model%me, Model%master, Model%debug) Model%nthv = get_tracer_index(Model%tracer_names, 'hail_vol', Model%me, Model%master, Model%debug) + Model%ntrz = get_tracer_index(Model%tracer_names, 'rain_ref', Model%me, Model%master, Model%debug) + Model%ntgz = get_tracer_index(Model%tracer_names, 'graupel_ref',Model%me, Model%master, Model%debug) + Model%nthz = get_tracer_index(Model%tracer_names, 'hail_ref', Model%me, Model%master, Model%debug) Model%ntke = get_tracer_index(Model%tracer_names, 'sgs_tke', Model%me, Model%master, Model%debug) Model%ntsigma = get_tracer_index(Model%tracer_names, 'sigmab', Model%me, Model%master, Model%debug) Model%nqrimef = get_tracer_index(Model%tracer_names, 'q_rimef', Model%me, Model%master, Model%debug) @@ -5194,6 +5203,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & call label_dtend_tracer(Model,100+Model%ntccn,'ccn_nc','CCN number concentration','kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntgv,'graupel_vol','graupel volume','m3 kg-1 s-1') call label_dtend_tracer(Model,100+Model%nthv,'hail_vol','hail volume','m3 kg-1 s-1') + call label_dtend_tracer(Model,100+Model%ntrz,'rain_ref','rain reflectivity','m3 kg-1 s-1') + call label_dtend_tracer(Model,100+Model%ntgz,'graupel_ref','graupel reflectivity','m3 kg-1 s-1') + call label_dtend_tracer(Model,100+Model%nthz,'hail_ref','hail reflectivity','m3 kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntke,'sgs_tke','turbulent kinetic energy','J s-1') call label_dtend_tracer(Model,100+Model%nqrimef,'q_rimef','mass weighted rime factor','kg-1 s-1') call label_dtend_tracer(Model,100+Model%ntwa,'liq_aero','number concentration of water-friendly aerosols','kg-1 s-1') @@ -5262,7 +5274,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & itrac /= Model%ntrw .and. itrac /= Model%ntsw .and. itrac /= Model%ntrnc .and. & itrac /= Model%ntsnc .and. itrac /= Model%ntgl .and. itrac /= Model%ntgnc .and. & itrac /= Model%nthl .and. itrac /= Model%nthnc .and. itrac /= Model%nthv .and. & - itrac /= Model%ntgv ) then + itrac /= Model%ntgv .and. itrac /= Model%ntrz .and. itrac /= Model%ntgz .and. & + itrac /= Model%nthz ) then call fill_dtidx(Model,dtend_select,100+itrac,Model%index_of_process_scnv,have_scnv) call fill_dtidx(Model,dtend_select,100+itrac,Model%index_of_process_dcnv,have_dcnv) else if(Model%ntchs<=0 .or. itrac 0) +[qgrs(:,:,index_of_reflectivity_of_rain_in_tracer_concentration_array)] + standard_name = reflectivity_of_rain_in_air + long_name = reflectivity of rain + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_reflectivity_of_rain_in_tracer_concentration_array > 0) +[qgrs(:,:,index_of_reflectivity_of_graupel_in_tracer_concentration_array)] + standard_name = reflectivity_of_graupel_in_air + long_name = reflectivity of graupel + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_reflectivity_of_graupel_in_tracer_concentration_array > 0) +[qgrs(:,:,index_of_reflectivity_of_hail_in_tracer_concentration_array)] + standard_name = reflectivity_of_hail_in_air + long_name = reflectivity of hail + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = (index_of_reflectivity_of_hail_in_tracer_concentration_array > 0) [qgrs(:,:,index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array)] standard_name = cloud_condensation_nuclei_number_concentration long_name = number concentration of cloud condensation nuclei @@ -568,6 +592,30 @@ type = real kind = kind_phys active = ( index_of_hail_volume_in_tracer_concentration_array > 0 ) +[gq0(:,:,index_of_reflectivity_of_rain_in_tracer_concentration_array)] + standard_name = reflectivity_of_rain_of_new_state + long_name = reflectivity of rain updated by physics + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_reflectivity_of_rain_in_tracer_concentration_array > 0 ) +[gq0(:,:,index_of_reflectivity_of_graupel_in_tracer_concentration_array)] + standard_name = reflectivity_of_graupel_of_new_state + long_name = reflectivity of graupel updated by physics + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_reflectivity_of_graupel_in_tracer_concentration_array > 0 ) +[gq0(:,:,index_of_reflectivity_of_hail_in_tracer_concentration_array)] + standard_name = reflectivity_of_hail_of_new_state + long_name = reflectivity of hail updated by physics + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + active = ( index_of_reflectivity_of_hail_in_tracer_concentration_array > 0 ) [gq0(:,:,index_of_cloud_area_fraction_in_atmosphere_layer_in_tracer_concentration_array)] standard_name = cloud_area_fraction_in_atmosphere_layer_of_new_state long_name = cloud fraction updated by physics @@ -4312,6 +4360,12 @@ units = flag dimensions = () type = logical +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical [tf] standard_name = all_ice_cloud_threshold_temperature long_name = threshold temperature below which all cloud is ice @@ -6137,6 +6191,24 @@ units = index dimensions = () type = integer +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer [ntke] standard_name = index_of_turbulent_kinetic_energy_in_tracer_concentration_array long_name = tracer index for turbulent kinetic energy diff --git a/ccpp/physics b/ccpp/physics index 3855dccfe..c751a5a6e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3855dccfe68750b7681adc32de2c6cf2abe689d9 +Subproject commit c751a5a6e1a5ae1f3f79e667a86e8dee0e62879f From 36500b6084014eb862176c810914206d2ddf2170 Mon Sep 17 00:00:00 2001 From: XiaqiongZhou-NOAA <48254930+XiaqiongZhou-NOAA@users.noreply.github.com> Date: Thu, 9 Nov 2023 10:55:24 -0500 Subject: [PATCH 31/48] Add a condition to turn off samfdeepcnv when MYNN shallow convection active (#714) * Add a condition to turn off samfdeepcnv when MYNN shallow convection active --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index c751a5a6e..c2ec9e5e1 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c751a5a6e1a5ae1f3f79e667a86e8dee0e62879f +Subproject commit c2ec9e5e165dac07a991424bd22bb0667cf32017 From bdee71e04223bb2c397597fe088cff2d40fa49b1 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Mon, 13 Nov 2023 19:37:43 -0500 Subject: [PATCH 32/48] Set default value of 'quilting_restart' to true (#713) * Set quilting_restart default to .true. * Update upp revision to 7fbc413 and read new varaible in inline post interface. --------- Co-authored-by: Wen Meng --- fv3_cap.F90 | 2 +- io/post_fv3.F90 | 13 ++++++++++++- upp | 2 +- 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index efd84211f..ada73a861 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -288,7 +288,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_ConfigGetAttribute(config=CF,value=quilting_restart, & - default=.false., label ='quilting_restart:',rc=rc) + default=.true., label ='quilting_restart:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (.not.quilting) quilting_restart = .false. diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 2026b67d9..97962bdd9 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -551,7 +551,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) dustpm10, dustcb, bccb, occb, sulfcb, sscb, & dustallcb, ssallcb, dustpm, sspm, pp25cb, pp10cb, & no3cb, nh4cb, dusmass, ducmass, dusmass25,ducmass25, & - snownc, graupelnc, qrmax + snownc, graupelnc, qrmax, hail_maxhailcast use soil, only: sldpth, sh2o, smc, stc, sllevel use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & @@ -995,6 +995,17 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif + ! Maximum hail diameter (mm) since last output + if(trim(fieldname)=='hailcast_dhail') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,hail_maxhailcast,arrayr42d,fillValue,spval) + do j=jsta,jend + do i=ista, iend + hail_maxhailcast(i,j)=arrayr42d(i,j) + if(abs(arrayr42d(i,j)-fillValue) < small) hail_maxhailcast(i,j)=spval + enddo + enddo + endif + ! biomass burning emissions if(trim(fieldname)=='ebb_smoke_hr') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ebb,arrayr42d,fillValue,spval) diff --git a/upp b/upp index fae617ba4..78f369b01 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit fae617ba485dbbadc8fc10f512a6a0c29c81741a +Subproject commit 78f369b011ec41dca87a1260298d0228f2c4f38f From 9ba5c5dd0e013a77ca7e4d6c6ffacf380d96abe1 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Wed, 15 Nov 2023 15:23:42 -0500 Subject: [PATCH 33/48] new global_nest_v1 suite and #715 (#709) * new global_nest_v1 suite * switch to ugwpv1 in global_nest_v1 suite * update suite_FV3_global_nest_v1.xml for scheme rename/rearrangement * point to lisa/C3_updates --------- Co-authored-by: Lisa Bengtsson --- ccpp/data/GFS_typedefs.F90 | 21 +++++- ccpp/data/GFS_typedefs.meta | 21 ++++++ ccpp/physics | 2 +- ccpp/suites/suite_FV3_global_nest_v1.xml | 95 ++++++++++++++++++++++++ 4 files changed, 135 insertions(+), 4 deletions(-) create mode 100644 ccpp/suites/suite_FV3_global_nest_v1.xml diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index dd9505128..3289d24bd 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1192,6 +1192,9 @@ module GFS_typedefs integer :: seed0 !< random seed for radiation real(kind=kind_phys) :: rbcr !< Critical Richardson Number in the PBL scheme + real(kind=kind_phys) :: betascu !< Tuning parameter for prog. closure shallow clouds + real(kind=kind_phys) :: betamcu !< Tuning parameter for prog. closure midlevel clouds + real(kind=kind_phys) :: betadcu !< Tuning parameter for prog. closure deep clouds !--- MYNN parameters/switches logical :: do_mynnedmf @@ -3072,7 +3075,6 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%psurfi_cpl = clear_val endif - !--prognostic closure - moisture coupling if(Model%progsigma)then allocate(Coupling%dqdt_qmicro (IM,Model%levs)) Coupling%dqdt_qmicro = clear_val @@ -3627,6 +3629,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: var_ric = 1.0 real(kind=kind_phys) :: coef_ric_l = 0.16 real(kind=kind_phys) :: coef_ric_s = 0.25 + !Prognostic convective closure + real(kind=kind_phys) :: betascu = 8.0 !< Tuning parameter for prog. closure shallow clouds + real(kind=kind_phys) :: betamcu = 1.0 !< Tuning parameter for prog. closure midlevel clouds + real(kind=kind_phys) :: betadcu = 2.0 !< Tuning parameter for prog. closure deep clouds ! *DH logical :: do_myjsfc = .false. !< flag for MYJ surface layer scheme logical :: do_myjpbl = .false. !< flag for MYJ PBL scheme @@ -3945,8 +3951,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & do_ugwp_v1, do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, & ugwp_seq_update, var_ric, coef_ric_l, coef_ric_s, hurr_pbl, & do_myjsfc, do_myjpbl, & - hwrf_samfdeep, hwrf_samfshal,progsigma, & - h2o_phys, pdfcld, shcnvcw, redrag, hybedmf, satmedmf, & + hwrf_samfdeep, hwrf_samfshal,progsigma,betascu,betamcu, & + betadcu,h2o_phys, pdfcld, shcnvcw, redrag, hybedmf, satmedmf,& shinhong, do_ysu, dspheat, lheatstrg, lseaspray, cnvcld, & random_clds, shal_cnv, imfshalcnv, imfdeepcnv, isatmedmf, & do_deep, jcap, & @@ -4726,11 +4732,15 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%hwrf_samfdeep = hwrf_samfdeep Model%hwrf_samfshal = hwrf_samfshal + !--prognostic closure - moisture coupling if ((progsigma .and. imfdeepcnv/=2) .and. (progsigma .and. imfdeepcnv/=5)) then write(*,*) 'Logic error: progsigma requires imfdeepcnv=2 or 5' stop end if Model%progsigma = progsigma + Model%betascu = betascu + Model%betamcu = betamcu + Model%betadcu = betadcu if (oz_phys .and. oz_phys_2015) then write(*,*) 'Logic error: can only use one ozone physics option (oz_phys or oz_phys_2015), not both. Exiting.' @@ -6732,6 +6742,11 @@ subroutine control_print(Model) print *, ' do_spp : ', Model%do_spp print *, ' n_var_spp : ', Model%n_var_spp print *, ' ' + print *, 'convection' + print *, 'betascu : ', Model%betascu + print *, 'betamcu : ', Model%betamcu + print *, 'betadcu : ', Model%betadcu + print *, ' ' print *, 'cellular automata' print *, ' nca : ', Model%nca print *, ' ncells : ', Model%ncells diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index d1c05af58..d028a5834 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -5299,6 +5299,27 @@ units = flag dimensions = () type = logical +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys [isatmedmf] standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL long_name = choice of scale-aware TKE moist EDMF PBL scheme diff --git a/ccpp/physics b/ccpp/physics index c2ec9e5e1..2b7bb29fd 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c2ec9e5e165dac07a991424bd22bb0667cf32017 +Subproject commit 2b7bb29fda845a558e6ea8000e948a4a6e0ae0d6 diff --git a/ccpp/suites/suite_FV3_global_nest_v1.xml b/ccpp/suites/suite_FV3_global_nest_v1.xml new file mode 100644 index 000000000..5a8dbd3e0 --- /dev/null +++ b/ccpp/suites/suite_FV3_global_nest_v1.xml @@ -0,0 +1,95 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_c3_driver_pre + cu_c3_driver + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + + + mp_thompson + + + mp_thompson_post + GFS_MP_generic_post + cu_c3_driver_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + GFS_physics_post + + + + From 34675c222f1140e732cc709de6c16bed0a6df9f0 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 17 Nov 2023 07:19:21 -0700 Subject: [PATCH 34/48] MYNN-EDMF, MYNN surface layer, and Thompson AA updates (#712) * In GFS_diagnostics make LAI, WILT and FLDCP be outputted with all LSMs. Also, output of LAI should not depend on RDLAI. * In GFS_typedefs.* add surface heat flux from the fire for use in RUC LSM. * Fix hail size output diagnostic array size (#1) * Added one more variable - frac_grid_burned_out - to GFS_typedefs.F90. Also, the surface heat flux from fires and frac_grid_burned_out are added to the model output in GFS_diagnostics.F90. --------- Co-authored-by: tanyasmirnova Co-authored-by: Anders Jensen --- ccpp/data/GFS_typedefs.F90 | 41 ++++++++--- ccpp/data/GFS_typedefs.meta | 50 +++++++++++-- ccpp/driver/GFS_diagnostics.F90 | 120 ++++++++++++++++++++------------ ccpp/physics | 2 +- 4 files changed, 152 insertions(+), 61 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 3289d24bd..17d6ee4a0 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -464,6 +464,9 @@ module GFS_typedefs !--- For fire diurnal cycle real (kind=kind_phys), pointer :: fhist (:) => null() !< instantaneous fire coef_bb real (kind=kind_phys), pointer :: coef_bb_dc (:) => null() !< instantaneous fire coef_bb + !--- wildfire heat flux + real (kind=kind_phys), pointer :: fire_heat_flux_out (:) => null() !< heat flux from wildfire + real (kind=kind_phys), pointer :: frac_grid_burned_out (:) => null() !< fraction of grid cell burning !--- For smoke and dust auxiliary inputs real (kind=kind_phys), pointer :: fire_in (:,:) => null() !< fire auxiliary inputs @@ -1050,6 +1053,9 @@ module GFS_typedefs integer :: isncond_opt=1 !< control for soil thermal conductivity option in RUC land surface model integer :: isncovr_opt=1 !< control for snow cover fraction option in RUC land surface model + ! -- Fire heat flux + logical :: add_fire_heat_flux=.false. ! null() ! real (kind=kind_phys), pointer :: det_sqv (:,:) => null() ! real (kind=kind_phys), pointer :: maxMF (:) => null() ! - integer, pointer :: nupdraft (:) => null() ! + real (kind=kind_phys), pointer :: maxwidth (:) => null() ! + real (kind=kind_phys), pointer :: ztop_plume (:) => null() ! integer, pointer :: ktop_plume (:) => null() ! real (kind=kind_phys), pointer :: exch_h (:,:) => null() ! real (kind=kind_phys), pointer :: exch_m (:,:) => null() ! @@ -1974,6 +1981,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: cldfra (:,:) => null() !< instantaneous 3D cloud fraction !--- MP quantities for 3D diagnositics real (kind=kind_phys), pointer :: refl_10cm(:,:) => null() !< instantaneous refl_10cm + real (kind=kind_phys), pointer :: max_hail_diam_sfc(:) => null() !< instantaneous max hail diameter sfc real (kind=kind_phys), pointer :: cldfra2d (:) => null() !< instantaneous 2D cloud fraction real (kind=kind_phys), pointer :: total_albedo (:) => null() !< total sky (with cloud) albedo at toa real (kind=kind_phys), pointer :: lwp_ex (:) => null() !< liquid water path from microphysics @@ -2665,6 +2673,10 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%snowfallac_ice (IM)) allocate (Sfcprop%acsnow_land (IM)) allocate (Sfcprop%acsnow_ice (IM)) + allocate (Sfcprop%xlaixy (IM)) + allocate (Sfcprop%fire_heat_flux_out (IM)) + allocate (Sfcprop%frac_grid_burned_out (IM)) + ! Sfcprop%wetness = clear_val Sfcprop%sh2o = clear_val @@ -2683,13 +2695,12 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%snowfallac_ice = clear_val Sfcprop%acsnow_land = clear_val Sfcprop%acsnow_ice = clear_val + Sfcprop%xlaixy = clear_val + Sfcprop%fire_heat_flux_out = clear_val + Sfcprop%frac_grid_burned_out = clear_val ! - if (Model%rdlai) then - allocate (Sfcprop%xlaixy (IM)) - Sfcprop%xlaixy = clear_val - end if - end if + allocate (Sfcprop%rmol (IM )) allocate (Sfcprop%flhc (IM )) allocate (Sfcprop%flqc (IM )) @@ -3472,7 +3483,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: lsoil_lsm = -1 !< number of soil layers internal to land surface model; -1 use lsoil integer :: lsnow_lsm = 3 !< maximum number of snow layers internal to land surface model logical :: exticeden = .false. !< Use variable precip ice density for NOAH LSM if true or original formulation - logical :: rdlai = .false. !< read LAI from input file (for RUC LSM or NOAH LSM WRFv4) + logical :: rdlai = .false. !< read LAI from input file at cold start (for RUC LSM or NOAH LSM WRFv4) logical :: ua_phys = .false. !< flag for using University of Arizona? extension to NOAH LSM WRFv4 logical :: usemonalb = .true. !< flag to read surface diffused shortwave albedo from input file for NOAH LSM WRFv4 real(kind=kind_phys) :: aoasis = 1.0 !< potential evaporation multiplication factor for NOAH LSM WRFv4 @@ -3515,6 +3526,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: use_ufo = .false. !< flag for gcycle surface option + logical :: add_fire_heat_flux = .false. !< Flag for fire heat flux + logical :: lcurr_sf = .false. !< flag for taking ocean currents into account in GFDL surface layer logical :: pert_cd = .false. !< flag for perturbing the surface drag coefficient for momentum in surface layer scheme integer :: ntsflg = 0 !< flag for updating skin temperature in the GFDL surface layer scheme @@ -3926,6 +3939,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & iopt_inf, iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc, & iopt_trs, iopt_diag, & ! RUC lsm options + add_fire_heat_flux, & mosaic_lu, mosaic_soil, isncond_opt, isncovr_opt, & ! GFDL surface layer options lcurr_sf, pert_cd, ntsflg, sfenth, & @@ -4702,6 +4716,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%mosaic_soil = mosaic_soil Model%isncond_opt = isncond_opt Model%isncovr_opt = isncovr_opt + Model%add_fire_heat_flux = add_fire_heat_flux ! JLS !--- tuning parameters for physical parameterizations Model%ras = ras @@ -5666,6 +5681,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' mosaic_soil = ',mosaic_soil print *,' isncond_opt = ',isncond_opt print *,' isncovr_opt = ',isncovr_opt + print *,' add_fire_heat_flux = ',add_fire_heat_flux else print *,' Unsupported LSM type - job aborted - lsm=',Model%lsm stop @@ -7700,6 +7716,7 @@ subroutine diag_create (Diag, IM, Model) !--- 3D diagnostics for Thompson MP / GFDL MP allocate (Diag%refl_10cm(IM,Model%levs)) + allocate (Diag%max_hail_diam_sfc(IM)) !--- New PBL Diagnostics allocate (Diag%dkt(IM,Model%levs)) @@ -7735,8 +7752,9 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%qbuoy (IM,Model%levs)) allocate (Diag%qdiss (IM,Model%levs)) endif - allocate (Diag%nupdraft (IM)) + allocate (Diag%maxwidth (IM)) allocate (Diag%maxmf (IM)) + allocate (Diag%ztop_plume(IM)) allocate (Diag%ktop_plume(IM)) allocate (Diag%exch_h (IM,Model%levs)) allocate (Diag%exch_m (IM,Model%levs)) @@ -7759,8 +7777,9 @@ subroutine diag_create (Diag, IM, Model) Diag%qbuoy = clear_val Diag%qdiss = clear_val endif - Diag%nupdraft = 0 + Diag%maxwidth = clear_val Diag%maxmf = clear_val + Diag%ztop_plume = clear_val Diag%ktop_plume = 0 Diag%exch_h = clear_val Diag%exch_m = clear_val @@ -7948,8 +7967,9 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%det_thl = clear_val Diag%det_sqv = clear_val endif - Diag%nupdraft = 0 + Diag%maxwidth = clear_val Diag%maxmf = clear_val + Diag%ztop_plume = clear_val Diag%ktop_plume = 0 Diag%exch_h = clear_val Diag%exch_m = clear_val @@ -8053,6 +8073,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) ! max hourly diagnostics Diag%refl_10cm = -35. + Diag%max_hail_diam_sfc = -999. Diag%refdmax = -35. Diag%refdmax263k = -35. Diag%t02max = -999. diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index d028a5834..deea0ad25 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -971,6 +971,22 @@ type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) +[fire_heat_flux_out] + standard_name = surface_fire_heat_flux + long_name = heat flux of fire at the surface + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) +[frac_grid_burned_out] + standard_name = fraction_of_grid_cell_burning + long_name = ration of the burnt area to the grid cell area + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) [snoalb] standard_name = upper_bound_of_max_albedo_assuming_deep_snow long_name = maximum snow albedo @@ -1630,7 +1646,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_noah_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .and. flag_for_reading_leaf_area_index_from_input)) + active = (control_for_land_surface_scheme == identifier_for_noah_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -4648,6 +4664,12 @@ units = flag dimensions = () type = integer +[add_fire_heat_flux] + standard_name = flag_for_fire_heat_flux + long_name = flag to add fire heat flux to LSM + units = flag + dimensions = () + type = logical [isncond_opt] standard_name = control_for_soil_thermal_conductivity_option_in_ruc_lsm long_name = control for soil thermal conductivity option in RUC land surface model @@ -9006,6 +9028,13 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys +[max_hail_diam_sfc] + standard_name = max_hail_diameter_sfc + long_name = instantaneous maximum hail diameter at lowest model level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [dkt] standard_name = atmosphere_heat_diffusivity long_name = atmospheric heat diffusivity @@ -9189,12 +9218,13 @@ type = real kind = kind_phys active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme .and. control_for_tke_budget_output == 1) -[nupdraft] - standard_name = number_of_plumes - long_name = number of plumes per grid column - units = count +[maxwidth] + standard_name = maximum_width_of_plumes + long_name = maximum width of plumes per grid column + units = m dimensions = (horizontal_loop_extent) - type = integer + type = real + kind = kind_phys active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme) [maxMF] standard_name = maximum_mass_flux @@ -9204,6 +9234,14 @@ type = real kind = kind_phys active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme) +[ztop_plume] + standard_name = height_of_tallest_plume_in_a_column + long_name = height of tallest plume in a column + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (flag_for_mellor_yamada_nakanishi_niino_pbl_scheme) [ktop_shallow] standard_name = k_level_of_highest_reaching_plume long_name = k-level of highest reaching plume diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index e3512528c..42b1d1d66 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2175,6 +2175,28 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%gfluxi(:) enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'wilt' + ExtDiag(idx)%desc = 'wiltimg point (volumetric)' + ExtDiag(idx)%unit = 'Proportion' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%smcwlt2(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'fldcp' + ExtDiag(idx)%desc = 'Field Capacity (volumetric)' + ExtDiag(idx)%unit = 'fraction' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%smcref2(:) + enddo + if (Model%lsm == Model%lsm_noahmp) then idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2199,28 +2221,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%epi(:) enddo - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'wilt' - ExtDiag(idx)%desc = 'wiltimg point (volumetric)' - ExtDiag(idx)%unit = 'Proportion' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%smcwlt2(:) - enddo - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'fldcp' - ExtDiag(idx)%desc = 'Field Capacity (volumetric)' - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%smcref2(:) - enddo - idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'wet1' @@ -2317,6 +2317,17 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%refl_10cm(:,:) enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'max_hail_diam_sfc' + ExtDiag(idx)%desc = 'Maximum hail diameter at lowest model level' + ExtDiag(idx)%unit = 'm' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%max_hail_diam_sfc(:) + enddo + idx = idx + 1 ExtDiag(idx)%axes = 3 ExtDiag(idx)%name = 'dkt' @@ -4105,7 +4116,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%visdfdi(:) enddo - if (Model%rdlai) then idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'xlaixy' @@ -4116,7 +4126,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%xlaixy(:) enddo - endif do num = 1,Model%nvegcat write (xtra,'(i2)') num @@ -4550,6 +4559,29 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop end if thompson_extended_diagnostics if (Model%rrfs_sd .and. Model%ntsmoke>0) then + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'fire_heat' + ExtDiag(idx)%desc = 'surface fire heat flux' + ExtDiag(idx)%unit = 'W m-2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%fire_heat_flux_out + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'burned' + ExtDiag(idx)%desc = 'ration of the burnt area to the grid cell area' + ExtDiag(idx)%unit = 'frac' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%frac_grid_burned_out + enddo + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'emdust' @@ -4808,16 +4840,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop !MYNN if (Model%do_mynnedmf) then - !idx = idx + 1 - !ExtDiag(idx)%axes = 2 - !ExtDiag(idx)%name = 'ktop_plume' - !ExtDiag(idx)%desc = 'k-level of plume top' - !ExtDiag(idx)%unit = 'n/a' - !ExtDiag(idx)%mod_name = 'gfs_sfc' - !allocate (ExtDiag(idx)%data(nblks)) - !do nb = 1,nblks - ! ExtDiag(idx)%data(nb)%var2 => real(IntDiag(nb)%ktop_plume(:),kind=kind_phys) - !enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'ztop_plume' + ExtDiag(idx)%desc = 'height of highest plume' + ExtDiag(idx)%unit = 'm' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ztop_plume(:) + enddo idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -4830,16 +4862,16 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%maxmf(:) enddo - !idx = idx + 1 - !ExtDiag(idx)%axes = 2 - !ExtDiag(idx)%name = 'nupdraft' - !ExtDiag(idx)%desc = 'number of plumes in grid column' - !ExtDiag(idx)%unit = 'n/a' - !ExtDiag(idx)%mod_name = 'gfs_sfc' - !allocate (ExtDiag(idx)%data(nblks)) - !do nb = 1,nblks - ! ExtDiag(idx)%data(nb)%var2 => real(IntDiag(nb)%nupdraft(:),kind=kind_phys) - !enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'maxwidth' + ExtDiag(idx)%desc = 'maximum width of plumes in grid column' + ExtDiag(idx)%unit = 'm' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%maxwidth(:) + enddo endif if (Model%do_mynnsfclay) then diff --git a/ccpp/physics b/ccpp/physics index 2b7bb29fd..d566ea4ae 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 2b7bb29fda845a558e6ea8000e948a4a6e0ae0d6 +Subproject commit d566ea4ae7dc777f8c1fcdfbda75a6ff150b168a From cd2c3b7ac0c613148ab2f956505b55f1d47a20ef Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 20 Nov 2023 13:13:45 -0700 Subject: [PATCH 35/48] fix grv function used by NST (#722) * point to bugfix branch: fix grv function used by NST --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index d566ea4ae..ade9c106a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d566ea4ae7dc777f8c1fcdfbda75a6ff150b168a +Subproject commit ade9c106a4bc32fa622341b76449070c912fd7a2 From 65c60173d420548380838ed93418c1c1b4c3c370 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Mon, 27 Nov 2023 10:41:31 -0500 Subject: [PATCH 36/48] Add option to use netcdf quantization (#718) * Add options to specify netcdf quantize mode * Remove old quantize routines --- io/module_fv3_io_def.F90 | 3 +- io/module_write_netcdf.F90 | 131 +++++++----------------------------- io/module_wrt_grid_comp.F90 | 34 +++++----- 3 files changed, 44 insertions(+), 124 deletions(-) diff --git a/io/module_fv3_io_def.F90 b/io/module_fv3_io_def.F90 index fd9c129e0..2689ef1c2 100644 --- a/io/module_fv3_io_def.F90 +++ b/io/module_fv3_io_def.F90 @@ -29,7 +29,8 @@ module module_fv3_io_def real,dimension(:),allocatable :: cen_lon, cen_lat real,dimension(:),allocatable :: lon1, lat1, lon2, lat2, dlon, dlat real,dimension(:),allocatable :: stdlat1, stdlat2, dx, dy - integer,dimension(:),allocatable :: ideflate, nbits, zstandard_level + integer,dimension(:),allocatable :: ideflate, quantize_nsd, zstandard_level + character(len=esmf_maxstr),dimension(:),allocatable :: quantize_mode integer,dimension(:),allocatable :: ichunk2d, jchunk2d, ichunk3d, jchunk3d, kchunk3d end module module_fv3_io_def diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 86650c6e7..e9670945b 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -10,7 +10,7 @@ module module_write_netcdf use mpi use esmf use netcdf - use module_fv3_io_def,only : ideflate, nbits, zstandard_level, & + use module_fv3_io_def,only : ideflate, quantize_mode, quantize_nsd, zstandard_level, & ichunk2d,jchunk2d,ichunk3d,jchunk3d,kchunk3d, & dx,dy,lon1,lat1,lon2,lat2, & time_unlimited @@ -21,11 +21,6 @@ module module_write_netcdf logical :: par - interface quantize_array - module procedure quantize_array_3d - module procedure quantize_array_4d - end interface - contains !---------------------------------------------------------------------------------------- @@ -86,6 +81,7 @@ subroutine write_netcdf(wrtfb, filename, & integer, dimension(:), allocatable :: dimids_2d, dimids_3d, dimids, chunksizes integer, dimension(:), allocatable :: varids integer :: xtype + integer :: quant_mode integer :: ishuffle logical shuffle @@ -358,10 +354,10 @@ subroutine write_netcdf(wrtfb, filename, & ncerr = nf90_def_var_chunking(ncid, varids(i), NF90_CHUNKED, chunksizes) ; NC_ERR_STOP(ncerr) end if - ishuffle = NF90_SHUFFLE - ! shuffle filter off for 3d fields using lossy compression - if (rank == 3 .and. nbits(grid_id) > 0) then - ishuffle = NF90_NOSHUFFLE + ishuffle = NF90_NOSHUFFLE + ! shuffle filter on when using lossy compression + if ( quantize_nsd(grid_id) > 0) then + ishuffle = NF90_SHUFFLE end if if (ideflate(grid_id) > 0) then ncerr = nf90_def_var_deflate(ncid, varids(i), ishuffle, 1, ideflate(grid_id)) ; NC_ERR_STOP(ncerr) @@ -370,6 +366,24 @@ subroutine write_netcdf(wrtfb, filename, & ncerr = nf90_def_var_zstandard(ncid, varids(i), zstandard_level(grid_id)) ; NC_ERR_STOP(ncerr) end if + ! turn on quantize only for 3d variables and if requested + if (rank == 3 .and. quantize_nsd(grid_id) > 0) then + ! nf90_quantize_bitgroom = 1 + ! nf90_quantize_granularbr = 2 + ! nf90_quantize_bitround = 3 (nsd is number of bits) + if (trim(quantize_mode(grid_id)) == 'quantize_bitgroom') then + quant_mode = 1 + else if (trim(quantize_mode(grid_id)) == 'quantize_granularbr') then + quant_mode = 2 + else if (trim(quantize_mode(grid_id)) == 'quantize_bitround') then + quant_mode = 3 + else + if (mype==0) write(0,*)'Unknown quantize_mode ', trim(quantize_mode(grid_id)) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + + ncerr = nf90_def_var_quantize(ncid, varids(i), quant_mode, quantize_nsd(grid_id)) ; NC_ERR_STOP(ncerr) + end if end if if (par) then @@ -626,14 +640,6 @@ subroutine write_netcdf(wrtfb, filename, & if (typekind == ESMF_TYPEKIND_R4) then if (par) then call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=array_r4_3d, rc=rc); ESMF_ERR_RETURN(rc) - if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0) then - dataMax = maxval(array_r4_3d) - dataMin = minval(array_r4_3d) - call mpi_allreduce(mpi_in_place,dataMax,1,mpi_real4,mpi_max,mpi_comm,ierr) - call mpi_allreduce(mpi_in_place,dataMin,1,mpi_real4,mpi_min,mpi_comm,ierr) - call quantize_array(array_r4_3d, dataMin, dataMax, nbits(grid_id), compress_err(i)) - call mpi_allreduce(mpi_in_place,compress_err(i),1,mpi_real4,mpi_max,mpi_comm,ierr) - end if ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d, start=start_idx); NC_ERR_STOP(ncerr) else if (is_cubed_sphere) then @@ -642,17 +648,11 @@ subroutine write_netcdf(wrtfb, filename, & call ESMF_ArrayGather(array, array_r4_3d_cube(:,:,:,t), rootPet=0, tile=t, rc=rc); ESMF_ERR_RETURN(rc) end do if (mype==0) then - if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0) then - call quantize_array(array_r4_3d_cube, minval(array_r4_3d_cube), maxval(array_r4_3d_cube), nbits(grid_id), compress_err(i)) - end if ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d_cube, start=start_idx); NC_ERR_STOP(ncerr) end if else call ESMF_FieldGather(fcstField(i), array_r4_3d, rootPet=0, rc=rc); ESMF_ERR_RETURN(rc) if (mype==0) then - if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0) then - call quantize_array(array_r4_3d, minval(array_r4_3d), maxval(array_r4_3d), nbits(grid_id), compress_err(i)) - end if ncerr = nf90_put_var(ncid, varids(i), values=array_r4_3d, start=start_idx); NC_ERR_STOP(ncerr) end if end if @@ -688,17 +688,6 @@ subroutine write_netcdf(wrtfb, filename, & end do ! end fieldCount - if ((ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) .and. nbits(grid_id) > 0 .and. do_io) then - ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) - do i=1, fieldCount - if (compress_err(i) > 0) then - ncerr = nf90_put_att(ncid, varids(i), 'max_abs_compression_error', compress_err(i)); NC_ERR_STOP(ncerr) - ncerr = nf90_put_att(ncid, varids(i), 'nbits', nbits(grid_id)); NC_ERR_STOP(ncerr) - end if - end do - ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) - end if - if (.not. par) then deallocate(array_r4) deallocate(array_r8) @@ -923,77 +912,5 @@ subroutine add_dim(ncid, dim_name, dimid, grid, mype, rc) end subroutine add_dim -!---------------------------------------------------------------------------------------- - subroutine quantize_array_3d(array, dataMin, dataMax, nbits, compress_err) - - real(4), dimension(:,:,:), intent(inout) :: array - real(4), intent(in) :: dataMin, dataMax - integer, intent(in) :: nbits - real(4), intent(out) :: compress_err - - real(4) :: scale_fact, offset - real(4), dimension(:,:,:), allocatable :: array_save - ! Lossy compression if nbits>0. - ! The floating point data is quantized to improve compression - ! See doi:10.5194/gmd-10-413-2017. The method employed - ! here is identical to the 'scaled linear packing' method in - ! that paper, except that the data are scaling into an arbitrary - ! range (2**nbits-1 not just 2**16-1) and are stored as - ! re-scaled floats instead of short integers. - ! The zlib algorithm does almost as - ! well packing the re-scaled floats as it does the scaled - ! integers, and this avoids the need for the client to apply the - ! rescaling (plus it allows the ability to adjust the packing - ! range). - scale_fact = (dataMax - dataMin) / (2**nbits-1) - offset = dataMin - if (scale_fact > 0.) then - allocate(array_save, source=array) - array = scale_fact*(nint((array_save - offset) / scale_fact)) + offset - ! compute max abs compression error - compress_err = maxval(abs(array_save-array)) - deallocate(array_save) - else - ! field is constant - compress_err = 0. - end if - end subroutine quantize_array_3d - - subroutine quantize_array_4d(array, dataMin, dataMax, nbits, compress_err) - - real(4), dimension(:,:,:,:), intent(inout) :: array - real(4), intent(in) :: dataMin, dataMax - integer, intent(in) :: nbits - real(4), intent(out) :: compress_err - - real(4) :: scale_fact, offset - real(4), dimension(:,:,:,:), allocatable :: array_save - - ! Lossy compression if nbits>0. - ! The floating point data is quantized to improve compression - ! See doi:10.5194/gmd-10-413-2017. The method employed - ! here is identical to the 'scaled linear packing' method in - ! that paper, except that the data are scaling into an arbitrary - ! range (2**nbits-1 not just 2**16-1) and are stored as - ! re-scaled floats instead of short integers. - ! The zlib algorithm does almost as - ! well packing the re-scaled floats as it does the scaled - ! integers, and this avoids the need for the client to apply the - ! rescaling (plus it allows the ability to adjust the packing - ! range). - scale_fact = (dataMax - dataMin) / (2**nbits-1) - offset = dataMin - if (scale_fact > 0.) then - allocate(array_save, source=array) - array = scale_fact*(nint((array_save - offset) / scale_fact)) + offset - ! compute max abs compression error - compress_err = maxval(abs(array_save-array)) - deallocate(array_save) - else - ! field is constant - compress_err = 0. - end if - end subroutine quantize_array_4d - !---------------------------------------------------------------------------------------- end module module_write_netcdf diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index ec8135217..bcca85ab4 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -36,7 +36,8 @@ module module_wrt_grid_comp n_group, num_files, & filename_base, output_grid, output_file, & imo,jmo,ichunk2d,jchunk2d, & - ichunk3d,jchunk3d,kchunk3d,nbits, & + ichunk3d,jchunk3d,kchunk3d, & + quantize_mode,quantize_nsd, & nsout => nsout_io, & cen_lon, cen_lat, & lon1, lat1, lon2, lat2, dlon, dlat, & @@ -361,7 +362,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, allocate(jchunk3d(ngrids)) allocate(kchunk3d(ngrids)) allocate(ideflate(ngrids)) - allocate(nbits(ngrids)) + allocate(quantize_mode(ngrids)) + allocate(quantize_nsd(ngrids)) allocate(zstandard_level(ngrids)) allocate(wrt_int_state%out_grid_info(ngrids)) @@ -472,28 +474,33 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_ConfigGetAttribute(config=CF,value=zstandard_level(n),default=0,label ='zstandard_level:',rc=rc) if (zstandard_level(n) < 0) zstandard_level(n)=0 - call ESMF_ConfigGetAttribute(config=CF,value=nbits(n),default=0,label ='nbits:',rc=rc) - ! zlib compression flag call ESMF_ConfigGetAttribute(config=CF,value=ideflate(n),default=0,label ='ideflate:',rc=rc) if (ideflate(n) < 0) ideflate(n)=0 - call ESMF_ConfigGetAttribute(config=CF,value=nbits(n),default=0,label ='nbits:',rc=rc) - if (ideflate(n) > 0 .and. zstandard_level(n) > 0) then write(0,*)"wrt_initialize_p1: zlib and zstd compression cannot be both enabled at the same time" call ESMF_LogWrite("wrt_initialize_p1: zlib and zstd compression cannot be both enabled at the same time",ESMF_LOGMSG_ERROR,rc=RC) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if + ! quantize_mode and quantize_nsd + call ESMF_ConfigGetAttribute(config=CF,value=quantize_mode(n),default='quantize_bitgroom',label='quantize_mode:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=quantize_nsd(n),default=0,label='quantize_nsd:',rc=rc) + + if (.NOT. (trim(quantize_mode(n))=='quantize_bitgroom' & + .OR. trim(quantize_mode(n))=='quantize_granularbr' & + .OR. trim(quantize_mode(n))=='quantize_bitround') ) then + write(0,*)"wrt_initialize_p1: unknown quantize_mode ", trim(quantize_mode(n)) + call ESMF_LogWrite("wrt_initialize_p1: wrt_initialize_p1: unknown quantize_mode "//trim(quantize_mode(n)),ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + if (lprnt) then - print *,'ideflate=',ideflate(n),' nbits=',nbits(n) + print *,'ideflate=',ideflate(n) + print *,'quantize_mode=',trim(quantize_mode(n)),' quantize_nsd=',quantize_nsd(n) print *,'zstandard_level=',zstandard_level(n) end if - ! nbits quantization level for lossy compression (must be between 1 and 31) - ! 1 is most compression, 31 is least. If outside this range, set to zero - ! which means use lossless compression. - if (nbits(n) < 1 .or. nbits(n) > 31) nbits(n)=0 ! lossless compression (no quantization) if (cf_output_grid /= cf) then ! destroy the temporary config object created for nest domains @@ -2386,11 +2393,6 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif - if (nbits(grid_id) /= 0) then - call ESMF_LogWrite("wrt_run: lossy compression is not supported for regional grids",ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & use_parallel_netcdf, wrt_mpi_comm,wrt_int_state%mype, & grid_id,rc) From 7eec3ceb4062ad761af2b6f6a9e133f1b948b3e1 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 29 Nov 2023 17:50:26 -0500 Subject: [PATCH 37/48] fix type mis-matches in nst water property module (#719) --- ccpp/config/ccpp_prebuild_config.py | 6 +++--- ccpp/physics | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index a96b067ac..268eb2166 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -186,9 +186,9 @@ 'physics/physics/noahmpdrv.F90', 'physics/physics/flake_driver.F90', 'physics/physics/clm_lake.f90', - 'physics/physics/sfc_nst_pre.f', - 'physics/physics/sfc_nst.f', - 'physics/physics/sfc_nst_post.f', + 'physics/physics/sfc_nst_pre.f90', + 'physics/physics/sfc_nst.f90', + 'physics/physics/sfc_nst_post.f90', 'physics/physics/sfc_ocean.F', 'physics/physics/sfc_sice.f', # HAFS FER_HIRES diff --git a/ccpp/physics b/ccpp/physics index ade9c106a..a77ed1647 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ade9c106a4bc32fa622341b76449070c912fd7a2 +Subproject commit a77ed1647440a3acd83625f46b1605f8b8239093 From 1f7af4b8abc69d6f8c9a435804ea55ba18d18df2 Mon Sep 17 00:00:00 2001 From: ericaligo-NOAA <48365233+ericaligo-NOAA@users.noreply.github.com> Date: Fri, 1 Dec 2023 10:38:48 -0500 Subject: [PATCH 38/48] Convective Reflectivity (#720) * Convective reflectivity added for NSSL,Thompson mp,SAS,GF shal/deep * Bug fix: htop intent set to in, modified if condition for convective refl. * Bug fix for conv refl,remove conv refl computation from the cu_gf driver * clean up a bit, remove comments and temporary parameters * Take advantage of onebg to avoid division * Replace 273.16 with already defined physical constant, con_t0c --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index a77ed1647..c0aa212db 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit a77ed1647440a3acd83625f46b1605f8b8239093 +Subproject commit c0aa212dbc255ac5d77934c3cd6283c994bbfd99 From ba6e8ea442b2d0d5992a8550db6d0c720ff338d2 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 4 Dec 2023 11:36:30 -0500 Subject: [PATCH 39/48] add 5 ccpp SDFs in support of RRFS multiphysics ensemble (#721) * add 5 ccpp SDFs in support of RRFS ensemble * add one more ccpp SDF for RRFS fire weather application by removing GWD in FV3_HRRR_gf --- ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml | 84 ++++++++++++++++++++++++ ccpp/suites/suite_RRFSens_phy1.xml | 86 +++++++++++++++++++++++++ ccpp/suites/suite_RRFSens_phy2.xml | 83 ++++++++++++++++++++++++ ccpp/suites/suite_RRFSens_phy3.xml | 83 ++++++++++++++++++++++++ ccpp/suites/suite_RRFSens_phy4.xml | 84 ++++++++++++++++++++++++ ccpp/suites/suite_RRFSens_phy5.xml | 81 +++++++++++++++++++++++ 6 files changed, 501 insertions(+) create mode 100644 ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml create mode 100644 ccpp/suites/suite_RRFSens_phy1.xml create mode 100644 ccpp/suites/suite_RRFSens_phy2.xml create mode 100644 ccpp/suites/suite_RRFSens_phy3.xml create mode 100644 ccpp/suites/suite_RRFSens_phy4.xml create mode 100644 ccpp/suites/suite_RRFSens_phy5.xml diff --git a/ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml b/ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml new file mode 100644 index 000000000..3e4b862c9 --- /dev/null +++ b/ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml @@ -0,0 +1,84 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + rrfs_smoke_wrapper + mynnedmf_wrapper + rrfs_smoke_postpbl + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + GFS_physics_post + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_RRFSens_phy1.xml b/ccpp/suites/suite_RRFSens_phy1.xml new file mode 100644 index 000000000..0cd4c47b8 --- /dev/null +++ b/ccpp/suites/suite_RRFSens_phy1.xml @@ -0,0 +1,86 @@ + + + + + + + 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 + rad_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_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + GFS_physics_post + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_RRFSens_phy2.xml b/ccpp/suites/suite_RRFSens_phy2.xml new file mode 100644 index 000000000..e1ecc7149 --- /dev/null +++ b/ccpp/suites/suite_RRFSens_phy2.xml @@ -0,0 +1,83 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + GFS_physics_post + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_RRFSens_phy3.xml b/ccpp/suites/suite_RRFSens_phy3.xml new file mode 100644 index 000000000..85e7189bd --- /dev/null +++ b/ccpp/suites/suite_RRFSens_phy3.xml @@ -0,0 +1,83 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_nssl + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + GFS_physics_post + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_RRFSens_phy4.xml b/ccpp/suites/suite_RRFSens_phy4.xml new file mode 100644 index 000000000..35c7b052f --- /dev/null +++ b/ccpp/suites/suite_RRFSens_phy4.xml @@ -0,0 +1,84 @@ + + + + + + + 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 + rad_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_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_nssl + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + GFS_physics_post + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_RRFSens_phy5.xml b/ccpp/suites/suite_RRFSens_phy5.xml new file mode 100644 index 000000000..26bb32584 --- /dev/null +++ b/ccpp/suites/suite_RRFSens_phy5.xml @@ -0,0 +1,81 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_nssl + GFS_MP_generic_post + maximum_hourly_diagnostics + GFS_physics_post + + + + + GFS_stochastics + + + + From a82381c0b751a15e5343de5078ef836b2c444c89 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Tue, 5 Dec 2023 15:13:13 -0500 Subject: [PATCH 40/48] Create 'coupler.res' log file in write grid comp. Explicitly specify chunk sizes in restart files (#726) * Write coupler.res log files from the write grid comp if quilting_restart is .true. * Explicitly specify chunk sizes in write_restart_netcdf --- io/module_write_restart_netcdf.F90 | 9 +++++- io/module_wrt_grid_comp.F90 | 50 ++++++++++++++++++++++++++---- module_fcst_grid_comp.F90 | 14 ++++----- 3 files changed, 59 insertions(+), 14 deletions(-) diff --git a/io/module_write_restart_netcdf.F90 b/io/module_write_restart_netcdf.F90 index ec46d6f23..2fd4c7732 100644 --- a/io/module_write_restart_netcdf.F90 +++ b/io/module_write_restart_netcdf.F90 @@ -79,7 +79,7 @@ subroutine write_restart_netcdf(wrtfb, filename, & integer :: dimid, dimtype integer :: im_dimid, im_p1_dimid, jm_dimid, jm_p1_dimid, time_dimid integer :: im_varid, im_p1_varid, jm_varid, jm_p1_varid, time_varid - integer, dimension(:), allocatable :: dimids_2d, dimids_3d + integer, dimension(:), allocatable :: dimids_2d, dimids_3d, chunksizes integer, dimension(:), allocatable :: varids, zaxis_dimids logical shuffle @@ -335,6 +335,7 @@ subroutine write_restart_netcdf(wrtfb, filename, & ! define variables if (rank == 2) then dimids_2d = [im_dimid,jm_dimid, time_dimid] + chunksizes = [im, jm, 1] if (typekind == ESMF_TYPEKIND_R4) then ncerr = nf90_def_var(ncid, trim(fldName), NF90_FLOAT, dimids_2d, varids(i)); NC_ERR_STOP(ncerr) else if (typekind == ESMF_TYPEKIND_R8) then @@ -346,13 +347,17 @@ subroutine write_restart_netcdf(wrtfb, filename, & else if (rank == 3) then if ( .not.is_restart_core ) then dimids_3d = [im_dimid,jm_dimid,zaxis_dimids(i),time_dimid] + chunksizes = [im, jm, 1, 1] else if (staggerloc == ESMF_STAGGERLOC_CENTER) then dimids_3d = [im_dimid,jm_dimid,zaxis_dimids(i),time_dimid] + chunksizes = [im, jm, 1, 1] else if (staggerloc == ESMF_STAGGERLOC_EDGE1) then ! east dimids_3d = [im_p1_dimid,jm_dimid,zaxis_dimids(i),time_dimid] + chunksizes = [im+1, jm, 1, 1] else if (staggerloc == ESMF_STAGGERLOC_EDGE2) then ! south dimids_3d = [im_dimid,jm_p1_dimid,zaxis_dimids(i),time_dimid] + chunksizes = [im, jm+1, 1, 1] else if (mype==0) write(0,*)'Unsupported staggerloc ', staggerloc call ESMF_Finalize(endflag=ESMF_END_ABORT) @@ -374,6 +379,8 @@ subroutine write_restart_netcdf(wrtfb, filename, & ncerr = nf90_var_par_access(ncid, varids(i), par_access); NC_ERR_STOP(ncerr) end if + ncerr = nf90_def_var_chunking(ncid, varids(i), NF90_CHUNKED, chunksizes) ; NC_ERR_STOP(ncerr) + if (zstandard_level(1) > 0) then ncerr = nf90_def_var_zstandard(ncid, varids(i), zstandard_level(1)) if (ncerr /= nf90_noerr) then diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index bcca85ab4..b59fe5e45 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -44,7 +44,7 @@ module module_wrt_grid_comp stdlat1, stdlat2, dx, dy, iau_offset, & ideflate, zstandard_level, lflname_fulltime use module_write_netcdf, only : write_netcdf - use module_write_restart_netcdf + use module_write_restart_netcdf, only : write_restart_netcdf use physcons, only : pi => con_pi #ifdef INLINE_POST use post_fv3, only : post_run_fv3 @@ -68,10 +68,11 @@ module module_wrt_grid_comp integer,save :: ngrids integer,save :: wrt_mpi_comm !<-- the mpi communicator in the write comp - integer,save :: idate(7) + integer,save :: idate(7), start_time(7) logical,save :: write_nsflip logical,save :: change_wrtidate=.false. integer,save :: frestart(999) = -1 + integer,save :: calendar_type = 3 logical :: lprnt ! !----------------------------------------------------------------------- @@ -840,6 +841,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, h=idate(4), m=idate(5), s=idate(6),rc=rc) ! if (lprnt) write(0,*) 'in wrt initial, io_baseline time=',idate,'rc=',rc idate(7) = 1 + start_time = idate wrt_int_state%idate = idate wrt_int_state%fdate = idate ! update IO-BASETIME and idate on write grid comp when IAU is enabled @@ -1333,8 +1335,27 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! save calendar_type (as integer) for use in 'coupler.res' + if (index(trim(attNameList(i)),'time:calendar') > 0) then + select case( uppercase(trim(valueS)) ) + case( 'JULIAN' ) + calendar_type = JULIAN + case( 'GREGORIAN' ) + calendar_type = GREGORIAN + case( 'NOLEAP' ) + calendar_type = NOLEAP + case( 'THIRTY_DAY' ) + calendar_type = THIRTY_DAY_MONTHS + case( 'NO_CALENDAR' ) + calendar_type = NO_CALENDAR + case default + call mpp_error ( FATAL, 'fcst_initialize: calendar must be one of '// & + 'JULIAN|GREGORIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + end select + endif + ! update the time:units when idate on write grid component is changed - if ( index(trim(attNameList(i)),'time:units')>0) then + if (index(trim(attNameList(i)),'time:units') > 0) then if ( change_wrtidate ) then idx = index(trim(valueS),' since ') if(lprnt) print *,'in write grid comp, time:unit=',trim(valueS) @@ -1795,7 +1816,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) logical :: use_parallel_netcdf real, allocatable :: output_fh(:) - logical :: is_restart_bundle + logical :: is_restart_bundle, restart_written integer :: tileCount ! !----------------------------------------------------------------------- @@ -2151,6 +2172,8 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! if (lprnt) write(0,*)'wrt_run: loop over wrt_int_state%FBCount ',wrt_int_state%FBCount, ' nfhour ', nfhour, ' cdate ', cdate(1:6) two_phase_loop: do out_phase = 1, 2 + + restart_written = .false. file_loop_all: do nbdl=1, wrt_int_state%FBCount call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), name=wrtFBName, rc=rc) @@ -2349,6 +2372,8 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) rc) endif ! cubed sphere vs. regional/nest write grid + restart_written = .true. + else ! history bundle if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then @@ -2413,13 +2438,26 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) enddo file_loop_all if (out_phase == 1 .and. mype == lead_write_task) then - !** write out log file - open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') + !** write history log file + open(newunit=nolog, file='log.atm.f'//trim(cfhour)) write(nolog,"('completed: fv3atm')") write(nolog,"('forecast hour: ',f10.3)") nfhour write(nolog,"('valid time: ',6(i4,2x))") wrt_int_state%fdate(1:6) close(nolog) endif + + if (out_phase == 2 .and. restart_written .and. mype == lead_write_task) then + !** write coupler.res log file + open(newunit=nolog, file='RESTART/'//trim(time_restart)//'.coupler.res', status='new') + write(nolog,"(i6,8x,a)") calendar_type , & + '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' + write(nolog,"(6i6,8x,a)") start_time(1:6), & + 'Model start time: year, month, day, hour, minute, second' + write(nolog,"(6i6,8x,a)") wrt_int_state%fdate(1:6), & + 'Current model time: year, month, day, hour, minute, second' + close(nolog) + endif + enddo two_phase_loop endif ! if ( wrt_int_state%output_history ) diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 4bc7bfe52..ea622369c 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -921,11 +921,11 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! Add time Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & attrList=(/ "time ", & - "time:long_name ", & - "time:units ", & - "time:cartesian_axis", & - "time:calendar_type ", & - "time:calendar " /), rc=rc) + "time:long_name ", & + "time:units ", & + "time:cartesian_axis", & + "time:calendar_type ", & + "time:calendar " /), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_AttributeSet(exportState, convention="NetCDF", purpose="FV3", & @@ -1366,8 +1366,8 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) call atmos_model_restart(Atmos, timestamp) call write_stoch_restart_atm('RESTART/'//trim(timestamp)//'.atm_stoch.res.nc') - !----- write restart file ------ - if (mpp_pe() == mpp_root_pe())then + !----- write coupler.res file ------ + if (.not. quilting_restart .and. mpp_pe() == mpp_root_pe()) then call get_date (Atmos%Time, date(1), date(2), date(3), date(4), date(5), date(6)) open( newunit=unit, file='RESTART/'//trim(timestamp)//'.coupler.res' ) write( unit, '(i6,8x,a)' )calendar_type, & From f221fc5ce66cee86160efa4bc4deb9c861959e19 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Tue, 19 Dec 2023 13:39:28 -0500 Subject: [PATCH 41/48] bug fix: disable concurrency in GFS_phys_time_vary_init NetCDF calls (#735) * Remove nfhout, nfhout_hf, nsout * Do not open 'coupler.res' file with status 'new' * bug fix: no concurrent NetCDF calls in GFS_phys_time_vary_init --------- Co-authored-by: Dusan Jovic --- atmos_model.F90 | 4 +- ccpp/physics | 2 +- fv3_cap.F90 | 73 ++----------------------------------- io/module_fv3_io_def.F90 | 2 +- io/module_wrt_grid_comp.F90 | 5 +-- module_fv3_config.F90 | 2 +- 6 files changed, 10 insertions(+), 78 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 25cc61a88..7105f6997 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -101,7 +101,7 @@ module atmos_model_mod use fv_ufs_restart_io_mod, only: fv_dyn_restart_register, & fv_dyn_restart_output use fv_iau_mod, only: iau_external_data_type,getiauforcing,iau_initialize -use module_fv3_config, only: first_kdt, nsout, output_fh, & +use module_fv3_config, only: first_kdt, output_fh, & fcst_mpi_comm, fcst_ntasks, & quilting_restart use module_block_data, only: block_atmos_copy, block_data_copy, & @@ -976,7 +976,7 @@ subroutine update_atmos_model_state (Atmos, rc) call get_time (Atmos%Time - diag_time, isec) call get_time (Atmos%Time - Atmos%Time_init, seconds) call atmosphere_nggps_diag(Atmos%Time,ltavg=.true.,avg_max_length=avg_max_length) - if (ANY(nint(output_fh(:)*3600.0) == seconds) .or. (GFS_control%kdt == first_kdt) .or. nsout > 0) then + if (ANY(nint(output_fh(:)*3600.0) == seconds) .or. (GFS_control%kdt == first_kdt)) then if (mpp_pe() == mpp_root_pe()) write(6,*) "---isec,seconds",isec,seconds time_int = real(isec) if(Atmos%iau_offset > zero) then diff --git a/ccpp/physics b/ccpp/physics index c0aa212db..ed7e015b4 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c0aa212dbc255ac5d77934c3cd6283c994bbfd99 +Subproject commit ed7e015b483a14fc7ae9bf9d0f0cc3d26c517f7e diff --git a/fv3_cap.F90 b/fv3_cap.F90 index ada73a861..5401e66a5 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -28,7 +28,7 @@ module fv3atm_cap_mod NUOPC_ModelGet ! use module_fv3_config, only: quilting, quilting_restart, output_fh, & - nfhout, nfhout_hf, nsout, dt_atmos, & + dt_atmos, & calendar, cpl_grid_id, & cplprint_flag, first_kdt @@ -36,7 +36,7 @@ module fv3atm_cap_mod num_files, filename_base, & wrttasks_per_group, n_group, & lead_wrttask, last_wrttask, & - nsout_io, iau_offset, lflname_fulltime, & + iau_offset, lflname_fulltime, & time_unlimited ! use module_fcst_grid_comp, only: fcstSS => SetServices @@ -301,7 +301,6 @@ subroutine InitializeAdvertise(gcomp, rc) if(mype == 0) print *,'af ufs config,quilting=',quilting,' calendar=', trim(calendar),' iau_offset=',iau_offset, & ' noutput_fh=',noutput_fh ! - nfhout = 0 ; nfhmax_hf = 0 ; nfhout_hf = 0 ; nsout = 0 if ( quilting ) then call ESMF_ConfigGetAttribute(config=CF,value=use_saved_routehandles, & label ='use_saved_routehandles:', & @@ -334,15 +333,6 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo -! variables for output - call ESMF_ConfigGetAttribute(config=CF, value=nfhout, label ='nfhout:', default=-1,rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=nfhmax_hf,label ='nfhmax_hf:',default=-1,rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=nfhout_hf,label ='nfhout_hf:',default=-1,rc=rc) - call ESMF_ConfigGetAttribute(config=CF, value=nsout, label ='nsout:', default=-1,rc=rc) - nsout_io = nsout -! - if(mype==0) print *,'af ufs config,nfhout,nsout=',nfhout,nfhmax_hf,nfhout_hf, nsout,noutput_fh - call ESMF_ConfigGetAttribute(config=CF, value=time_unlimited, label ='time_unlimited:', default=.false., rc=rc) endif ! quilting @@ -819,64 +809,7 @@ subroutine InitializeAdvertise(gcomp, rc) if(iau_offset > 0) then output_startfh = iau_offset endif - if(mype==0) print *,'in fv3 cap init, output_startfh=',output_startfh,'nsout=',nsout, & - 'iau_offset=',iau_offset,'nfhmax_hf=',nfhmax_hf,'nfhout_hf=',nfhout_hf, & - 'nfhout=',nfhout -! -!--- set up output_fh with output forecast hours -! if the run does not have iau, it will have output after first step integration as fh00 -! if the run has iau, it will start output at fh=00 at the cycle time (usually StartTime+IAU_offsetTI) - if(nsout > 0) then -!--- use nsout for output frequency nsout*dt_atmos - nfh = 0 - if( nfhmax > output_startfh ) nfh = nint((nfhmax-output_startfh)/(nsout*dt_atmos/3600.))+1 - if(nfh >0) then - allocate(output_fh(nfh)) - if( output_startfh == 0) then - output_fh(1) = dt_atmos/3600. - else - output_fh(1) = output_startfh - endif - do i=2,nfh - output_fh(i) = (i-1)*nsout*dt_atmos/3600. + output_startfh - enddo - endif - elseif (nfhmax_hf > 0 ) then -!--- use high frequency output and low frequency for output forecast time - nfh = 0 - if( nfhout_hf>0 .and. nfhmax_hf>output_startfh) nfh = nint((nfhmax_hf-output_startfh)/nfhout_hf)+1 - nfh2 = 0 - if( nfhout>0 .and. nfhmax>nfhmax_hf) nfh2 = nint((nfhmax-nfhmax_hf)/nfhout) - if( nfh+nfh2 > 0) then - allocate(output_fh(nfh+nfh2)) - if( output_startfh == 0) then - output_fh(1) = dt_atmos/3600. - else - output_fh(1) = output_startfh - endif - do i=2,nfh - output_fh(i) = (i-1)*nfhout_hf + output_startfh - enddo - do i=1,nfh2 - output_fh(nfh+i) = nfhmax_hf + i*nfhout - enddo - endif - elseif (nfhout > 0 ) then -!--- use one output freqency - nfh = 0 - if( nfhout > 0 .and. nfhmax>output_startfh) nfh = nint((nfhmax-output_startfh)/nfhout) + 1 - if( nfh > 0 ) then - allocate(output_fh(nfh)) - if( output_startfh == 0) then - output_fh(1) = dt_atmos/3600. - else - output_fh(1) = output_startfh - endif - do i=2,nfh - output_fh(i) = (i-1)*nfhout + output_startfh - enddo - endif - endif + if(mype==0) print *,'in fv3 cap init, output_startfh=',output_startfh,' iau_offset=',iau_offset ! !----------------------------------------------------------------------- !*** SET THE FIRST WRITE GROUP AS THE FIRST ONE TO ACT. diff --git a/io/module_fv3_io_def.F90 b/io/module_fv3_io_def.F90 index 2689ef1c2..dfef37500 100644 --- a/io/module_fv3_io_def.F90 +++ b/io/module_fv3_io_def.F90 @@ -15,7 +15,7 @@ module module_fv3_io_def integer :: n_group integer :: num_files integer :: nbdlphys - integer :: nsout_io, iau_offset + integer :: iau_offset logical :: lflname_fulltime logical :: time_unlimited diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index b59fe5e45..e409788ab 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -38,7 +38,6 @@ module module_wrt_grid_comp imo,jmo,ichunk2d,jchunk2d, & ichunk3d,jchunk3d,kchunk3d, & quantize_mode,quantize_nsd, & - nsout => nsout_io, & cen_lon, cen_lat, & lon1, lat1, lon2, lat2, dlon, dlat, & stdlat1, stdlat2, dx, dy, iau_offset, & @@ -1876,7 +1875,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (nf_hours < 0) return - if (nsout > 0 .or. lflname_fulltime) then + if (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,'-',nf_seconds @@ -2448,7 +2447,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (out_phase == 2 .and. restart_written .and. mype == lead_write_task) then !** write coupler.res log file - open(newunit=nolog, file='RESTART/'//trim(time_restart)//'.coupler.res', status='new') + open(newunit=nolog, file='RESTART/'//trim(time_restart)//'.coupler.res') write(nolog,"(i6,8x,a)") calendar_type , & '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' write(nolog,"(6i6,8x,a)") start_time(1:6), & diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index aac606a5e..7e82c8e24 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -13,7 +13,7 @@ module module_fv3_config implicit none ! - integer :: nfhout, nfhout_hf, nsout, dt_atmos + integer :: dt_atmos integer :: first_kdt integer :: fcst_mpi_comm, fcst_ntasks ! From 87a0ccae64b180d6b45d6f50fa55718d8ff26ede Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Thu, 21 Dec 2023 10:46:46 -0500 Subject: [PATCH 42/48] pressure is not density and weasdi is not snodi + #739 and #742 (#736) * pressure is not density * wrong variable sent for snodi * explain lakedepth corruption safeguards * module_sf_ruclsm.f90: explain the snow_mosaic=0 line * add flag to track new freezing lake ice grids * change name of lake_freeze to flag_lakefreeze --------- Co-authored-by: Jili Dong --- ccpp/data/CCPP_typedefs.F90 | 3 +++ ccpp/data/CCPP_typedefs.meta | 6 ++++++ ccpp/driver/GFS_diagnostics.F90 | 4 ++-- ccpp/physics | 2 +- 4 files changed, 12 insertions(+), 3 deletions(-) diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index a7da2eca9..7d9351337 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -140,6 +140,7 @@ module CCPP_typedefs logical, pointer :: flag_cice(:) => null() !< logical, pointer :: flag_guess(:) => null() !< logical, pointer :: flag_iter(:) => null() !< + logical, pointer :: flag_lakefreeze(:) => null() !< real (kind=kind_phys), pointer :: ffmm_ice(:) => null() !< real (kind=kind_phys), pointer :: ffmm_land(:) => null() !< real (kind=kind_phys), pointer :: ffmm_water(:) => null() !< @@ -607,6 +608,7 @@ subroutine gfs_interstitial_create (Interstitial, IM, Model) allocate (Interstitial%flag_cice (IM)) allocate (Interstitial%flag_guess (IM)) allocate (Interstitial%flag_iter (IM)) + allocate (Interstitial%flag_lakefreeze (IM)) allocate (Interstitial%ffmm_ice (IM)) allocate (Interstitial%ffmm_land (IM)) allocate (Interstitial%ffmm_water (IM)) @@ -1297,6 +1299,7 @@ subroutine gfs_interstitial_phys_reset (Interstitial, Model) Interstitial%flag_cice = .false. Interstitial%flag_guess = .false. Interstitial%flag_iter = .true. + Interstitial%flag_lakefreeze = .false. Interstitial%ffmm_ice = Model%huge Interstitial%ffmm_land = Model%huge Interstitial%ffmm_water = Model%huge diff --git a/ccpp/data/CCPP_typedefs.meta b/ccpp/data/CCPP_typedefs.meta index 3ecb69be7..428970f2d 100644 --- a/ccpp/data/CCPP_typedefs.meta +++ b/ccpp/data/CCPP_typedefs.meta @@ -890,6 +890,12 @@ units = flag dimensions = (horizontal_loop_extent) type = logical +[flag_lakefreeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical [ffmm_water] standard_name = Monin_Obukhov_similarity_function_for_momentum_over_water long_name = Monin-Obukhov similarity function for momentum over water diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 42b1d1d66..f7f6d0caf 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -4005,12 +4005,12 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'snodi' - ExtDiag(idx)%desc = 'water equivalent snow depth over ice' + ExtDiag(idx)%desc = 'snow depth over ice' ExtDiag(idx)%unit = 'mm' ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%weasdi(:) + ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%snodi(:) enddo idx = idx + 1 diff --git a/ccpp/physics b/ccpp/physics index ed7e015b4..0cdfc9d74 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ed7e015b483a14fc7ae9bf9d0f0cc3d26c517f7e +Subproject commit 0cdfc9d7465358debb4de292861fef970b44874a From bba399053d3939241938f19ee598895eea54fd65 Mon Sep 17 00:00:00 2001 From: haiqinli <38666296+haiqinli@users.noreply.github.com> Date: Wed, 27 Dec 2023 14:10:22 -0700 Subject: [PATCH 43/48] Smoke/Dust updates for RRFS code freeze (#728) * "update smoke/dust for RRFS code freeze" * "point to the chem3d dimension update in GF for hercules/gnu" --- ccpp/data/GFS_typedefs.F90 | 75 +++++++++++++++++++------- ccpp/data/GFS_typedefs.meta | 96 ++++++++++++++++++++++++++++----- ccpp/driver/GFS_diagnostics.F90 | 72 ++++++++++++++----------- ccpp/physics | 2 +- io/fv3atm_restart_io.F90 | 4 +- io/fv3atm_rrfs_sd_io.F90 | 79 +++++++++++++++++++++------ 6 files changed, 246 insertions(+), 82 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 17d6ee4a0..5a8368a40 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -253,7 +253,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: hprime (:,:) => null() !< orographic metrics real (kind=kind_phys), pointer :: dust12m_in (:,:,:) => null() !< fengsha dust input real (kind=kind_phys), pointer :: emi_in (:,:) => null() !< anthropogenic background input - real (kind=kind_phys), pointer :: smoke_RRFS(:,:,:) => null() !< RRFS fire input + real (kind=kind_phys), pointer :: smoke_RRFS(:,:,:) => null() !< RRFS fire input hourly + real (kind=kind_phys), pointer :: smoke2d_RRFS(:,:) => null() !< RRFS fire input daily real (kind=kind_phys), pointer :: z0base (:) => null() !< background or baseline surface roughness length in m real (kind=kind_phys), pointer :: semisbase(:) => null() !< background surface emissivity real (kind=kind_phys), pointer :: sfalb_lnd (:) => null() !< surface albedo over land for LSM @@ -456,10 +457,9 @@ module GFS_typedefs real (kind=kind_phys), pointer :: emseas (:) => null() !< instantaneous sea salt emission real (kind=kind_phys), pointer :: emanoc (:) => null() !< instantaneous anthro. oc emission - !--- Smoke. These 3 arrays are hourly, so their dimension is imx24 (output is hourly) - real (kind=kind_phys), pointer :: ebb_smoke_hr(:) => null() !< hourly smoke emission - real (kind=kind_phys), pointer :: frp_hr (:) => null() !< hourly FRP - real (kind=kind_phys), pointer :: frp_std_hr (:) => null() !< hourly std. FRP + !--- Smoke. These 2 arrays are input smoke emission and frp + real (kind=kind_phys), pointer :: ebb_smoke_in(:) => null() !< input smoke emission + real (kind=kind_phys), pointer :: frp_input (:) => null() !< input FRP !--- For fire diurnal cycle real (kind=kind_phys), pointer :: fhist (:) => null() !< instantaneous fire coef_bb @@ -614,7 +614,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: nifa2d (:) => null() !< instantaneous ice-friendly sfc aerosol source !--- For fire diurnal cycle - real (kind=kind_phys), pointer :: ebu_smoke (:,:) => null() !< 3D ebu array + real (kind=kind_phys), pointer :: ebu_smoke (:,:) => null() !< 3D ebu array !--- For smoke and dust optical extinction real (kind=kind_phys), pointer :: smoke_ext (:,:) => null() !< 3D aod array @@ -623,12 +623,19 @@ module GFS_typedefs !--- For MYNN PBL transport of smoke and dust real (kind=kind_phys), pointer :: chem3d (:,:,:) => null() !< 3D aod array real (kind=kind_phys), pointer :: ddvel (:,: ) => null() !< 2D dry deposition velocity + !--- For convective wet removal of smoke and dust + real (kind=kind_phys), pointer :: wetdpc_flux (:,:) => null() !< 2D wet deposition array + !--- For large-scale wet removal of smoke and dust + real (kind=kind_phys), pointer :: wetdpr_flux (:,:) => null() !< 2D wet deposition array + !--- For dry deposition of smoke and dust + real (kind=kind_phys), pointer :: drydep_flux (:,:) => null() !< 2D dry deposition flux of smoke !--- Fire plume rise diagnostics - real (kind=kind_phys), pointer :: min_fplume (:) => null() !< minimum plume rise level - real (kind=kind_phys), pointer :: max_fplume (:) => null() !< maximum plume rise level + real (kind=kind_phys), pointer :: min_fplume (:) => null() !< minimum plume rise level + real (kind=kind_phys), pointer :: max_fplume (:) => null() !< maximum plume rise level !--- hourly fire potential index - real (kind=kind_phys), pointer :: rrfs_hwp (:) => null() !< hourly fire potential index + real (kind=kind_phys), pointer :: rrfs_hwp (:) => null() !< hourly fire potential index + real (kind=kind_phys), pointer :: rrfs_hwp_ave (:) => null() !< *Average* hourly fire potential index !--- instantaneous quantities for chemistry coupling real (kind=kind_phys), pointer :: ushfsfci(:) => null() !< instantaneous upward sensible heat flux (w/m**2) @@ -1448,8 +1455,8 @@ module GFS_typedefs integer :: ntsmoke !< tracer index for smoke integer :: ntdust !< tracer index for dust integer :: ntcoarsepm !< tracer index for coarse PM - integer :: nchem = 3 !< number of prognostic chemical species (vertically mixied) - integer :: ndvel = 3 !< number of prognostic chemical species (which are deposited, usually =nchem) + integer :: nchem !< number of prognostic chemical species (vertically mixied) + integer :: ndvel !< number of prognostic chemical species (which are deposited, usually =nchem) integer :: ntchm !< number of prognostic chemical tracers (advected) integer :: ntchs !< tracer index for first prognostic chemical tracer integer :: ntche !< tracer index for last prognostic chemical tracer @@ -1510,10 +1517,13 @@ module GFS_typedefs real(kind=kind_phys) :: dust_alpha !< alpha parameter for fengsha dust scheme real(kind=kind_phys) :: dust_gamma !< gamma parameter for fengsha dust scheme real(kind=kind_phys) :: wetdep_ls_alpha !< alpha parameter for wet deposition + integer :: ebb_dcycle !< 1:retro; 2:forecast of fire emission integer :: seas_opt integer :: dust_opt integer :: drydep_opt integer :: coarsepm_settling + integer :: plume_wind_eff + logical :: extended_sd_diags integer :: wetdep_ls_opt logical :: do_plumerise integer :: addsmoke_flag @@ -1522,9 +1532,11 @@ module GFS_typedefs logical :: aero_ind_fdb ! WFA/IFA indirect logical :: aero_dir_fdb ! smoke/dust direct logical :: rrfs_smoke_debug + logical :: do_smoke_transport logical :: mix_chem logical :: enh_mix real(kind=kind_phys) :: smoke_dir_fdb_coef(7) !< smoke & dust direct feedbck coefficents + real(kind=kind_phys) :: smoke_conv_wet_coef(3) !< smoke & dust convective wet removal coefficents !--- debug flags logical :: debug @@ -2309,7 +2321,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%weasdi (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) allocate (Sfcprop%dust12m_in (IM,12,5)) - allocate (Sfcprop%smoke_RRFS(IM,24,3)) + allocate (Sfcprop%smoke_RRFS(IM,24,2)) + allocate (Sfcprop%smoke2d_RRFS(IM,4)) allocate (Sfcprop%emi_in (IM,1)) allocate(Sfcprop%albdirvis_lnd (IM)) allocate(Sfcprop%albdirnir_lnd (IM)) @@ -2367,6 +2380,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%dust12m_in= clear_val Sfcprop%emi_in = clear_val Sfcprop%smoke_RRFS= clear_val + Sfcprop%smoke2d_RRFS= clear_val Sfcprop%albdirvis_lnd = clear_val Sfcprop%albdirnir_lnd = clear_val Sfcprop%albdifvis_lnd = clear_val @@ -2790,9 +2804,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%emdust (IM)) allocate (Sfcprop%emseas (IM)) allocate (Sfcprop%emanoc (IM)) - allocate (Sfcprop%ebb_smoke_hr (IM)) - allocate (Sfcprop%frp_hr (IM)) - allocate (Sfcprop%frp_std_hr(IM)) + allocate (Sfcprop%ebb_smoke_in (IM)) + allocate (Sfcprop%frp_input (IM)) allocate (Sfcprop%fhist (IM)) allocate (Sfcprop%coef_bb_dc(IM)) allocate (Sfcprop%fire_in (IM,Model%fire_aux_data_levels)) @@ -2801,9 +2814,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%emdust = clear_val Sfcprop%emseas = clear_val Sfcprop%emanoc = clear_val - Sfcprop%ebb_smoke_hr = clear_val - Sfcprop%frp_hr = clear_val - Sfcprop%frp_std_hr = clear_val + Sfcprop%ebb_smoke_in = clear_val + Sfcprop%frp_input = clear_val Sfcprop%fhist = 1. Sfcprop%coef_bb_dc = clear_val Sfcprop%fire_in = clear_val @@ -3149,17 +3161,25 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%dust_ext (IM,Model%levs)) allocate (Coupling%chem3d (IM,Model%levs,Model%nchem)) allocate (Coupling%ddvel (IM,Model%ndvel)) + allocate (Coupling%wetdpc_flux(IM,Model%nchem)) + allocate (Coupling%wetdpr_flux(IM,Model%nchem)) + allocate (Coupling%drydep_flux(IM,Model%ndvel)) allocate (Coupling%min_fplume(IM)) allocate (Coupling%max_fplume(IM)) allocate (Coupling%rrfs_hwp (IM)) + allocate (Coupling%rrfs_hwp_ave (IM)) Coupling%ebu_smoke = clear_val Coupling%smoke_ext = clear_val Coupling%dust_ext = clear_val Coupling%chem3d = clear_val Coupling%ddvel = clear_val + Coupling%wetdpc_flux = clear_val + Coupling%wetdpr_flux = clear_val + Coupling%drydep_flux = clear_val Coupling%min_fplume = clear_val Coupling%max_fplume = clear_val Coupling%rrfs_hwp = clear_val + Coupling%rrfs_hwp_ave = clear_val endif if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_c3) then @@ -3847,10 +3867,13 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: dust_gamma = 0. real(kind=kind_phys) :: wetdep_ls_alpha = 0. integer :: dust_moist_opt = 1 ! fecan :1 else shao + integer :: ebb_dcycle = 1 ! 1:retro; 2:forecast integer :: seas_opt = 2 integer :: dust_opt = 5 integer :: drydep_opt = 1 integer :: coarsepm_settling = 1 + integer :: plume_wind_eff = 1 + logical :: extended_sd_diags = .false. integer :: wetdep_ls_opt = 1 logical :: do_plumerise = .false. integer :: addsmoke_flag = 1 @@ -3859,9 +3882,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: aero_ind_fdb = .false. ! RRFS-sd wfa/ifa emission logical :: aero_dir_fdb = .false. ! RRFS-sd smoke/dust radiation feedback logical :: rrfs_smoke_debug = .false. ! RRFS-sd plumerise debug + logical :: do_smoke_transport = .true.! RRFS-sd convective transport of smoke/dust logical :: mix_chem = .false. ! tracer mixing option by MYNN PBL logical :: enh_mix = .false. ! enhance vertmix option by MYNN PBL real(kind=kind_phys) :: smoke_dir_fdb_coef(7) =(/ 0.33, 0.67, 0.02, 0.13, 0.85, 0.05, 0.95 /) !< smoke & dust direct feedbck coefficents + real(kind=kind_phys) :: smoke_conv_wet_coef(3) =(/ 0.50, 0.50, 0.50 /) !< smoke & dust convective wet removal coefficents !-- Lightning threat index logical :: lightning_threat = .false. @@ -4020,9 +4045,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & dust_drylimit_factor, dust_moist_correction, dust_moist_opt, & dust_alpha, dust_gamma, wetdep_ls_alpha, & seas_opt, dust_opt, drydep_opt, coarsepm_settling, & + plume_wind_eff,ebb_dcycle, extended_sd_diags, & wetdep_ls_opt, smoke_forecast, aero_ind_fdb, aero_dir_fdb, & rrfs_smoke_debug, do_plumerise, plumerisefire_frq, & addsmoke_flag, enh_mix, mix_chem, smoke_dir_fdb_coef, & + do_smoke_transport,smoke_conv_wet_coef, & !--- C3/GF closures ichoice,ichoicem,ichoice_s, & !--- (DFI) time ranges with radar-prescribed microphysics tendencies @@ -4246,10 +4273,13 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%dust_alpha = dust_alpha Model%dust_gamma = dust_gamma Model%wetdep_ls_alpha = wetdep_ls_alpha + Model%ebb_dcycle = ebb_dcycle Model%seas_opt = seas_opt Model%dust_opt = dust_opt Model%drydep_opt = drydep_opt Model%coarsepm_settling = coarsepm_settling + Model%plume_wind_eff = plume_wind_eff + Model%extended_sd_diags = extended_sd_diags Model%wetdep_ls_opt = wetdep_ls_opt Model%do_plumerise = do_plumerise Model%plumerisefire_frq = plumerisefire_frq @@ -4258,11 +4288,13 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%aero_ind_fdb = aero_ind_fdb Model%aero_dir_fdb = aero_dir_fdb Model%rrfs_smoke_debug = rrfs_smoke_debug + Model%do_smoke_transport= do_smoke_transport Model%mix_chem = mix_chem Model%enh_mix = enh_mix Model%smoke_dir_fdb_coef = smoke_dir_fdb_coef + Model%smoke_conv_wet_coef = smoke_conv_wet_coef - Model%fire_aux_data_levels = 10 + Model%fire_aux_data_levels = 1 Model%ichoice_s = ichoice_s Model%ichoicem = ichoicem @@ -6375,10 +6407,13 @@ subroutine control_print(Model) print *, 'dust_alpha : ',Model%dust_alpha print *, 'dust_gamma : ',Model%dust_gamma print *, 'wetdep_ls_alpha : ',Model%wetdep_ls_alpha + print *, 'ebb_dcycle : ',Model%ebb_dcycle print *, 'seas_opt : ',Model%seas_opt print *, 'dust_opt : ',Model%dust_opt print *, 'drydep_opt : ',Model%drydep_opt print *, 'coarsepm_settling: ',Model%coarsepm_settling + print *, 'plume_wind_eff : ',Model%plume_wind_eff + print *, 'extended_sd_diags: ',Model%extended_sd_diags print *, 'wetdep_ls_opt : ',Model%wetdep_ls_opt print *, 'do_plumerise : ',Model%do_plumerise print *, 'plumerisefire_frq: ',Model%plumerisefire_frq @@ -6387,9 +6422,11 @@ subroutine control_print(Model) print *, 'aero_ind_fdb : ',Model%aero_ind_fdb print *, 'aero_dir_fdb : ',Model%aero_dir_fdb print *, 'rrfs_smoke_debug : ',Model%rrfs_smoke_debug + print *, 'do_smoke_transport : ',Model%do_smoke_transport print *, 'mix_chem : ',Model%mix_chem print *, 'enh_mix : ',Model%enh_mix print *, 'smoke_dir_fdb_coef : ',Model%smoke_dir_fdb_coef + print *, 'smoke_conv_wet_coef: ',Model%smoke_conv_wet_coef endif print *, ' ' print *, ' lsidea : ', Model%lsidea diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index deea0ad25..0c07dd093 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -921,7 +921,7 @@ standard_name = fengsha_dust12m_input long_name = fengsha dust input units = various - dimensions = (horizontal_dimension,12,5) + dimensions = (horizontal_loop_extent,12,5) type = real kind = kind_phys active = (do_smoke_coupling) @@ -929,7 +929,7 @@ standard_name = anthropogenic_background_input long_name = anthropogenic background input units = various - dimensions = (horizontal_dimension,1) + dimensions = (horizontal_loop_extent,1) type = real kind = kind_phys active = (do_smoke_coupling) @@ -937,7 +937,15 @@ standard_name = emission_smoke_RRFS long_name = emission fire RRFS units = various - dimensions = (horizontal_dimension,24,3) + dimensions = (horizontal_loop_extent,24,2) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[smoke2d_RRFS] + standard_name = emission_smoke_prvd_RRFS + long_name = emission fire RRFS daily + units = various + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys active = (do_smoke_coupling) @@ -2272,7 +2280,7 @@ type = real kind = kind_phys active = (do_smoke_coupling) -[ebb_smoke_hr] +[ebb_smoke_in] standard_name = surface_smoke_emission long_name = emission of surface smoke units = ug m-2 s-1 @@ -2280,7 +2288,7 @@ type = real kind = kind_phys active = (do_smoke_coupling) -[frp_hr] +[frp_input] standard_name = frp_hourly long_name = hourly fire radiative power units = MW @@ -2288,14 +2296,6 @@ type = real kind = kind_phys active = (do_smoke_coupling) -[frp_std_hr] - standard_name = frp_std_hourly - long_name = hourly stdandard deviation of fire radiative power - units = MW - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_smoke_coupling) [fhist] standard_name = fire_hist long_name = coefficient to scale the fire activity depending on the fire duration @@ -3012,6 +3012,30 @@ type = real kind = kind_phys active = (do_smoke_coupling) +[wetdpc_flux] + standard_name = conv_wet_deposition_smoke_dust + long_name = convective wet removal of smoke and dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[wetdpr_flux] + standard_name = mp_wet_deposition_smoke_dust + long_name = large scale wet deposition of smoke and dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + active = (do_smoke_coupling) +[drydep_flux] + standard_name = dry_deposition_flux + long_name = rrfs dry deposition flux + units = ug m-2 + dimensions = (horizontal_loop_extent,number_of_chemical_species_deposited) + type = real + kind = kind_phys + active = (do_smoke_coupling) [min_fplume] standard_name = minimum_fire_plume_sigma_pressure_level long_name = minimum model level of fire plumerise @@ -3036,6 +3060,14 @@ type = real kind = kind_phys active = (do_smoke_coupling) +[rrfs_hwp_ave] + standard_name = hourly_wildfire_potential_average + long_name = rrfs hourly fire weather potential average + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (do_smoke_coupling) [ushfsfci] standard_name = surface_upward_sensible_heat_flux_for_chemistry_coupling long_name = instantaneous upward sensible heat flux for chemistry coupling @@ -6521,6 +6553,14 @@ type = real kind = kind_phys active = (do_smoke_coupling) +[smoke_conv_wet_coef] + standard_name = smoke_dust_conv_wet_coef + long_name = smoke dust convetive wet scavanging coefficents + units = none + dimensions = (3) + type = real + kind = kind_phys + active = (do_smoke_coupling) [dust_moist_correction] standard_name = dust_moist_correction_fengsha_dust_scheme long_name = moisture correction term for fengsha dust emission @@ -6568,6 +6608,13 @@ type = real kind = kind_phys active = (do_smoke_coupling) +[ebb_dcycle] + standard_name = control_for_diurnal_cycle_of_biomass_burning_emissions + long_name = rrfs smoke diurnal cycle option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) [seas_opt] standard_name = control_for_smoke_sea_salt long_name = rrfs smoke sea salt emission option @@ -6590,12 +6637,26 @@ type = integer active = (do_smoke_coupling) [coarsepm_settling] - standard_name = control_for_smoke_coarsepm_settling + standard_name = control_for_smoke_pm_settling long_name = rrfs smoke coarsepm settling option units = index dimensions = () type = integer active = (do_smoke_coupling) +[plume_wind_eff] + standard_name = option_for_wind_effects_on_smoke_plumerise + long_name = wind effect plumerise option + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) +[extended_sd_diags] + standard_name = flag_for_extended_smoke_dust_diagnostics + long_name = flag for extended smoke dust diagnostics + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) [wetdep_ls_opt] standard_name = control_for_smoke_wet_deposition long_name = rrfs smoke large scale wet deposition option @@ -6652,6 +6713,13 @@ dimensions = () type = logical active = (do_smoke_coupling) +[do_smoke_transport] + standard_name = do_smoke_conv_transport + long_name = flag for rrfs smoke convective transport + units = flag + dimensions = () + type = logical + active = (do_smoke_coupling) [ncnvcld3d] standard_name = number_of_convective_cloud_variables_in_xyz_dimensioned_restart_array long_name = number of convective 3d clouds fields diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index f7f6d0caf..3bbd300d5 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -4658,82 +4658,92 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%rrfs_hwp enddo - idx = idx + 1 ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'ebb_smoke_hr' - ExtDiag(idx)%desc = 'hourly smoke emission' - ExtDiag(idx)%unit = 'ug m-2 s-1' + ExtDiag(idx)%name = 'HWP_ave' + ExtDiag(idx)%desc = 'averaged fire weather potential' + ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%ebb_smoke_hr + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%rrfs_hwp_ave enddo idx = idx + 1 ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'fhist' - ExtDiag(idx)%desc = 'coefficient to scale the fire activity depending on the fire duration' + ExtDiag(idx)%name = 'wetdpc_smoke' + ExtDiag(idx)%desc = 'convective wet deposition smoke' ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%ebb_smoke_hr + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%wetdpc_flux(:,1) enddo idx = idx + 1 ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'frp_hr' - ExtDiag(idx)%desc = 'hourly frp' - ExtDiag(idx)%unit = 'mw' + ExtDiag(idx)%name = 'wetdpc_dust' + ExtDiag(idx)%desc = 'convective wet deposition dust' + ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%frp_hr + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%wetdpc_flux(:,2) enddo idx = idx + 1 ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'frp_std_hr' - ExtDiag(idx)%desc = 'hourly std frp' - ExtDiag(idx)%unit = 'mw' + ExtDiag(idx)%name = 'wetdpc_coarsepm' + ExtDiag(idx)%desc = 'convective wet deposition coarsepm' + ExtDiag(idx)%unit = ' ' ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%frp_std_hr + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%wetdpc_flux(:,3) enddo idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'ebu_smoke' - ExtDiag(idx)%desc = 'smoke emission' - ExtDiag(idx)%unit = 'ug/m2/s' - ExtDiag(idx)%mod_name = 'gfs_phys' + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'ebb_smoke_in' + ExtDiag(idx)%desc = 'input smoke emission' + ExtDiag(idx)%unit = 'ug m-2 s-1' + ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%ebu_smoke(:,:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%ebb_smoke_in enddo idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'smoke_ext' - ExtDiag(idx)%desc = 'smoke extinction at 550nm' + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'fhist' + ExtDiag(idx)%desc = 'coefficient to scale the fire activity depending on the fire duration' ExtDiag(idx)%unit = ' ' - ExtDiag(idx)%mod_name = 'gfs_phys' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%fhist + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'frp_input' + ExtDiag(idx)%desc = 'input frp' + ExtDiag(idx)%unit = 'mw' + ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%smoke_ext(:,:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%frp_input enddo idx = idx + 1 ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'dust_ext' - ExtDiag(idx)%desc = 'dust extinction at 550nm' - ExtDiag(idx)%unit = ' ' + ExtDiag(idx)%name = 'ebu_smoke' + ExtDiag(idx)%desc = 'smoke emission' + ExtDiag(idx)%unit = 'ug/m2/s' ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%dust_ext(:,:) + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%ebu_smoke(:,:) enddo idx = idx + 1 diff --git a/ccpp/physics b/ccpp/physics index 0cdfc9d74..df9e1ad0f 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0cdfc9d7465358debb4de292861fef970b44874a +Subproject commit df9e1ad0f9dcafe58eb5ccd505046f965a6042bc diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index 39d2131b9..d32be0586 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -593,7 +593,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file'//trim(infile) ) ! Register axes and variables, allocate memory - call rrfs_sd_emis%register_fire(rrfssd_restart, Atm_block) + call rrfs_sd_emis%register_fire(Model, rrfssd_restart, Atm_block) !--- read new GSL created rrfssd restart/data call mpp_error(NOTE,'reading rrfssd information from INPUT/SMOKE_RRFS_data.nc') @@ -601,7 +601,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta call close_file(rrfssd_restart) !--- Copy to Sfcprop and free temporary arrays: - call rrfs_sd_emis%copy_fire(Sfcprop, Atm_block) + call rrfs_sd_emis%copy_fire(Model, Sfcprop, Atm_block) endif if_smoke ! RRFS_SD diff --git a/io/fv3atm_rrfs_sd_io.F90 b/io/fv3atm_rrfs_sd_io.F90 index 780153208..93e2981c7 100644 --- a/io/fv3atm_rrfs_sd_io.F90 +++ b/io/fv3atm_rrfs_sd_io.F90 @@ -62,15 +62,18 @@ module fv3atm_rrfs_sd_io type rrfs_sd_emissions_type integer, private :: nvar_dust12m = 5 integer, private :: nvar_emi = 1 - integer, private :: nvar_fire = 3 + integer, private :: nvar_fire = 2 + integer, private :: nvar_fire2d = 4 character(len=32), pointer, dimension(:), private :: dust12m_name => null() character(len=32), pointer, dimension(:), private :: emi_name => null() character(len=32), pointer, dimension(:), private :: fire_name => null() + character(len=32), pointer, dimension(:), private :: fire_name2d => null() real(kind=kind_phys), pointer, dimension(:,:,:,:), private :: dust12m_var => null() real(kind=kind_phys), pointer, dimension(:,:,:,:), private :: emi_var => null() real(kind=kind_phys), pointer, dimension(:,:,:,:), private :: fire_var => null() + real(kind=kind_phys), pointer, dimension(:,:,: ), private :: fire_var2d => null() contains @@ -520,70 +523,116 @@ end subroutine rrfs_sd_emissions_copy_emi ! -------------------------------------------------------------------- !>@ Allocates temporary arrays and registers variables for reading the fire data file. - subroutine rrfs_sd_emissions_register_fire(data, restart, Atm_block) + subroutine rrfs_sd_emissions_register_fire(data, Model, restart, Atm_block) implicit none class(rrfs_sd_emissions_type) :: data + type(GFS_control_type), intent(in) :: Model type(FmsNetcdfDomainFile_t) :: restart type(block_control_type), intent(in) :: Atm_block + real(kind=kind_phys), pointer, dimension(:,:) :: var_p2 => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() integer :: num, nx, ny + integer :: ebb_dcycle + + ebb_dcycle=Model%ebb_dcycle if(associated(data%fire_name)) then deallocate(data%fire_name) nullify(data%fire_name) endif + if(associated(data%fire_name2d)) then + deallocate(data%fire_name2d) + nullify(data%fire_name2d) + endif + if(associated(data%fire_var)) then deallocate(data%fire_var) nullify(data%fire_var) endif + if(associated(data%fire_var2d)) then + deallocate(data%fire_var2d) + nullify(data%fire_var2d) + endif + !--- allocate the various containers needed for rrfssd fire data call get_nx_ny_from_atm(Atm_block, nx, ny) allocate(data%fire_name(data%nvar_fire)) + allocate(data%fire_name2d(data%nvar_fire2d)) allocate(data%fire_var(nx,ny,24,data%nvar_fire)) + allocate(data%fire_var2d(nx,ny,data%nvar_fire2d)) - data%fire_name(1) = 'ebb_smoke_hr' - data%fire_name(2) = 'frp_avg_hr' - data%fire_name(3) = 'frp_std_hr' + data%fire_name(1) = 'ebb_smoke_hr' ! 2d x 24 hours + data%fire_name(2) = 'frp_avg_hr' ! 2d x 24 hours + + ! For the operational system + data%fire_name2d(1) = 'ebb_rate' ! 2d + data%fire_name2d(2) = 'frp_davg' + data%fire_name2d(3) = 'fire_end_hr' + data%fire_name2d(4) = 'hwp_davg' !--- register axis call register_axis(restart, 'lon', 'X') call register_axis(restart, 'lat', 'Y') - call register_axis(restart, 't', 24) - !--- register the 3D fields - do num = 1,data%nvar_fire + if (ebb_dcycle==1) then ! -- retro mode + !--- register the 3D fields + call register_axis(restart, 't', 24) + do num = 1,data%nvar_fire var3_p2 => data%fire_var(:,:,:,num) call register_restart_field(restart, data%fire_name(num), var3_p2, & dimensions=(/'t ', 'lat', 'lon'/), is_optional=.true.) - enddo + enddo + elseif (ebb_dcycle==2) then ! -- forecast mode + !--- register the 2D fields + call register_axis(restart, 't', 1) + do num = 1,data%nvar_fire2d + var_p2 => data%fire_var2d(:,:,num) + call register_restart_field(restart, data%fire_name2d(num), var_p2, & + dimensions=(/'lat', 'lon'/), is_optional=.true.) + enddo + else + ! -- user define their own fire emission + endif end subroutine rrfs_sd_emissions_register_fire ! -------------------------------------------------------------------- !>@ Called after register_fire() to copy data from internal arrays to the model grid and deallocate arrays - subroutine rrfs_sd_emissions_copy_fire(data, Sfcprop, Atm_block) + subroutine rrfs_sd_emissions_copy_fire(data, Model, Sfcprop, Atm_block) implicit none class(rrfs_sd_emissions_type) :: data + type(GFS_control_type), intent(in) :: Model type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) type(block_control_type), intent(in) :: Atm_block integer :: nb, ix, k, i, j + integer :: ebb_dcycle + + ebb_dcycle=Model%ebb_dcycle !$omp parallel do default(shared) private(i, j, nb, ix, k) do nb = 1, Atm_block%nblks - !--- 3D variables do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - Atm_block%isc + 1 j = Atm_block%index(nb)%jj(ix) - Atm_block%jsc + 1 - !--- assign hprime(1:10) and hprime(15:24) with new oro stat data - do k = 1, 24 + if (ebb_dcycle==1) then ! -- retro mode + !--- 3D variables + do k = 1, 24 Sfcprop(nb)%smoke_RRFS(ix,k,1) = data%fire_var(i,j,k,1) Sfcprop(nb)%smoke_RRFS(ix,k,2) = data%fire_var(i,j,k,2) - Sfcprop(nb)%smoke_RRFS(ix,k,3) = data%fire_var(i,j,k,3) - enddo + enddo + elseif (ebb_dcycle==2) then ! -- forecast mode + !--- 2D variables + Sfcprop(nb)%smoke2d_RRFS(ix,1) = data%fire_var2d(i,j,1) + Sfcprop(nb)%smoke2d_RRFS(ix,2) = data%fire_var2d(i,j,2) + Sfcprop(nb)%smoke2d_RRFS(ix,3) = data%fire_var2d(i,j,3) + Sfcprop(nb)%smoke2d_RRFS(ix,4) = data%fire_var2d(i,j,4) + else + ! -- user define their own fire emission + endif enddo enddo end subroutine rrfs_sd_emissions_copy_fire From 997907fe89b18fcc53405cf6722942810bf09eed Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 3 Jan 2024 14:19:16 -0700 Subject: [PATCH 44/48] Reorganization of ccpp-physics repository (#733) * Metafile cleanup * Move rte-rrtmgp submodule * More metadata fixes --- ccpp/config/ccpp_prebuild_config.py | 268 +++++++++--------- ccpp/data/CCPP_typedefs.meta | 7 +- ccpp/data/GFS_typedefs.meta | 8 +- ccpp/physics | 2 +- ...suite_FV3_GFS_v15_thompson_mynn_lam3km.xml | 1 - ccpp/suites/suite_FV3_GFS_v15p2.xml | 1 - ccpp/suites/suite_FV3_GFS_v16.xml | 1 - ccpp/suites/suite_FV3_GFS_v16_csawmg.xml | 1 - ccpp/suites/suite_FV3_GFS_v16_flake.xml | 1 - ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml | 1 - ccpp/suites/suite_FV3_GFS_v16_ras.xml | 1 - ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml | 1 - .../suite_FV3_GFS_v17_coupled_p8_c3.xml | 1 - .../suite_FV3_GFS_v17_coupled_p8_sfcocn.xml | 1 - .../suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml | 1 - ccpp/suites/suite_FV3_GFS_v17_p8.xml | 1 - ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml | 1 - ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml | 1 - ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml | 1 - .../suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml | 1 - .../suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml | 1 - ...uite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml | 1 - ccpp/suites/suite_FV3_HRRR.xml | 1 - ccpp/suites/suite_FV3_HRRR_c3.xml | 1 - ccpp/suites/suite_FV3_HRRR_gf.xml | 1 - ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml | 1 - ccpp/suites/suite_FV3_RAP.xml | 1 - ccpp/suites/suite_FV3_RAP_cires_ugwp.xml | 1 - ccpp/suites/suite_FV3_RAP_clm_lake.xml | 1 - ccpp/suites/suite_FV3_RAP_flake.xml | 1 - ccpp/suites/suite_FV3_RAP_noah.xml | 1 - .../suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml | 1 - ccpp/suites/suite_FV3_RAP_sfcdiff.xml | 1 - ccpp/suites/suite_FV3_RAP_unified_ugwp.xml | 1 - ccpp/suites/suite_FV3_RRFS_v1beta.xml | 1 - ccpp/suites/suite_FV3_RRFS_v1nssl.xml | 1 - ccpp/suites/suite_FV3_WoFS_v0.xml | 1 - ccpp/suites/suite_FV3_global_nest_v1.xml | 1 - ccpp/suites/suite_RRFSens_phy1.xml | 1 - ccpp/suites/suite_RRFSens_phy2.xml | 1 - ccpp/suites/suite_RRFSens_phy3.xml | 1 - ccpp/suites/suite_RRFSens_phy4.xml | 1 - ccpp/suites/suite_RRFSens_phy5.xml | 1 - 43 files changed, 140 insertions(+), 184 deletions(-) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index 268eb2166..1ed2c6245 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -16,12 +16,11 @@ VARIABLE_DEFINITION_FILES = [ # actual variable definition files 'framework/src/ccpp_types.F90', - 'physics/physics/machine.F', - 'physics/physics/radsw_param.f', - 'physics/physics/radlw_param.f', - 'physics/physics/h2o_def.f', - 'physics/physics/radiation_surface.f', - 'physics/physics/module_ozphys.F90', + 'physics/physics/hooks/machine.F', + 'physics/physics/Radiation/RRTMG/radsw_param.f', + 'physics/physics/Radiation/RRTMG/radlw_param.f', + 'physics/physics/photochem/h2o_def.f', + 'physics/physics/photochem/module_ozphys.F90', 'data/CCPP_typedefs.F90', 'data/GFS_typedefs.F90', 'data/CCPP_data.F90', @@ -74,138 +73,135 @@ # Relative path to source (from where ccpp_prebuild.py is called) : [ list of physics sets in which scheme may be called ]; # current restrictions are that each scheme can only belong to one physics set, and all schemes within one group in the # suite definition file have to belong to the same physics set - 'physics/physics/GFS_DCNV_generic_pre.F90', - 'physics/physics/GFS_DCNV_generic_post.F90', - 'physics/physics/GFS_GWD_generic_pre.F90', - 'physics/physics/GFS_GWD_generic_post.F90', - 'physics/physics/GFS_MP_generic_pre.F90', - 'physics/physics/GFS_MP_generic_post.F90', - 'physics/physics/GFS_PBL_generic_pre.F90', - 'physics/physics/GFS_PBL_generic_post.F90', - 'physics/physics/GFS_SCNV_generic_pre.F90', - 'physics/physics/GFS_SCNV_generic_post.F90', - 'physics/physics/GFS_debug.F90', - 'physics/physics/GFS_phys_time_vary.fv3.F90', - 'physics/physics/GFS_rad_time_vary.fv3.F90', - 'physics/physics/GFS_radiation_surface.F90', - 'physics/physics/GFS_rrtmg_post.F90', - 'physics/physics/GFS_rrtmg_pre.F90', - 'physics/physics/GFS_rrtmg_setup.F90', - 'physics/physics/GFS_stochastics.F90', - 'physics/physics/GFS_suite_interstitial_rad_reset.F90', - 'physics/physics/GFS_suite_interstitial_phys_reset.F90', - 'physics/physics/GFS_suite_interstitial_1.F90', - 'physics/physics/GFS_suite_interstitial_2.F90', - 'physics/physics/GFS_suite_stateout_reset.F90', - 'physics/physics/GFS_suite_stateout_update.F90', - 'physics/physics/GFS_suite_interstitial_3.F90', - 'physics/physics/GFS_suite_interstitial_4.F90', - 'physics/physics/GFS_suite_interstitial_5.F90', - 'physics/physics/GFS_surface_generic_pre.F90', - 'physics/physics/GFS_surface_generic_post.F90', - 'physics/physics/GFS_surface_composites_pre.F90', - 'physics/physics/GFS_surface_composites_inter.F90', - 'physics/physics/GFS_surface_composites_post.F90', - 'physics/physics/GFS_surface_loop_control_part1.F90', - 'physics/physics/GFS_surface_loop_control_part2.F90', - 'physics/physics/GFS_time_vary_pre.fv3.F90', - 'physics/physics/GFS_physics_post.F90', - 'physics/physics/cires_ugwp.F90', - 'physics/physics/cires_ugwp_post.F90', - 'physics/physics/unified_ugwp.F90', - 'physics/physics/unified_ugwp_post.F90', - 'physics/physics/ugwpv1_gsldrag.F90', - 'physics/physics/ugwpv1_gsldrag_post.F90', - 'physics/physics/cnvc90.f', - 'physics/physics/cs_conv_pre.F90', - 'physics/physics/cs_conv.F90', - 'physics/physics/cs_conv_post.F90', - 'physics/physics/cs_conv_aw_adj.F90', - 'physics/physics/cu_ntiedtke_pre.F90', - 'physics/physics/cu_ntiedtke.F90', - 'physics/physics/cu_ntiedtke_post.F90', - 'physics/physics/dcyc2t3.f', - 'physics/physics/drag_suite.F90', - 'physics/physics/shoc.F90', - 'physics/physics/get_prs_fv3.F90', - 'physics/physics/get_phi_fv3.F90', - 'physics/physics/gfdl_cloud_microphys.F90', - 'physics/physics/fv_sat_adj.F90', - 'physics/physics/gfdl_sfc_layer.F90', - 'physics/physics/zhaocarr_gscond.f', - 'physics/physics/gwdc_pre.f', - 'physics/physics/gwdc.f', - 'physics/physics/gwdc_post.f', - 'physics/physics/gwdps.f', - 'physics/physics/h2ophys.f', - 'physics/physics/samfdeepcnv.f', - 'physics/physics/samfshalcnv.f', - 'physics/physics/sascnvn.F', - 'physics/physics/shalcnv.F', - 'physics/physics/maximum_hourly_diagnostics.F90', - 'physics/physics/m_micro.F90', - 'physics/physics/m_micro_pre.F90', - 'physics/physics/m_micro_post.F90', - 'physics/physics/cu_gf_driver_pre.F90', - 'physics/physics/cu_gf_driver.F90', - 'physics/physics/cu_gf_driver_post.F90', - 'physics/physics/cu_c3_driver_pre.F90', - 'physics/physics/cu_c3_driver.F90', - 'physics/physics/cu_c3_driver_post.F90', - 'physics/physics/hedmf.f', - 'physics/physics/moninshoc.f', - 'physics/physics/satmedmfvdif.F', - 'physics/physics/satmedmfvdifq.F', - 'physics/physics/shinhongvdif.F90', - 'physics/physics/ysuvdif.F90', - 'physics/physics/mynnedmf_wrapper.F90', - 'physics/physics/mynnsfc_wrapper.F90', - 'physics/physics/sgscloud_radpre.F90', - 'physics/physics/sgscloud_radpost.F90', - 'physics/physics/myjsfc_wrapper.F90', - 'physics/physics/myjpbl_wrapper.F90', - 'physics/physics/mp_thompson_pre.F90', - 'physics/physics/mp_thompson.F90', - 'physics/physics/mp_thompson_post.F90', - 'physics/physics/mp_nssl.F90', - 'physics/physics/zhaocarr_precpd.f', - 'physics/physics/radlw_main.F90', - 'physics/physics/radsw_main.F90', - 'physics/physics/rascnv.F90', - 'physics/physics/rayleigh_damp.f', - 'physics/physics/rrtmg_lw_post.F90', - 'physics/physics/rrtmg_lw_pre.F90', - 'physics/physics/rrtmg_sw_post.F90', - 'physics/physics/rad_sw_pre.F90', - 'physics/physics/sfc_diag.f', - 'physics/physics/sfc_diag_post.F90', - 'physics/physics/lsm_ruc.F90', - 'physics/physics/sfc_cice.f', - 'physics/physics/sfc_diff.f', - 'physics/physics/lsm_noah.f', - 'physics/physics/noahmpdrv.F90', - 'physics/physics/flake_driver.F90', - 'physics/physics/clm_lake.f90', - 'physics/physics/sfc_nst_pre.f90', - 'physics/physics/sfc_nst.f90', - 'physics/physics/sfc_nst_post.f90', - 'physics/physics/sfc_ocean.F', - 'physics/physics/sfc_sice.f', - # HAFS FER_HIRES - 'physics/physics/mp_fer_hires.F90', - # SMOKE + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90', + 'physics/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.F90', + 'physics/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90', + 'physics/physics/CONV/Chikira_Sugiyama/cs_conv.F90', + 'physics/physics/CONV/Chikira_Sugiyama/cs_conv_post.F90', + 'physics/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90', + 'physics/physics/CONV/nTiedtke/cu_ntiedtke_pre.F90', + 'physics/physics/CONV/nTiedtke/cu_ntiedtke.F90', + 'physics/physics/CONV/nTiedtke/cu_ntiedtke_post.F90', + 'physics/physics/CONV/SAMF/samfdeepcnv.f', + 'physics/physics/CONV/SAMF/samfshalcnv.f', + 'physics/physics/CONV/SAS/sascnvn.F', + 'physics/physics/CONV/SAS/shalcnv.F', + 'physics/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90', + 'physics/physics/CONV/Grell_Freitas/cu_gf_driver.F90', + 'physics/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90', + 'physics/physics/CONV/C3/cu_c3_driver_pre.F90', + 'physics/physics/CONV/C3/cu_c3_driver.F90', + 'physics/physics/CONV/C3/cu_c3_driver_post.F90', + 'physics/physics/CONV/RAS/rascnv.F90', + 'physics/physics/GWD/cires_ugwp.F90', + 'physics/physics/GWD/cires_ugwp_post.F90', + 'physics/physics/GWD/unified_ugwp.F90', + 'physics/physics/GWD/unified_ugwp_post.F90', + 'physics/physics/GWD/ugwpv1_gsldrag.F90', + 'physics/physics/GWD/ugwpv1_gsldrag_post.F90', + 'physics/physics/GWD/drag_suite.F90', + 'physics/physics/GWD/gwdc_pre.f', + 'physics/physics/GWD/gwdc.f', + 'physics/physics/GWD/gwdc_post.f', + 'physics/physics/GWD/gwdps.f', + 'physics/physics/GWD/rayleigh_damp.f', + 'physics/physics/photochem/h2ophys.f', + 'physics/physics/photochem/module_ozphys.F90', + 'physics/physics/MP/Ferrier_Aligo/mp_fer_hires.F90', + 'physics/physics/MP/GFDL/gfdl_cloud_microphys.F90', + 'physics/physics/MP/GFDL/fv_sat_adj.F90', + 'physics/physics/MP/Morrison_Gettelman/m_micro.F90', + 'physics/physics/MP/Morrison_Gettelman/m_micro_pre.F90', + 'physics/physics/MP/Morrison_Gettelman/m_micro_post.F90', + 'physics/physics/MP/NSSL/mp_nssl.F90', + 'physics/physics/MP/Thompson/mp_thompson_pre.F90', + 'physics/physics/MP/Thompson/mp_thompson.F90', + 'physics/physics/MP/Thompson/mp_thompson_post.F90', + 'physics/physics/MP/Zhao_Carr/zhaocarr_gscond.f', + 'physics/physics/MP/Zhao_Carr/zhaocarr_precpd.f', + 'physics/physics/PBL/HEDMF/hedmf.f', + 'physics/physics/PBL/SHOC/moninshoc.f', + 'physics/physics/PBL/SHOC/shoc.F90', + 'physics/physics/PBL/MYJ/myjpbl_wrapper.F90', + 'physics/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90', + 'physics/physics/PBL/SATMEDMF/satmedmfvdif.F', + 'physics/physics/PBL/SATMEDMF/satmedmfvdifq.F', + 'physics/physics/PBL/YSU/ysuvdif.F90', + 'physics/physics/PBL/saYSU/shinhongvdif.F90', + 'physics/physics/Radiation/RRTMG/radsw_main.F90', + 'physics/physics/Radiation/RRTMG/radlw_main.F90', + 'physics/physics/Radiation/RRTMG/rrtmg_lw_post.F90', + 'physics/physics/Radiation/RRTMG/rrtmg_sw_post.F90', + 'physics/physics/Radiation/RRTMG/rad_sw_pre.F90', + 'physics/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90', + 'physics/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90', + 'physics/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90', + 'physics/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90', + 'physics/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90', + 'physics/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90', + 'physics/physics/SFC_Layer/UFS/sfc_diag.f', + 'physics/physics/SFC_Layer/UFS/sfc_diag_post.F90', + 'physics/physics/SFC_Layer/UFS/sfc_diff.f', + 'physics/physics/SFC_Layer/UFS/sfc_nst_pre.f90', + 'physics/physics/SFC_Layer/UFS/sfc_nst.f90', + 'physics/physics/SFC_Layer/UFS/sfc_nst_post.f90', + 'physics/physics/SFC_Models/Land/RUC/lsm_ruc.F90', + 'physics/physics/SFC_Models/SeaIce/CICE/sfc_cice.f', + 'physics/physics/SFC_Models/Land/Noah/lsm_noah.f', + 'physics/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90', + 'physics/physics/SFC_Models/Lake/Flake/flake_driver.F90', + 'physics/physics/SFC_Models/Lake/CLM/clm_lake.f90', + 'physics/physics/SFC_Models/Ocean/UFS/sfc_ocean.F', + 'physics/physics/SFC_Models/SeaIce/CICE/sfc_sice.f', 'physics/physics/smoke_dust/rrfs_smoke_wrapper.F90', 'physics/physics/smoke_dust/rrfs_smoke_postpbl.F90', - # RRTMGP - 'physics/physics/rrtmgp_aerosol_optics.F90', - 'physics/physics/rrtmgp_lw_main.F90', - 'physics/physics/rrtmgp_sw_main.F90', - 'physics/physics/GFS_rrtmgp_setup.F90', - 'physics/physics/GFS_rrtmgp_pre.F90', - 'physics/physics/GFS_cloud_diagnostics.F90', - 'physics/physics/GFS_rrtmgp_cloud_mp.F90', - 'physics/physics/GFS_rrtmgp_cloud_overlap.F90', - 'physics/physics/GFS_rrtmgp_post.F90' + 'physics/physics/tools/get_prs_fv3.F90', + 'physics/physics/tools/get_phi_fv3.F90' ] # Default build dir, relative to current working directory, diff --git a/ccpp/data/CCPP_typedefs.meta b/ccpp/data/CCPP_typedefs.meta index 428970f2d..a2d1105df 100644 --- a/ccpp/data/CCPP_typedefs.meta +++ b/ccpp/data/CCPP_typedefs.meta @@ -3193,11 +3193,8 @@ name = CCPP_typedefs type = module relative_path = ../physics/physics - dependencies = machine.F,radlw_param.f,radsw_param.f - dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_optical_props.F90 - dependencies = rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - dependencies = rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_rte_config.F90 - dependencies = rte-rrtmgp/rte/mo_source_functions.F90 + dependencies = hooks/machine.F,photochem/module_ozphys.F90 + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f [ccpp-arg-table] name = CCPP_typedefs diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 0c07dd093..ebaa9af7f 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -9863,9 +9863,11 @@ [ccpp-table-properties] name = GFS_typedefs type = module - relative_path = ../physics/physics - dependencies = machine.F,physcons.F90,radlw_param.f,radsw_param.f - dependencies = GFDL_parse_tracers.F90,h2o_def.f,module_ozphys.F90 + relative_path = ../physics/physics/ + dependencies = hooks/machine.F,hooks/physcons.F90 + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f + dependencies = photochem/h2o_def.f,photochem/module_ozphys.F90 + dependencies = MP/GFDL/GFDL_parse_tracers.F90 [ccpp-arg-table] name = GFS_typedefs diff --git a/ccpp/physics b/ccpp/physics index df9e1ad0f..53062d634 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit df9e1ad0f9dcafe58eb5ccd505046f965a6042bc +Subproject commit 53062d634c77deb774ce5abc3813f1583292eec9 diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml index 7886743e3..922f7f305 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn_lam3km.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_GFS_v15p2.xml b/ccpp/suites/suite_FV3_GFS_v15p2.xml index 7b2eaac1b..c164a1c7e 100644 --- a/ccpp/suites/suite_FV3_GFS_v15p2.xml +++ b/ccpp/suites/suite_FV3_GFS_v15p2.xml @@ -23,7 +23,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v16.xml b/ccpp/suites/suite_FV3_GFS_v16.xml index e6ae5483f..bc5540ce1 100644 --- a/ccpp/suites/suite_FV3_GFS_v16.xml +++ b/ccpp/suites/suite_FV3_GFS_v16.xml @@ -23,7 +23,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml b/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml index 3c41ef08d..3f972d784 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_csawmg.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_flake.xml b/ccpp/suites/suite_FV3_GFS_v16_flake.xml index a99756c30..4f09779a2 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_flake.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_flake.xml @@ -23,7 +23,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml b/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml index e540edc52..4de8927b1 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_fv3wam.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v16_ras.xml b/ccpp/suites/suite_FV3_GFS_v16_ras.xml index 31e1d29f3..d27a4887c 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_ras.xml @@ -23,7 +23,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml index 00675097a..53007131f 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml index 7daa7495a..64200955b 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_c3.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml index b137ed9a8..8b495a18f 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_sfcocn.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml index 5b316a735..b63190e65 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_coupled_p8_ugwpv1.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8.xml b/ccpp/suites/suite_FV3_GFS_v17_p8.xml index 37ce4d90c..4fa6c222d 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml index dd79992ce..e9257a7f3 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_c3.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml index a5b2b3291..fb7672ac3 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_mynn.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml index 0d001fc45..2a5034035 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_p8_ugwpv1.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml index e6673d7a6..0a08ee576 100644 --- a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml +++ b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf.xml @@ -23,7 +23,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml index de25bd871..3fc78efad 100644 --- a/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml +++ b/ccpp/suites/suite_FV3_HAFS_v1_gfdlmp_tedmf_nonsst.xml @@ -23,7 +23,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml b/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml index 7231ed9ac..70018e7cc 100644 --- a/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml +++ b/ccpp/suites/suite_FV3_HAFS_v1_thompson_tedmf_gfdlsf.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_FV3_HRRR.xml b/ccpp/suites/suite_FV3_HRRR.xml index 56360ab5d..2177dc078 100644 --- a/ccpp/suites/suite_FV3_HRRR.xml +++ b/ccpp/suites/suite_FV3_HRRR.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_HRRR_c3.xml b/ccpp/suites/suite_FV3_HRRR_c3.xml index 95a426de8..e3ad50a8a 100644 --- a/ccpp/suites/suite_FV3_HRRR_c3.xml +++ b/ccpp/suites/suite_FV3_HRRR_c3.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_HRRR_gf.xml b/ccpp/suites/suite_FV3_HRRR_gf.xml index 8694976ac..48260ce9f 100644 --- a/ccpp/suites/suite_FV3_HRRR_gf.xml +++ b/ccpp/suites/suite_FV3_HRRR_gf.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml b/ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml index 3e4b862c9..0f0022d1c 100644 --- a/ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml +++ b/ccpp/suites/suite_FV3_HRRR_gf_nogwd.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP.xml b/ccpp/suites/suite_FV3_RAP.xml index a24476213..b5a2117f6 100644 --- a/ccpp/suites/suite_FV3_RAP.xml +++ b/ccpp/suites/suite_FV3_RAP.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml b/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml index 6f16d0ea4..e6294028c 100644 --- a/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_cires_ugwp.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_clm_lake.xml b/ccpp/suites/suite_FV3_RAP_clm_lake.xml index 2bc178eae..e7fef4461 100644 --- a/ccpp/suites/suite_FV3_RAP_clm_lake.xml +++ b/ccpp/suites/suite_FV3_RAP_clm_lake.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_flake.xml b/ccpp/suites/suite_FV3_RAP_flake.xml index c60c4324b..3239355fa 100644 --- a/ccpp/suites/suite_FV3_RAP_flake.xml +++ b/ccpp/suites/suite_FV3_RAP_flake.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_noah.xml b/ccpp/suites/suite_FV3_RAP_noah.xml index 6fd994f3c..80a515356 100644 --- a/ccpp/suites/suite_FV3_RAP_noah.xml +++ b/ccpp/suites/suite_FV3_RAP_noah.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml index a07dd850b..2d6d0377b 100644 --- a/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_noah_sfcdiff_cires_ugwp.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_sfcdiff.xml b/ccpp/suites/suite_FV3_RAP_sfcdiff.xml index 8a960e02e..23bbf1f54 100644 --- a/ccpp/suites/suite_FV3_RAP_sfcdiff.xml +++ b/ccpp/suites/suite_FV3_RAP_sfcdiff.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml b/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml index efca314bb..509ffea89 100644 --- a/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml +++ b/ccpp/suites/suite_FV3_RAP_unified_ugwp.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RRFS_v1beta.xml b/ccpp/suites/suite_FV3_RRFS_v1beta.xml index 42ee00565..90165d880 100644 --- a/ccpp/suites/suite_FV3_RRFS_v1beta.xml +++ b/ccpp/suites/suite_FV3_RRFS_v1beta.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_RRFS_v1nssl.xml b/ccpp/suites/suite_FV3_RRFS_v1nssl.xml index 05b1edb79..e24d2c6f2 100644 --- a/ccpp/suites/suite_FV3_RRFS_v1nssl.xml +++ b/ccpp/suites/suite_FV3_RRFS_v1nssl.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_WoFS_v0.xml b/ccpp/suites/suite_FV3_WoFS_v0.xml index 5641af472..140ba9023 100644 --- a/ccpp/suites/suite_FV3_WoFS_v0.xml +++ b/ccpp/suites/suite_FV3_WoFS_v0.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_FV3_global_nest_v1.xml b/ccpp/suites/suite_FV3_global_nest_v1.xml index 5a8dbd3e0..6f55e56f7 100644 --- a/ccpp/suites/suite_FV3_global_nest_v1.xml +++ b/ccpp/suites/suite_FV3_global_nest_v1.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_RRFSens_phy1.xml b/ccpp/suites/suite_RRFSens_phy1.xml index 0cd4c47b8..f0de1ebf4 100644 --- a/ccpp/suites/suite_RRFSens_phy1.xml +++ b/ccpp/suites/suite_RRFSens_phy1.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_RRFSens_phy2.xml b/ccpp/suites/suite_RRFSens_phy2.xml index e1ecc7149..44cafb249 100644 --- a/ccpp/suites/suite_RRFSens_phy2.xml +++ b/ccpp/suites/suite_RRFSens_phy2.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_RRFSens_phy3.xml b/ccpp/suites/suite_RRFSens_phy3.xml index 85e7189bd..da442619d 100644 --- a/ccpp/suites/suite_RRFSens_phy3.xml +++ b/ccpp/suites/suite_RRFSens_phy3.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post diff --git a/ccpp/suites/suite_RRFSens_phy4.xml b/ccpp/suites/suite_RRFSens_phy4.xml index 35c7b052f..74a1e8972 100644 --- a/ccpp/suites/suite_RRFSens_phy4.xml +++ b/ccpp/suites/suite_RRFSens_phy4.xml @@ -18,7 +18,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw rrtmg_lw_post GFS_rrtmg_post diff --git a/ccpp/suites/suite_RRFSens_phy5.xml b/ccpp/suites/suite_RRFSens_phy5.xml index 26bb32584..0321e64e9 100644 --- a/ccpp/suites/suite_RRFSens_phy5.xml +++ b/ccpp/suites/suite_RRFSens_phy5.xml @@ -19,7 +19,6 @@ rad_sw_pre rrtmg_sw rrtmg_sw_post - rrtmg_lw_pre rrtmg_lw sgscloud_radpost rrtmg_lw_post From 5e7f1961ff4ee0e4793818589a3942482ca8967e Mon Sep 17 00:00:00 2001 From: Brian Curtis <64433609+BrianCurtis-NOAA@users.noreply.github.com> Date: Sat, 6 Jan 2024 10:21:16 -0500 Subject: [PATCH 45/48] switch to use fms implementation of mpp (#732) --- io/module_wrt_grid_comp.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index e409788ab..b7e93e28f 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -29,7 +29,6 @@ module module_wrt_grid_comp use mpi use esmf use fms - use mpp_mod, only : mpp_init ! needed for fms 2023.02 use write_internal_state use module_fv3_io_def, only : num_pes_fcst, & @@ -253,7 +252,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, lprnt = lead_write_task == wrt_int_state%mype call fms_init(wrt_mpi_comm) - call mpp_init() ! print *,'in wrt, lead_write_task=', & ! lead_write_task,'last_write_task=',last_write_task, & @@ -1336,7 +1334,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! save calendar_type (as integer) for use in 'coupler.res' if (index(trim(attNameList(i)),'time:calendar') > 0) then - select case( uppercase(trim(valueS)) ) + select case( fms_mpp_uppercase(trim(valueS)) ) case( 'JULIAN' ) calendar_type = JULIAN case( 'GREGORIAN' ) @@ -1348,7 +1346,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, case( 'NO_CALENDAR' ) calendar_type = NO_CALENDAR case default - call mpp_error ( FATAL, 'fcst_initialize: calendar must be one of '// & + call fms_mpp_error ( FATAL, 'fcst_initialize: calendar must be one of '// & 'JULIAN|GREGORIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) end select endif From 138aab1b4dcc98143803941301c81e3e933fecdc Mon Sep 17 00:00:00 2001 From: Alex Richert <82525672+AlexanderRichert-NOAA@users.noreply.github.com> Date: Fri, 12 Jan 2024 14:28:31 -0500 Subject: [PATCH 46/48] Add CI build (#730) * Add GCC-based CI build --- .github/workflows/GCC.yml | 83 +++++++++++++++++++++++++++++++++++++++ CMakeLists.txt | 6 +++ ci/CMakeLists.txt | 70 +++++++++++++++++++++++++++++++++ ci/spack.yaml | 29 ++++++++++++++ 4 files changed, 188 insertions(+) create mode 100644 .github/workflows/GCC.yml create mode 100644 ci/CMakeLists.txt create mode 100644 ci/spack.yaml diff --git a/.github/workflows/GCC.yml b/.github/workflows/GCC.yml new file mode 100644 index 000000000..3fb022bae --- /dev/null +++ b/.github/workflows/GCC.yml @@ -0,0 +1,83 @@ +# This is a CI workflow for the fv3atm project. +# +# This workflow builds and tests the fv3atm library using GCC, and it tests +# different CMake build options. +# +# Alex Richert, 6 Dec 2023 + +name: GCC +on: + push: + branches: + - develop + pull_request: + branches: + - develop + +jobs: + GCC: + runs-on: ubuntu-latest + + strategy: + matrix: + cmake_opts: ["-D32BIT=ON", "-D32BIT=OFF"] + gcc_ver: ["11"] + mpi: ["mpich"] + + steps: + + - name: checkout-fv3atm + uses: actions/checkout@v3 + with: + path: ${{ github.workspace }}/fv3atm + submodules: recursive + + - name: cache-spack + id: cache-spack + uses: actions/cache@v3 + with: + path: ${{ github.workspace }}/spack-develop + key: spack-${{ hashFiles('fv3atm/ci/spack.yaml') }}-gcc${{ matrix.gcc_ver }}-2 + + # Building dependencies takes 40+ min + - name: spack-install + if: steps.cache-spack.outputs.cache-hit != 'true' + run: | + wget --no-verbose https://github.com/spack/spack/archive/refs/heads/develop.zip + unzip develop.zip -d ${GITHUB_WORKSPACE}/ &> unzip.out + . ${GITHUB_WORKSPACE}/spack-develop/share/spack/setup-env.sh + spack env create gcc${{ matrix.gcc_ver }} ${GITHUB_WORKSPACE}/fv3atm/ci/spack.yaml + spack env activate gcc${{ matrix.gcc_ver }} + spack compiler find | grep gcc@${{ matrix.gcc_ver }} + spack external find gmake cmake git git-lfs perl python ${{ matrix.mpi }} + spack config add "packages:all:require:['%gcc@${{ matrix.gcc_ver }}']" + spack config add "packages:mpi:require:'${{ matrix.mpi }}'" + spack concretize |& tee ${SPACK_ENV}/log.concretize + spack install -j2 --fail-fast + + - name: cache-save + uses: actions/cache/save@v3 + if: ${{ always() }} + with: + path: ${{ github.workspace }}/spack-develop + key: spack-${{ hashFiles('fv3atm/ci/spack.yaml') }}-gcc${{ matrix.gcc_ver }}-2 + + - name: build-fv3atm + run: | + . ${GITHUB_WORKSPACE}/spack-develop/share/spack/setup-env.sh + spack env activate gcc${{ matrix.gcc_ver }} + spack load $(spack find --format "{name}") + cd ${GITHUB_WORKSPACE}/fv3atm + git clone https://github.com/NOAA-EMC/CMakeModules + git clone --recurse-submodules https://github.com/NOAA-PSL/stochastic_physics stochastic_physics_repo + mkdir ${GITHUB_WORKSPACE}/build + cd ${GITHUB_WORKSPACE}/build + cmake ${GITHUB_WORKSPACE}/fv3atm -DBUILD_TESTING=ON ${{ matrix.cmake_opts }} + make -j2 + + - name: debug-artifacts + uses: actions/upload-artifact@v3 + if: ${{ failure() }} + with: + name: ccpp_prebuild_logs + path: ${{ github.workspace }}/build/ccpp/ccpp_prebuild.* diff --git a/CMakeLists.txt b/CMakeLists.txt index 549738794..bd40d09df 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,3 +1,9 @@ +# Enable CI build & unit testing: +if(BUILD_TESTING) + cmake_minimum_required(VERSION 3.19) + project(fv3atm VERSION 1.0 LANGUAGES C CXX Fortran) + include(ci/CMakeLists.txt) +endif() ############################################################################### ### CCPP diff --git a/ci/CMakeLists.txt b/ci/CMakeLists.txt new file mode 100644 index 000000000..71412b3af --- /dev/null +++ b/ci/CMakeLists.txt @@ -0,0 +1,70 @@ +# This file is used by fv3atm's root CMakeLists.txt when BUILD_TESTING=ON. It is +# used for CI runs and is based on the ufs-weather-model root CMakeLists.txt. It +# cannot be built directly, and should not be used for compiling for general R&D +# or operations. +# +# Alex Richert, 6 Dec 2023 + +list(APPEND CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/CMakeModules/Modules) + +if(${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU") + if(CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 9.0.0) + message(FATAL_ERROR "GNU Compiler >= 9 is required") + endif() + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ggdb -fbacktrace -cpp -fcray-pointer -ffree-line-length-none -fno-range-check") + + if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch -fallow-invalid-boz") + endif() + + if(NOT 32BIT) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fdefault-double-8") + endif() +elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback -fpp -fno-alias -auto -safe-cray-ptr -ftz -assume byterecl -nowarn -sox -align array64byte -qno-opt-dynamic-align") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -qno-opt-dynamic-align -sox -fp-model source") + set(CMAKE_Fortran_FLAGS_RELEASE "-O2 -debug minimal -qoverride-limits") + set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -fp-model consistent") + set(CMAKE_C_FLAGS_RELEASE "-O2 -debug minimal") + + if(NOT 32BIT) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -real-size 64") + endif() +endif() + +set(32BIT OFF CACHE BOOL "Enable 32BIT (single precision arithmetic in dycore and fast physics)") +set(CCPP_32BIT OFF CACHE BOOL "Enable CCPP_32BIT (single precision arithmetic in slow physics)") +set(INLINE_POST ON CACHE BOOL "Enable inline post") +set(MULTI_GASES OFF CACHE BOOL "Enable MULTI_GASES") +set(MOVING_NEST OFF CACHE BOOL "Enable moving nest code") +set(OPENMP ON CACHE BOOL "Enable OpenMP threading") +set(PARALLEL_NETCDF OFF CACHE BOOL "Enable parallel NetCDF") + +message("32BIT ............ ${32BIT}") +message("CCPP_32BIT ....... ${CCPP_32BIT}") +message("INLINE_POST ...... ${INLINE_POST}") +message("MULTI_GASES ...... ${MULTI_GASES}") +message("MOVING_NEST ...... ${MOVING_NEST}") +message("OPENMP ........... ${OPENMP}") +message("PARALLEL_NETCDF .. ${PARALLEL_NETCDF}") + +find_package(MPI REQUIRED) +if(OPENMP) + find_package(OpenMP REQUIRED) +endif() + +find_package(NetCDF 4.7.4 REQUIRED C Fortran) +find_package(ESMF 8.3.0 MODULE REQUIRED) +find_package(FMS 2022.04 REQUIRED COMPONENTS R4 R8) +if(32BIT) + add_library(fms ALIAS FMS::fms_r4) +else() + add_library(fms ALIAS FMS::fms_r8) +endif() +find_package(bacio 2.4.0 REQUIRED) +find_package(sp 2.3.3 REQUIRED) +find_package(w3emc 2.9.2 REQUIRED) + +find_package(Python 3.6 REQUIRED COMPONENTS Interpreter) + +add_subdirectory(stochastic_physics_repo) diff --git a/ci/spack.yaml b/ci/spack.yaml new file mode 100644 index 000000000..400b7e06b --- /dev/null +++ b/ci/spack.yaml @@ -0,0 +1,29 @@ +# This file is used in the CI to define the libraries needed to build fv3atm. It +# is used by the 'spack env create' command to generate a Spack environment. It +# is generally preferred to avoid defining settings here that are not shared +# across CI workflows, such as requiring the use of a specific compiler. Any +# such modifications should be done in the appropriate CI workflow using the +# 'spack config add' command, or with search-and-replace. +# WARNING: Changing this file will automatically cause the cached Spack builds +# in GitHub Actions to be regenerated, which takes a considerable amount of +# time. +# +# Alex Richert, 6 Dec 2023 +spack: + specs: + - w3emc@2.10.0 precision=4,d,8 + - ip@develop precision=4,d,8 + - sp@2.4.0 precision=4,d,8 + - bacio@2.4.1 + - upp@develop + - esmf@8.4.2 + - fms@2023.04 +gfs_phys +openmp +pic +quad_precision +deprecated_io constants=GFS precision=32,64 + - netcdf-c@4.9.2 ~blosc + view: false + concretizer: + unify: true + packages: + mpich: + require: ['~libxml2 ~hwloc ~pci'] # minimize unneeded dependencies + yaksa: + buildable: false # minimize unneeded dependencies From 095a1d578a2adf4f10b0f0134160e31ac8aa2f11 Mon Sep 17 00:00:00 2001 From: AnningCheng-NOAA <48297505+AnningCheng-NOAA@users.noreply.github.com> Date: Tue, 16 Jan 2024 11:35:25 -0500 Subject: [PATCH 47/48] A merra2 interpolation bug found by running RRFS (#750) * physics merra2 interpolation bug fix: rrfs --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 53062d634..a492addf8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 53062d634c77deb774ce5abc3813f1583292eec9 +Subproject commit a492addf860d29d797bca488f53d39b260584924 From 68980ad4437563f55af05f9a0eb1998441c803ba Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Wed, 17 Jan 2024 14:03:17 -0500 Subject: [PATCH 48/48] Fix out-of-bounds access in module_diag_hailcast.F90 which crashes RRFS on WCOSS2 (#746) * fix out-of-bounds write in module_diag_hailcast * only correct RWA_new where RWA_adiabat(k).ge.1.E-12 * module_diag_hailcast.F90: update comments; changes from @adams-selin --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index caba092f6..eeb4a714d 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit caba092f682c9713a485e782b8f9ba6480adaca2 +Subproject commit eeb4a714d946f554da6b16800da436e1ce66a092