From 2dc03c1ca1acd8a61a5ac89448cc96897cf092c7 Mon Sep 17 00:00:00 2001 From: bensonr <6594772+bensonr@users.noreply.github.com> Date: Wed, 25 Aug 2021 09:19:23 -0400 Subject: [PATCH 1/7] Updates to use FMS 2021.03 (#374) * io/FV3GFS_io.F90 updated to use fms2_io * atmos_model.F90 and ccpp/data/GFS_typefs.F90 updates to input_nml_file handling * atmos_cubed_sphere submodule updated --- CMakeLists.txt | 2 + atmos_cubed_sphere | 2 +- atmos_model.F90 | 2 + ccpp/data/GFS_typedefs.F90 | 14 +- io/FV3GFS_io.F90 | 688 +++++++++++++++++++++++++------------ 5 files changed, 484 insertions(+), 224 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ea4109cd5..4766a17d3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -61,6 +61,8 @@ list(APPEND _fv3dycore_defs_private SPMD GFS_TYPES USE_GFSL63 MOIST_CAPPA + INTERNAL_FILE_NML + ENABLE_QUAD_PRECISION USE_COND) if(MULTI_GASES) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 3a0d35ad3..bdb078ade 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 3a0d35ad3efca351d5b1efccfad58eecf8147f2c +Subproject commit bdb078ade1e9f81755513d6dbb51b3f40fccaa41 diff --git a/atmos_model.F90 b/atmos_model.F90 index 0730a886a..0425b5a03 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -650,6 +650,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic #ifdef INTERNAL_FILE_NML + ! allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 + allocate(Init_parm%input_nml_file, mold=input_nml_file) Init_parm%input_nml_file => input_nml_file Init_parm%fn_nml='using internal file' #else diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 9bb68da10..17ca800cd 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -148,9 +148,9 @@ module GFS_typedefs character(len=32), pointer :: tracer_names(:) !< tracers names to dereference tracer id integer, pointer :: tracer_types(:) !< tracers types: 0=generic, 1=chem,prog, 2=chem,diag character(len=64) :: fn_nml !< namelist filename - character(len=256), pointer :: input_nml_file(:) !< character string containing full namelist - !< for use with internal file reads - end type GFS_init_type + character(len=:), pointer, dimension(:) :: input_nml_file => null() !< character string containing full namelist + !< for use with internal file reads + end type GFS_init_type !---------------------------------------------------------------- @@ -586,8 +586,8 @@ module GFS_typedefs integer :: nthreads !< OpenMP threads available for physics integer :: nlunit !< unit for namelist character(len=64) :: fn_nml !< namelist filename for surface data cycling - character(len=256), pointer :: input_nml_file(:) !< character string containing full namelist - !< for use with internal file reads + character(len=:), pointer, dimension(:) :: input_nml_file => null() !< character string containing full namelist + !< for use with internal file reads integer :: input_nml_file_length !< length (number of lines) in namelist for internal reads integer :: logunit real(kind=kind_phys) :: fhzero !< hours between clearing of diagnostic buckets @@ -3086,7 +3086,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer, intent(in) :: nwat character(len=32), intent(in) :: tracer_names(:) integer, intent(in) :: tracer_types(:) - character(len=256), intent(in), pointer :: input_nml_file(:) + character(len=:), intent(in), dimension(:), pointer :: input_nml_file integer, intent(in) :: blksz(:) real(kind=kind_phys), dimension(:), intent(in) :: ak real(kind=kind_phys), dimension(:), intent(in) :: bk @@ -3723,6 +3723,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- read in the namelist #ifdef INTERNAL_FILE_NML + ! allocate required to work around GNU compiler bug 100886 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100886 + allocate(Model%input_nml_file, mold=input_nml_file) Model%input_nml_file => input_nml_file read(Model%input_nml_file, nml=gfs_physics_nml) ! Set length (number of lines) in namelist for internal reads diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index adc3c9b03..ce6420fa4 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -3,7 +3,7 @@ module FV3GFS_io_mod !----------------------------------------------------------------------- ! gfs_physics_driver_mod defines the GFS physics routines used by ! the GFDL FMS system to obtain tendencies and boundary fluxes due -! to the physical parameterizations and processes that drive +! to the physical parameterizations and processes that drive ! atmospheric time tendencies for use by other components, namely ! the atmospheric dynamical core. ! @@ -17,10 +17,13 @@ module FV3GFS_io_mod use block_control_mod, only: block_control_type use mpp_mod, only: mpp_error, mpp_pe, mpp_root_pe, & mpp_chksum, NOTE, FATAL - use fms_mod, only: file_exist, stdout - use fms_io_mod, only: restart_file_type, free_restart_type, & - register_restart_field, & - restore_state, save_restart + use fms_mod, only: stdout + use fms2_io_mod, only: FmsNetcdfDomainFile_t, unlimited, & + open_file, close_file, & + register_axis, register_restart_field, & + register_variable_attribute, register_field, & + read_restart, write_restart, write_data, & + get_global_io_domain_indices, variable_exists use mpp_domains_mod, only: domain1d, domain2d, domainUG use time_manager_mod, only: time_type use diag_manager_mod, only: register_diag_field, send_data @@ -42,7 +45,7 @@ module FV3GFS_io_mod !----------------------------------------------------------------------- implicit none private - + !--- public interfaces --- public FV3GFS_restart_read, FV3GFS_restart_write public FV3GFS_GFS_checksum @@ -58,10 +61,10 @@ module FV3GFS_io_mod character(len=32) :: fn_srf = 'sfc_data.nc' character(len=32) :: fn_phy = 'phy_data.nc' - !--- GFDL FMS netcdf restart data types - type(restart_file_type) :: Oro_restart, Sfc_restart, Phy_restart - type(restart_file_type) :: Oro_ls_restart, Oro_ss_restart - + !--- GFDL FMS netcdf restart data types defined in fms2_io + type(FmsNetcdfDomainFile_t) :: Oro_restart, Sfc_restart, Phy_restart + type(FmsNetcdfDomainFile_t) :: Oro_ls_restart, Oro_ss_restart + !--- GFDL FMS restart containers character(len=32), allocatable, dimension(:) :: oro_name2, sfc_name2, sfc_name3 real(kind=kind_phys), allocatable, target, dimension(:,:,:) :: oro_var2, sfc_var2, phy_var2, sfc_var3ice @@ -96,7 +99,7 @@ module FV3GFS_io_mod real, parameter:: drythresh = 1.e-4_r8, zero = 0.0_r8, one = 1.0_r8 real, parameter:: min_lake_orog = 200.0_r8 real(kind=kind_phys), parameter :: timin = 173.0_r8 ! minimum temperature allowed for snow/ice - + !--- miscellaneous other variables logical :: use_wrtgridcomp_output = .FALSE. logical :: module_is_initialized = .FALSE. @@ -119,8 +122,8 @@ subroutine FV3GFS_restart_read (GFS_Data, GFS_Restart, Atm_block, Model, fv_doma type(GFS_control_type), intent(inout) :: Model type(domain2d), intent(in) :: fv_domain logical, intent(in) :: warm_start - - !--- read in surface data from chgres + + !--- read in surface data from chgres call sfc_prop_restart_read (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, warm_start) !--- read in physics restart data @@ -138,10 +141,10 @@ subroutine FV3GFS_restart_write (GFS_Data, GFS_Restart, Atm_block, Model, fv_dom type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain character(len=32), optional, intent(in) :: timestamp - - !--- write surface data from chgres + + !--- write surface data from chgres call sfc_prop_restart_write (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, timestamp) - + !--- write physics restart data call phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) @@ -490,7 +493,7 @@ end subroutine FV3GFS_GFS_checksum ! calls: register_restart_field, restart_state, free_restart ! ! opens: oro_data.tile?.nc, sfc_data.tile?.nc -! +! !---------------------------------------------------------------------- subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_start) !--- interface variable definitions @@ -515,7 +518,13 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: vegtyp logical :: mand real(kind=kind_phys) :: rsnow, tem, tem1 - + !--- directory of the input files + character(5) :: indir='INPUT' + character(37) :: infile + !--- fms2_io file open logic + logical :: amiopen + logical :: is_lsoil + nvar_o2 = 19 nvar_oro_ls_ss = 10 nvar_s2o = 18 @@ -551,8 +560,14 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta npz = Atm_block%npz nx = (iec - isc + 1) ny = (jec - jsc + 1) - + !--- OROGRAPHY FILE + + !--- open file + infile=trim(indir)//'/'//trim(fn_oro) + amiopen=open_file(Oro_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if (.not.amiopen) call mpp_error( FATAL, 'Error with opening file '//trim(infile) ) + if (.not. allocated(oro_name2)) then !--- allocate the various containers needed for orography data allocate(oro_name2(nvar_o2)) @@ -579,23 +594,29 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- variables below here are optional oro_name2(18) = 'lake_frac' ! lake fraction [0:1] oro_name2(19) = 'lake_depth' ! lake depth(m) + + !--- register axis + call register_axis( Oro_restart, "lon", 'X' ) + call register_axis( Oro_restart, "lat", 'Y' ) !--- register the 2D fields do num = 1,nvar_o2 - var2_p => oro_var2(:,:,num) - if (trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') then - id_restart = register_restart_field(Oro_restart, fn_oro, oro_name2(num), var2_p, domain=fv_domain, mandatory=.false.) - else - id_restart = register_restart_field(Oro_restart, fn_oro, oro_name2(num), var2_p, domain=fv_domain) - endif + var2_p => oro_var2(:,:,num) + if (trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') then + call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + else + call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/)) + endif enddo nullify(var2_p) - endif + endif + + !--- read the orography restart/data + call mpp_error(NOTE,'reading topographic/orographic information from INPUT/oro_data.tile*.nc') + call read_restart(Oro_restart) + call close_file(Oro_restart) - !--- read the orography restart/data - call mpp_error(NOTE,'reading topographic/orographic information from INPUT/oro_data.tile*.nc') - call restore_state(Oro_restart) - !--- copy data into GFS containers + !--- copy data into GFS containers !$omp parallel do default(shared) private(i, j, nb, ix) do nb = 1, Atm_block%nblks @@ -635,7 +656,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo enddo - + nvar_s2m = 44 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then nvar_s2m = nvar_s2m + 4 @@ -647,11 +668,21 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) - call free_restart_type(Oro_restart) - !--- Modify/read-in additional orographic static fields for GSL drag suite + !--- Modify/read-in additional orographic static fields for GSL drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then + + !--- open restart file + infile=trim(indir)//'/'//trim(fn_oro_ls) + amiopen=open_file(Oro_ls_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( .not.amiopen ) call mpp_error( FATAL, 'Error with opening file '//trim(infile) ) + + !--- open restart file + infile=trim(indir)//'/'//trim(fn_oro_ss) + amiopen=open_file(Oro_ss_restart, trim(infile), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( .not.amiopen ) call mpp_error( FATAL, 'Error with opening file '//trim(infile) ) + if (.not. allocated(oro_ls_ss_name)) then !--- allocate the various containers needed for orography data allocate(oro_ls_ss_name(nvar_oro_ls_ss)) @@ -668,28 +699,34 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta oro_ls_ss_name(8) = 'ol2' oro_ls_ss_name(9) = 'ol3' oro_ls_ss_name(10) = 'ol4' - !--- register the 2D fields + + call register_axis(Oro_ls_restart, "lon", 'X') + call register_axis(Oro_ls_restart, "lat", 'Y') + call register_axis(Oro_ss_restart, "lon", 'X') + call register_axis(Oro_ss_restart, "lat", 'Y') + do num = 1,nvar_oro_ls_ss var2_p => oro_ls_var(:,:,num) - id_restart = register_restart_field(Oro_ls_restart, fn_oro_ls, & - oro_ls_ss_name(num), var2_p, domain=fv_domain) + call register_restart_field(Oro_ls_restart, oro_ls_ss_name(num), var2_p, dimensions=(/'lon','lat'/)) enddo nullify(var2_p) do num = 1,nvar_oro_ls_ss var2_p => oro_ss_var(:,:,num) - id_restart = register_restart_field(Oro_ss_restart, fn_oro_ss, & - oro_ls_ss_name(num), var2_p, domain=fv_domain) + call register_restart_field(Oro_ss_restart, oro_ls_ss_name(num), var2_p, dimensions=(/'lon','lat'/)) enddo nullify(var2_p) - endif + end if !--- read new GSL created orography restart/data call mpp_error(NOTE,'reading topographic/orographic information from & - &INPUT/oro_data_ls.tile*.nc') - call restore_state(Oro_ls_restart) + &INPUT/oro_data_ls.tile*.nc') + call read_restart(Oro_ls_restart) + call close_file(Oro_ls_restart) call mpp_error(NOTE,'reading topographic/orographic information from & - &INPUT/oro_data_ss.tile*.nc') - call restore_state(Oro_ss_restart) + &INPUT/oro_data_ss.tile*.nc') + call read_restart(Oro_ss_restart) + call close_file(Oro_ss_restart) + do nb = 1, Atm_block%nblks !--- 2D variables @@ -727,11 +764,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo enddo - call free_restart_type(Oro_ls_restart) - call free_restart_type(Oro_ss_restart) - endif + end if + + !--- SURFACE FILE + + !--- open file + infile=trim(indir)//'/'//trim(fn_srf) + amiopen=open_file(Sfc_restart, trim(infile), "read", domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( .not.amiopen ) call mpp_error(FATAL, 'Error opening file'//trim(infile)) - !--- SURFACE FILE if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) @@ -894,6 +935,36 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+19) = 'lai' endif + is_lsoil=.false. + if ( .not. warm_start ) then + if( variable_exists(Sfc_restart,"lsoil") ) then + is_lsoil=.true. + call register_axis(Sfc_restart, 'lon', 'X') + call register_axis(Sfc_restart, 'lat', 'Y') + call register_axis(Sfc_restart, 'lsoil', dimension_length=Model%lsoil) + else + call register_axis(Sfc_restart, 'xaxis_1', 'X') + call register_axis(Sfc_restart, 'yaxis_1', 'Y') + call register_axis(Sfc_restart, 'zaxis_1', dimension_length=4) + call register_axis(Sfc_restart, 'Time', 1) + end if + else + call register_axis(Sfc_restart, 'xaxis_1', 'X') + call register_axis(Sfc_restart, 'yaxis_1', 'Y') + call register_axis(Sfc_restart, 'zaxis_1', dimension_length=Model%kice) + + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil) + else if(Model%lsm == Model%lsm_ruc) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil_lsm) + end if + if(Model%lsm == Model%lsm_noahmp) then + call register_axis(Sfc_restart, 'zaxis_3', dimension_length=3) + call register_axis(Sfc_restart, 'zaxis_4', dimension_length=7) + end if + call register_axis(Sfc_restart, 'Time', unlimited) + end if + !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) @@ -901,47 +972,69 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & - .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdifvis_ice' & - .or. trim(sfc_name2(num)) == 'albdirnir_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & - .or. trim(sfc_name2(num)) == 'emis_lnd' ) then - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) + .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdirnir_ice' & + .or. trim(sfc_name2(num)) == 'albdifvis_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & + .or. trim(sfc_name2(num)) == 'emis_lnd' ) then + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/),& + &is_optional=.true.) + end if else - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) + if(is_lsoil) then + call register_restart_field(Sfc_restart,sfc_name2(num),var2_p, dimensions=(/'lat','lon'/)) + else + call register_restart_field(Sfc_restart,sfc_name2(num),var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/)) + end if endif - enddo - + enddo if (Model%nstf_name(1) > 0) then - mand = .false. - if (Model%nstf_name(2) == 0) mand = .true. - do num = nvar_s2m+1,nvar_s2m+nvar_s2o - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo + mand = .false. + if (Model%nstf_name(2) == 0) mand = .true. + do num = nvar_s2m+1,nvar_s2m+nvar_s2o + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.not.mand) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/), & + &is_optional=.not.mand) + endif + enddo endif if (Model%lsm == Model%lsm_ruc) then ! nvar_s2mp = 0 - do num = nvar_s2m+nvar_s2o+1, nvar_s2m+nvar_s2o+nvar_s2r - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) - enddo + do num = nvar_s2m+nvar_s2o+1, nvar_s2m+nvar_s2o+nvar_s2r + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/) ) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/) ) + end if + enddo endif ! mp/ruc + ! Noah MP register only necessary only lsm = 2, not necessary has values if (nvar_s2mp > 0) then - mand = .false. - do num = nvar_s2m+nvar_s2o+1,nvar_s2m+nvar_s2o+nvar_s2mp - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo + mand = .false. + do num = nvar_s2m+nvar_s2o+1,nvar_s2m+nvar_s2o+nvar_s2mp + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.not.mand) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'Time ','yaxis_1','xaxis_1'/), & + &is_optional=.not.mand) + end if + enddo endif ! noahmp - nullify(var2_p) - endif ! if not allocated + endif ! if not allocated + - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' @@ -966,29 +1059,43 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- register the 3D fields sfc_name3(0) = 'tiice' var3_p => sfc_var3ice(:,:,:) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain, mandatory=.false.) - + call register_restart_field(Sfc_restart, sfc_name3(0), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_1', 'Time '/),& + &is_optional=.true.) + do num = 1,nvar_s3 - var3_p => sfc_var3(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p, domain=fv_domain) + var3_p => sfc_var3(:,:,:,num) + if ( warm_start ) then + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'lsoil ', 'Time '/),& + &is_optional=.true.) + else + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'lat ', 'lon ', 'lsoil'/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& + &is_optional=.true.) + end if + end if enddo + if (Model%lsm == Model%lsm_noahmp) then - mand = .false. - do num = nvar_s3+1,nvar_s3+3 - var3_p1 => sfc_var3sn(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p1, domain=fv_domain,mandatory=mand) - enddo + mand = .false. + do num = nvar_s3+1,nvar_s3+3 + var3_p1 => sfc_var3sn(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p1, dimensions=(/'xaxis_1', 'yaxis_1','zaxis_2', 'Time '/),& + &is_optional=.not.mand) + enddo - var3_p2 => sfc_var3eq(:,:,:,7) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(7), var3_p2, domain=fv_domain,mandatory=mand) + var3_p2 => sfc_var3eq(:,:,:,7) + call register_restart_field(Sfc_restart, sfc_name3(7), var3_p2, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/),& + &is_optional=.not.mand) - var3_p3 => sfc_var3zn(:,:,:,8) - id_restart = register_restart_fIeld(Sfc_restart, fn_srf, sfc_name3(8), var3_p3, domain=fv_domain,mandatory=mand) - - nullify(var3_p1) - nullify(var3_p2) - nullify(var3_p3) + var3_p3 => sfc_var3zn(:,:,:,8) + call register_restart_field(Sfc_restart, sfc_name3(8), var3_p3, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_4', 'Time '/),& + &is_optional=.not.mand) + nullify(var3_p1) + nullify(var3_p2) + nullify(var3_p3) endif !mp nullify(var3_p) @@ -1002,7 +1109,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- read the surface restart/data call mpp_error(NOTE,'reading surface properties data from INPUT/sfc_data.tile*.nc') - call restore_state(Sfc_restart) + call read_restart(Sfc_restart) + call close_file(Sfc_restart) ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,35)),maxval(sfc_var2(:,:,35)),' sfc_name2=',sfc_name2(35) ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,18)),maxval(sfc_var2(:,:,18)) @@ -1296,7 +1404,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%snicexy(ix,lsoil) = sfc_var3sn(i,j,lsoil,4) Sfcprop(nb)%snliqxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,5) Sfcprop(nb)%tsnoxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,6) - enddo + enddo do lsoil = 1, 4 Sfcprop(nb)%smoiseq(ix,lsoil) = sfc_var3eq(i,j,lsoil,7) @@ -1304,7 +1412,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta do lsoil = -2, 4 Sfcprop(nb)%zsnsoxy(ix,lsoil) = sfc_var3zn(i,j,lsoil,8) - enddo + enddo endif else if (Model%lsm == Model%lsm_ruc) then @@ -1512,6 +1620,14 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p1 => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p3 => NULL() + !--- directory of the input files + character(7) :: indir='RESTART' + character(72) :: infile + !--- fms2_io file open logic + logical :: amiopen + !--- variables used for fms2_io register axis + integer :: is, ie + integer, allocatable, dimension(:) :: buffer nvar2m = 44 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then @@ -1557,11 +1673,83 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta deallocate(sfc_name3) deallocate(sfc_var2) deallocate(sfc_var3) - call free_restart_type(Sfc_restart) - end if + end if end if end if + !--- set filename + infile=trim(indir)//'/'//trim(fn_srf) + if( present(timestamp) ) infile=trim(indir)//'/'//trim(timestamp)//'.'//trim(fn_srf) + + !--- register axis + amiopen=open_file(Sfc_restart, trim(infile), 'overwrite', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( amiopen ) then + call register_axis(Sfc_restart, 'xaxis_1', 'X') + call register_field(Sfc_restart, 'xaxis_1', 'double', (/'xaxis_1'/)) + call register_variable_attribute(Sfc_restart, 'xaxis_1', 'cartesian_axis', 'X', str_len=1) + call get_global_io_domain_indices(Sfc_restart, 'xaxis_1', is, ie, indices=buffer) + call write_data(Sfc_restart, "xaxis_1", buffer) + deallocate(buffer) + + call register_axis(Sfc_restart, 'yaxis_1', 'Y') + call register_field(Sfc_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_variable_attribute(Sfc_restart, 'yaxis_1', 'cartesian_axis', 'Y', str_len=1) + call get_global_io_domain_indices(Sfc_restart, 'yaxis_1', is, ie, indices=buffer) + call write_data(Sfc_restart, "yaxis_1", buffer) + deallocate(buffer) + + call register_axis(Sfc_restart, 'zaxis_1', dimension_length=Model%kice) + call register_field(Sfc_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_1', 'cartesian_axis', 'Z', str_len=1) + allocate( buffer(Model%kice) ) + do i=1, Model%kice + buffer(i) = i + end do + call write_data(Sfc_restart, 'zaxis_1', buffer) + deallocate(buffer) + + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then + call register_axis(Sfc_restart, 'zaxis_2', dimension_length=Model%lsoil) + call register_field(Sfc_restart, 'zaxis_2', 'double', (/'zaxis_2'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_2', 'cartesian_axis', 'Z', str_len=1) + allocate( buffer(Model%lsoil) ) + do i=1, Model%lsoil + buffer(i)=i + end do + call write_data(Sfc_restart, 'zaxis_2', buffer) + deallocate(buffer) + endif + + if(Model%lsm == Model%lsm_noahmp) then + call register_axis(Sfc_restart, 'zaxis_3', dimension_length=3) + call register_field(Sfc_restart, 'zaxis_3', 'double', (/'zaxis_3'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_3', 'cartesian_axis', 'Z', str_len=1) + allocate(buffer(3)) + do i=1, 3 + buffer(i) = i + end do + call write_data(Sfc_restart, 'zaxis_3', buffer) + deallocate(buffer) + + call register_axis(Sfc_restart, 'zaxis_4', dimension_length=7) + call register_field(Sfc_restart, 'zaxis_4', 'double', (/'zaxis_4'/)) + call register_variable_attribute(Sfc_restart, 'zaxis_4', 'cartesian_axis' ,'Z', str_len=1) + allocate(buffer(7)) + do i=1, 7 + buffer(i)=i + end do + call write_data(Sfc_restart, 'zaxis_4', buffer) + deallocate(buffer) + end if + call register_axis(Sfc_restart, 'Time', unlimited) + call register_field(Sfc_restart, 'Time', 'double', (/'Time'/)) + call register_variable_attribute(Sfc_restart, 'Time', 'cartesian_axis', 'T', str_len=1) + call write_data( Sfc_restart, 'Time', 1) + else + call mpp_error(FATAL, 'Error in opening file'//trim(infile) ) + end if + + if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) @@ -1716,100 +1904,112 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+46) = 'deeprechxy' sfc_name2(nvar2m+47) = 'rechxy' endif + end if + + !--- register the 2D fields + do num = 1,nvar2m + var2_p => sfc_var2(:,:,num) + if (trim(sfc_name2(num)) == 'sncovr' .or. trim(sfc_name2(num)) == 'tsfcl' .or.trim(sfc_name2(num)) == 'zorll' & + .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & + .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & + .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & + .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdirnir_ice' & + .or. trim(sfc_name2(num)) == 'albdifvis_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & + .or. trim(sfc_name2(num)) == 'emis_lnd' ) then + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/) ) + endif + enddo + if (Model%nstf_name(1) > 0) then + mand = .false. + if (Model%nstf_name(2) ==0) mand = .true. + do num = nvar2m+1,nvar2m+nvar2o + var2_p => sfc_var2(:,:,num) + call register_restart_field(Sfc_restart, sfc_name2(num), var2_p, dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/),& + &is_optional=.not.mand) + enddo + endif - !--- register the 2D fields - do num = 1,nvar2m - var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr' .or. trim(sfc_name2(num)) == 'tsfcl' .or.trim(sfc_name2(num)) == 'zorll' & - .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & - .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & - .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & - .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & - .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdifvis_ice' & - .or. trim(sfc_name2(num)) == 'albdirnir_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & -! .or. trim(sfc_name2(num)) == 'sfalb_ice' & - .or. trim(sfc_name2(num)) == 'emis_lnd' ) then - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) - else - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) - endif + 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 - if (Model%nstf_name(1) > 0) then - mand = .false. - if (Model%nstf_name(2) ==0) mand = .true. - do num = nvar2m+1,nvar2m+nvar2o - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo - endif + 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_ruc) then ! nvar2mp =0 - do num = nvar2m+nvar2o+1, nvar2m+nvar2o+nvar2r - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) - enddo - else if (Model%lsm == Model%lsm_noahmp) then ! nvar2r =0 - mand = .true. ! actually should be true since it is after cold start - do num = nvar2m+nvar2o+1,nvar2m+nvar2o+nvar2mp - var2_p => sfc_var2(:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) - enddo + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then + !--- names of the 3D variables to save + sfc_name3(1) = 'stc' + sfc_name3(2) = 'smc' + sfc_name3(3) = 'slc' + if (Model%lsm == Model%lsm_noahmp) then + sfc_name3(4) = 'snicexy' + sfc_name3(5) = 'snliqxy' + sfc_name3(6) = 'tsnoxy' + sfc_name3(7) = 'smoiseq' + sfc_name3(8) = 'zsnsoxy' endif - nullify(var2_p) - - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then - !--- names of the 3D variables to save - sfc_name3(1) = 'stc' - sfc_name3(2) = 'smc' - sfc_name3(3) = 'slc' - if (Model%lsm == Model%lsm_noahmp) then - sfc_name3(4) = 'snicexy' - sfc_name3(5) = 'snliqxy' - sfc_name3(6) = 'tsnoxy' - sfc_name3(7) = 'smoiseq' - sfc_name3(8) = 'zsnsoxy' - endif - else if (Model%lsm == Model%lsm_ruc) then - !--- names of the 3D variables to save - sfc_name3(1) = 'tslb' - sfc_name3(2) = 'smois' - sfc_name3(3) = 'sh2o' - sfc_name3(4) = 'smfr' - sfc_name3(5) = 'flfr' - end if + else if (Model%lsm == Model%lsm_ruc) then + !--- names of the 3D variables to save + sfc_name3(1) = 'tslb' + sfc_name3(2) = 'smois' + sfc_name3(3) = 'sh2o' + sfc_name3(4) = 'smfr' + sfc_name3(5) = 'flfr' + end if - !--- register the 3D fields -! if (Model%frac_grid) then - sfc_name3(0) = 'tiice' - var3_p => sfc_var3ice(:,:,:) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain) -! endif + !--- register the 3D fields + ! if (Model%frac_grid) then + sfc_name3(0) = 'tiice' + var3_p => sfc_var3ice(:,:,:) + call register_restart_field(Sfc_restart, sfc_name3(0), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_1', 'Time '/)) + ! endif + if(Model%lsm == Model%lsm_ruc) then do num = 1,nvar3 - var3_p => sfc_var3(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p, domain=fv_domain) + var3_p => sfc_var3(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_1', 'Time '/)) enddo nullify(var3_p) + else + do num = 1,nvar3 + var3_p => sfc_var3(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_2', 'Time '/)) + enddo + nullify(var3_p) + endif - if (Model%lsm == Model%lsm_noahmp) then - mand = .true. - do num = nvar3+1,nvar3+3 - var3_p1 => sfc_var3sn(:,:,:,num) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(num), var3_p1, domain=fv_domain,mandatory=mand) - enddo - - var3_p2 => sfc_var3eq(:,:,:,7) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(7), var3_p2, domain=fv_domain,mandatory=mand) - - var3_p3 => sfc_var3zn(:,:,:,8) - id_restart = register_restart_fIeld(Sfc_restart, fn_srf, sfc_name3(8), var3_p3, domain=fv_domain,mandatory=mand) + if (Model%lsm == Model%lsm_noahmp) then + mand = .true. + do num = nvar3+1,nvar3+3 + var3_p1 => sfc_var3sn(:,:,:,num) + call register_restart_field(Sfc_restart, sfc_name3(num), var3_p1, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_3', 'Time '/),& + &is_optional=.not.mand) + enddo - nullify(var3_p1) - nullify(var3_p2) - nullify(var3_p3) - endif ! lsm = lsm_noahmp - endif + var3_p2 => sfc_var3eq(:,:,:,7) + call register_restart_field(Sfc_restart, sfc_name3(7), var3_p2, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_2', 'Time '/),& + &is_optional=.not.mand) + + var3_p3 => sfc_var3zn(:,:,:,8) + call register_restart_field(Sfc_restart, sfc_name3(8), var3_p3, dimensions=(/'xaxis_1', 'yaxis_1', 'zaxis_4', 'Time '/),& + &is_optional=.not.mand) + + nullify(var3_p1) + nullify(var3_p2) + nullify(var3_p3) + endif ! lsm = lsm_noahmp !$omp parallel do default(shared) private(i, j, nb, ix, lsoil) @@ -1993,7 +2193,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta enddo enddo - call save_restart(Sfc_restart, timestamp) + call write_restart(Sfc_restart) + call close_file(Sfc_restart) end subroutine sfc_prop_restart_write @@ -2009,7 +2210,7 @@ end subroutine sfc_prop_restart_write ! calls: register_restart_field, restart_state, free_restart ! ! opens: phys_data.tile?.nc -! +! !---------------------------------------------------------------------- subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) !--- interface variable definitions @@ -2025,7 +2226,9 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) character(len=64) :: fname real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() - + !--- directory of the input files + character(5) :: indir='INPUT' + logical :: amiopen isc = Atm_block%isc iec = Atm_block%iec @@ -2039,7 +2242,20 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) nvar3d = GFS_Restart%num3d fdiag = GFS_Restart%fdiag ldiag = GFS_Restart%ldiag - + + !--- open restart file and register axes + fname = trim(indir)//'/'//trim(fn_phy) + amiopen=open_file(Phy_restart, trim(fname), 'read', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( amiopen ) then + call register_axis(Phy_restart, 'xaxis_1', 'X') + call register_axis(Phy_restart, 'yaxis_1', 'Y') + call register_axis(Phy_restart, 'zaxis_1', npz) + call register_axis(Phy_restart, 'Time', unlimited) + else + call mpp_error(NOTE,'No physics restarts - cold starting physical parameterizations') + return + endif + !--- register the restart fields if (.not. allocated(phy_var2)) then allocate (phy_var2(nx,ny,nvar2d)) @@ -2049,28 +2265,22 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) do num = 1,nvar2d var2_p => phy_var2(:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_Restart%name2d(num)), & - var2_p, domain=fv_domain, mandatory=.false.) + call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& + &is_optional=.true.) enddo do num = 1,nvar3d var3_p => phy_var3(:,:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_restart%name3d(num)), & - var3_p, domain=fv_domain, mandatory=.false.) + call register_restart_field(Phy_restart, trim(GFS_restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/), is_optional=.true.) enddo nullify(var2_p) nullify(var3_p) endif - fname = 'INPUT/'//trim(fn_phy) - if (file_exist(fname)) then - !--- read the surface restart/data - call mpp_error(NOTE,'reading physics restart data from INPUT/phy_data.tile*.nc') - call restore_state(Phy_restart) - else - call mpp_error(NOTE,'No physics restarts - cold starting physical parameterizations') - return - endif - + !--- read the surface restart/data + call mpp_error(NOTE,'reading physics restart data from INPUT/phy_data.tile*.nc') + call read_restart(Phy_restart) + call close_file(Phy_restart) + !--- place the data into the block GFS containers !--- phy_var* variables !$omp parallel do default(shared) private(i, j, nb, ix) @@ -2093,7 +2303,7 @@ subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) j = Atm_block%index(nb)%jj(ix) - jsc + 1 GFS_Restart%data(nb,num)%var2p(ix) = zero enddo - enddo + enddo enddo endif do num = 1,nvar3d @@ -2136,7 +2346,12 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta integer :: nvar2d, nvar3d real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() - + !--- used for axis data for fms2_io + integer :: is, ie + integer, allocatable, dimension(:) :: buffer + character(7) :: indir='RESTART' + character(72) :: infile + logical :: amiopen isc = Atm_block%isc iec = Atm_block%iec @@ -2148,32 +2363,70 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta nvar2d = GFS_Restart%num2d nvar3d = GFS_Restart%num3d - !--- register the restart fields + !--- set file name + infile=trim(indir)//'/'//trim(fn_phy) + if( present(timestamp) ) infile=trim(indir)//'/'//trim(timestamp)//'.'//trim(fn_phy) + !--- register axis + amiopen=open_file(Phy_restart, trim(infile), 'overwrite', domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) + if( amiopen ) then + call register_axis(Phy_restart, 'xaxis_1', 'X') + call register_field(Phy_restart, 'xaxis_1', 'double', (/'xaxis_1'/)) + call register_variable_attribute(Phy_restart, 'xaxis_1', 'cartesian_axis', 'X', str_len=1) + call get_global_io_domain_indices(Phy_restart, 'xaxis_1', is, ie, indices=buffer) + call write_data(Phy_restart, "xaxis_1", buffer) + deallocate(buffer) + + call register_axis(Phy_restart, 'yaxis_1', 'Y') + call register_field(Phy_restart, 'yaxis_1', 'double', (/'yaxis_1'/)) + call register_variable_attribute(Phy_restart, 'yaxis_1', 'cartesian_axis', 'Y', str_len=1) + call get_global_io_domain_indices(Phy_restart, 'yaxis_1', is, ie, indices=buffer) + call write_data(Phy_restart, "yaxis_1", buffer) + deallocate(buffer) + + call register_axis(Phy_restart, 'zaxis_1', npz) + call register_field(Phy_restart, 'zaxis_1', 'double', (/'zaxis_1'/)) + call register_variable_attribute(Phy_restart, 'zaxis_1', 'cartesian_axis', 'Z', str_len=1) + allocate( buffer(npz) ) + do i=1, npz + buffer(i)=i + end do + call write_data(Phy_restart, "zaxis_1", buffer) + deallocate(buffer) + + call register_axis(Phy_restart, 'Time', unlimited) + call register_field(Phy_restart, 'Time', 'double', (/'Time'/)) + call register_variable_attribute(Phy_restart, 'Time', 'cartesian_axis', 'T', str_len=1) + call write_data(Phy_restart, "Time", 1) + else + call mpp_error(FATAL, 'Error opening file '//trim(infile)) + end if + + !--- register the restart fields if (.not. allocated(phy_var2)) then allocate (phy_var2(nx,ny,nvar2d)) allocate (phy_var3(nx,ny,npz,nvar3d)) phy_var2 = zero phy_var3 = zero - - do num = 1,nvar2d - var2_p => phy_var2(:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_Restart%name2d(num)), & - var2_p, domain=fv_domain, mandatory=.false.) - enddo - do num = 1,nvar3d - var3_p => phy_var3(:,:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_restart%name3d(num)), & - var3_p, domain=fv_domain, mandatory=.false.) - enddo - nullify(var2_p) - nullify(var3_p) endif + do num = 1,nvar2d + var2_p => phy_var2(:,:,num) + call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& + &is_optional=.true.) + enddo + do num = 1,nvar3d + var3_p => phy_var3(:,:,:,num) + call register_restart_field(Phy_restart, trim(GFS_Restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& + &is_optional=.true.) + enddo + nullify(var2_p) + nullify(var3_p) + !--- 2D variables !$omp parallel do default(shared) private(i, j, num, nb, ix) do num = 1,nvar2d do nb = 1,Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) + do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 phy_var2(i,j,num) = GFS_Restart%data(nb,num)%var2p(ix) @@ -2185,7 +2438,7 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta do num = 1,nvar3d do nb = 1,Atm_block%nblks do k=1,npz - do ix = 1, Atm_block%blksz(nb) + do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 phy_var3(i,j,k,num) = GFS_Restart%data(nb,num)%var3p(ix,k) @@ -2194,7 +2447,8 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta enddo enddo - call save_restart(Phy_restart, timestamp) + call write_restart(Phy_restart) + call close_file(Phy_restart) end subroutine phys_restart_write @@ -2321,7 +2575,7 @@ end subroutine fv3gfs_diag_register !------------------------------------------------------------------------- !--- gfs_diag_output --- !------------------------------------------------------------------------- -! routine to transfer the diagnostic data to the gfdl fms diagnostic +! routine to transfer the diagnostic data to the gfdl fms diagnostic ! manager for eventual output to the history files. ! ! calls: send_data From 7a9725669de02da89c6755f00f0d28a34ae3ed93 Mon Sep 17 00:00:00 2001 From: bensonr <6594772+bensonr@users.noreply.github.com> Date: Fri, 27 Aug 2021 11:01:59 -0400 Subject: [PATCH 2/7] brings in latest release candidate for the FV3 dycore (#377) This PR brings in the latest release candidate for the FV3 dycore for use in the UFS. This PR will change answers for regional tests as well as any test using ICs generated from specific sources to chgres (when data_source_fv3gfs=.TRUE. logical within the dycore external_ic) --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index bdb078ade..86177e14c 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit bdb078ade1e9f81755513d6dbb51b3f40fccaa41 +Subproject commit 86177e14cdf60ce53fc6ec15829a8876db0c7445 From 2fe2998e148c8aa0ff18eb5de58cb0e856b8f07b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 2 Sep 2021 19:52:22 -0600 Subject: [PATCH 3/7] sfcsub.F land-mask bug fix in ccpp-physics (#378) 1. changes in NCAR/ccpp-physics#721 (sfcsub.F land-mask bug fix) --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index cabe68f4a..1f8cf92bb 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit cabe68f4a933f72276c12c557a5d6b4a0d909d7d +Subproject commit 1f8cf92bb4d562ba1aa53966fc361fcd1331c2b3 From 967b84b8db159cb25a6dc3529c0cbaa4a2b2eca9 Mon Sep 17 00:00:00 2001 From: Bin Liu Date: Tue, 7 Sep 2021 11:48:15 -0400 Subject: [PATCH 4/7] Add a cplocn2atm namelist option to turn on/off ocean model component feedback to FV3ATM (#376) Add a cplocn2atm namelist option to turn on/off the ocean model component feedback (e.g., SST) to the atmosphere model component. --- atmos_model.F90 | 2 +- ccpp/data/GFS_typedefs.F90 | 6 +++++- ccpp/data/GFS_typedefs.meta | 6 ++++++ 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 0425b5a03..d5231aae5 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1787,7 +1787,7 @@ subroutine assign_importdata(jdat, rc) fldname = 'sea_surface_temperature' if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) - if (importFieldsValid(findex)) then + if (importFieldsValid(findex) .and. GFS_control%cplocn2atm) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 17ca800cd..fb456245b 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -631,6 +631,7 @@ module GFS_typedefs !--- coupling parameters logical :: cplflx !< default no cplflx collection logical :: cplice !< default yes cplice collection (used together with cplflx) + logical :: cplocn2atm !< default yes ocn->atm coupling logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling logical :: cplchm !< default no cplchm collection @@ -3125,6 +3126,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters logical :: cplflx = .false. !< default no cplflx collection logical :: cplice = .true. !< default yes cplice collection (used together with cplflx) + logical :: cplocn2atm = .true. !< default yes cplocn2atm coupling (turn on the feedback from ocn to atm) logical :: cplwav = .false. !< default no cplwav collection logical :: cplwav2atm = .false. !< default no cplwav2atm coupling logical :: cplchm = .false. !< default no cplchm collection @@ -3593,7 +3595,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & naux3d, aux2d_time_avg, aux3d_time_avg, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplice, cplwav, cplwav2atm, cplchm, & + cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplchm, & cpl_imp_mrg, cpl_imp_dbg, & use_cice_alb, lsidea, & !--- radiation parameters @@ -3873,6 +3875,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters Model%cplflx = cplflx Model%cplice = cplice + Model%cplocn2atm = cplocn2atm Model%cplwav = cplwav Model%cplwav2atm = cplwav2atm Model%cplchm = cplchm @@ -5465,6 +5468,7 @@ subroutine control_print(Model) print *, 'coupling parameters' print *, ' cplflx : ', Model%cplflx print *, ' cplice : ', Model%cplice + print *, ' cplocn2atm : ', Model%cplocn2atm print *, ' cplwav : ', Model%cplwav print *, ' cplwav2atm : ', Model%cplwav2atm print *, ' cplchm : ', Model%cplchm diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index dc1be40e2..d15ed56d7 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2555,6 +2555,12 @@ units = flag dimensions = () type = logical +[cplocn2atm] + standard_name = flag_for_one_way_ocean_coupling_to_atmosphere + long_name = flag controlling ocean coupling to the atmosphere (default on) + units = flag + dimensions = () + type = logical [cplwav] standard_name = flag_for_ocean_wave_coupling long_name = flag controlling cplwav collection (default off) From e5dfdd5bab32880d829ab97e642cf9559dcf3cfd Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 9 Sep 2021 19:59:03 -0600 Subject: [PATCH 5/7] CCPP metadata bugfixes in GFS_typedefs.meta, update fv3 files with fms.2021.03, IAU bug fix for restart files (#379) * CCPP metadata bugfixes in ccpp/data/GFS_typedefs.meta * fix the restart interval for iau Co-authored-by: Jun.Wang --- atmos_model.F90 | 18 ++-------------- ccpp/data/GFS_typedefs.meta | 8 +++---- ccpp/physics | 2 +- module_fcst_grid_comp.F90 | 42 +++++++++++++++++-------------------- 4 files changed, 26 insertions(+), 44 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index d5231aae5..1bec14f0b 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -47,12 +47,8 @@ module atmos_model_mod use mpp_mod, only: FATAL, mpp_min, mpp_max, mpp_error, mpp_chksum use mpp_domains_mod, only: domain2d use mpp_mod, only: mpp_get_current_pelist_name -#ifdef INTERNAL_FILE_NML use mpp_mod, only: input_nml_file -#else -use fms_mod, only: open_namelist_file -#endif -use fms_mod, only: file_exist, error_mesg +use fms2_io_mod, only: file_exists use fms_mod, only: close_file, write_version_number, stdlog, stdout use fms_mod, only: clock_flag_default use fms_mod, only: check_nml_error @@ -551,19 +547,9 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !---------------------------------------------------------------------------------------------- ! initialize atmospheric model - must happen AFTER atmosphere_init so that nests work correctly - IF ( file_exist('input.nml')) THEN -#ifdef INTERNAL_FILE_NML + IF ( file_exists('input.nml')) THEN read(input_nml_file, nml=atmos_model_nml, iostat=io) ierr = check_nml_error(io, 'atmos_model_nml') -#else - unit = open_namelist_file ( ) - ierr=1 - do while (ierr /= 0) - read (unit, nml=atmos_model_nml, iostat=io, end=10) - ierr = check_nml_error(io,'atmos_model_nml') - enddo - 10 call close_file (unit) -#endif endif !----------------------------------------------------------------------- diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index d15ed56d7..c7522a0e3 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -631,7 +631,7 @@ standard_name = surface_snow_area_fraction_over_ice long_name = surface snow area fraction over ice units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) @@ -1448,7 +1448,7 @@ standard_name = temperature_in_surface_snow_at_surface_adjacent_layer_over_land long_name = snow temperature at the bottom of the first snow layer over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme) @@ -10110,7 +10110,7 @@ standard_name = saturation_vapor_pressure long_name = saturation vapor pressure units = Pa - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys optional = F @@ -10119,7 +10119,7 @@ standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio units = kg/kg - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys optional = F diff --git a/ccpp/physics b/ccpp/physics index 1f8cf92bb..cb2b5166a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1f8cf92bb4d562ba1aa53966fc361fcd1331c2b3 +Subproject commit cb2b5166af5b5c5b284d910f36be31f67b325e8c diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 9ff27b1a6..a6e69b13a 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -24,7 +24,7 @@ module module_fcst_grid_comp use esmf use time_manager_mod, only: time_type, set_calendar_type, set_time, & - set_date, days_in_month, month_name, & + set_date, month_name, & operator(+), operator(-), operator (<), & operator (>), operator (/=), operator (/), & operator (==), operator (*), & @@ -43,22 +43,20 @@ module module_fcst_grid_comp addLsmask2grid use constants_mod, only: constants_init - use fms_mod, only: open_namelist_file, file_exist, check_nml_error, & - error_mesg, fms_init, fms_end, close_file, & + use fms_mod, only: error_mesg, fms_init, fms_end, & write_version_number, uppercase use mpp_mod, only: mpp_init, mpp_pe, mpp_root_pe, & mpp_error, FATAL, WARNING - use mpp_mod, only: mpp_clock_id, mpp_clock_begin, mpp_clock_end + use mpp_mod, only: mpp_clock_id, mpp_clock_begin - use mpp_io_mod, only: mpp_open, mpp_close, MPP_NATIVE, MPP_RDONLY, MPP_DELETE + use mpp_io_mod, only: mpp_open, mpp_close, MPP_DELETE use mpp_domains_mod, only: mpp_get_compute_domains, domain2D - use memutils_mod, only: print_memuse_stats use sat_vapor_pres_mod, only: sat_vapor_pres_init use diag_manager_mod, only: diag_manager_init, diag_manager_end, & - get_base_date, diag_manager_set_time_end + diag_manager_set_time_end use data_override_mod, only: data_override_init use fv_nggps_diags_mod, only: fv_dyn_bundle_setup @@ -359,9 +357,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if(restart_interval(2)== -1) freq_restart = .true. endif if(freq_restart) then - if(restart_interval(1) == 0) then - frestart(1) = total_inttime - else if(restart_interval(1) > 0) then + if(restart_interval(1) >= 0) then tmpvar = restart_interval(1) * 3600 atm_int_state%Time_step_restart = set_time (tmpvar, 0) if(iau_offset > 0 ) then @@ -371,16 +367,18 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) atm_int_state%Time_restart = atm_int_state%Time_init + atm_int_state%Time_step_restart frestart(1) = tmpvar endif - i = 2 - do while ( atm_int_state%Time_restart < atm_int_state%Time_end ) - frestart(i) = frestart(i-1) + tmpvar - atm_int_state%Time_restart = atm_int_state%Time_restart + atm_int_state%Time_step_restart - i = i + 1 - enddo + if(restart_interval(1) > 0) then + i = 2 + do while ( atm_int_state%Time_restart < atm_int_state%Time_end ) + frestart(i) = frestart(i-1) + tmpvar + atm_int_state%Time_restart = atm_int_state%Time_restart + atm_int_state%Time_step_restart + i = i + 1 + enddo + endif endif ! otherwise it is an array with forecast time at which the restart files will be written out else if(num_restart_interval >= 1) then - if(restart_interval(1) == 0 ) then + if(num_restart_interval == 1 .and. restart_interval(1) == 0 ) then frestart(1) = total_inttime else if(iau_offset > 0 ) then @@ -861,11 +859,11 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) !--- intermediate restart if (atm_int_state%intrm_rst>0) then if (na /= atm_int_state%num_atmos_calls-1) then - call get_time(atm_int_state%Time_atmos - atm_int_state%Time_atstart, seconds) + call get_time(atm_int_state%Time_atmos - atm_int_state%Time_init, seconds) if (ANY(frestart(:) == seconds)) then - restart_inctime = set_time(seconds, 0) - atm_int_state%Time_restart = atm_int_state%Time_atstart + restart_inctime - timestamp = date_to_string (atm_int_state%Time_restart) + if (mype == 0) write(0,*)'write out restart at na=',na,' seconds=',seconds, & + 'integration lenght=',na*dt_atmos/3600. + timestamp = date_to_string (atm_int_state%Time_atmos) call atmos_model_restart(atm_int_state%Atm, timestamp) call write_stoch_restart_atm('RESTART/'//trim(timestamp)//'.atm_stoch.res.nc') @@ -873,8 +871,6 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) endif endif endif -! - call print_memuse_stats('after full step') ! !----------------------------------------------------------------------- ! From 85c2648ced7b183f7bef2759cb1b94f72d200fe7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 14 Sep 2021 19:25:59 -0600 Subject: [PATCH 6/7] Cleanup CCPP cmake build (#383) * Clean up ccpp/CMakeLists.txt, because the associated PRs for ccpp-framework and ccpp-physics now define their targets and dependencies correctly. --- ccpp/CMakeLists.txt | 18 +++--------------- ccpp/framework | 2 +- ccpp/physics | 2 +- 3 files changed, 5 insertions(+), 17 deletions(-) diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index b41298b45..825406b85 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -4,10 +4,6 @@ project(CCPP-FV3 LANGUAGES C CXX Fortran) set(PROJECT "CCPP-FV3") -# Attempt to add link library "NetCDF::NetCDF_Fortran" to target "ccppphys" -# which is not built in this directory. -cmake_policy(SET CMP0079 NEW) - #------------------------------------------------------------------------------ # Set a default build type if none was specified if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) @@ -94,12 +90,8 @@ endif() # Build CCPP framework and physics add_subdirectory(framework) - add_subdirectory(physics) -add_dependencies(ccppphys ccpp) -target_link_libraries(ccppphys PUBLIC w3nco::w3nco_d NetCDF::NetCDF_Fortran) -# This should not be necessary once framework and physics targets define BUILD_INTERFACE -target_include_directories(ccppphys PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/framework/src) +add_dependencies(ccpp_physics ccpp_framework) #------------------------------------------------------------------------------ # Build fv3ccpp @@ -124,16 +116,12 @@ add_library( set_property(SOURCE driver/GFS_diagnostics.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "-O0") -target_link_libraries(fv3ccpp PUBLIC ccpp) -target_link_libraries(fv3ccpp PUBLIC ccppphys) +target_link_libraries(fv3ccpp PUBLIC ccpp_framework) +target_link_libraries(fv3ccpp PUBLIC ccpp_physics) if(OPENMP) target_link_libraries(fv3ccpp PUBLIC OpenMP::OpenMP_Fortran) endif() -# This should not be necessary once framework and physics targets define BUILD_INTERFACE -target_include_directories(fv3ccpp PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/framework/src - ${CMAKE_CURRENT_BINARY_DIR}/physics) - set_target_properties(fv3ccpp PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) target_include_directories(fv3ccpp PUBLIC $) diff --git a/ccpp/framework b/ccpp/framework index 922fe4494..bc1826932 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 922fe44948acddaec6bc08d2392beaa047fe2587 +Subproject commit bc18269320395826896072308f3d50cf056880ff diff --git a/ccpp/physics b/ccpp/physics index cb2b5166a..84c6144f5 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit cb2b5166af5b5c5b284d910f36be31f67b325e8c +Subproject commit 84c6144f5412fe0f1ac88e377516f8df5d00f3a7 From 3dadef98fc0eb30692714a208e695db22f70d065 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 22 Sep 2021 15:16:45 -0600 Subject: [PATCH 7/7] Revert change to .gitmodules and update submodule pointers for ccpp-framework and ccpp-physics --- .gitmodules | 12 ++++-------- ccpp/framework | 2 +- ccpp/physics | 2 +- 3 files changed, 6 insertions(+), 10 deletions(-) diff --git a/.gitmodules b/.gitmodules index e83471c89..6d2d19bb4 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,13 +4,9 @@ branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework - #url = https://github.com/NOAA-GSL/ccpp-framework - #branch = gsl/develop - url = https://github.com/climbfuji/ccpp-framework - branch = update_gsl_develop_from_main_20210921 + url = https://github.com/NOAA-GSL/ccpp-framework + branch = gsl/develop [submodule "ccpp/physics"] path = ccpp/physics - #url = https://github.com/NOAA-GSL/ccpp-physics - #branch = gsl/develop - url = https://github.com/climbfuji/ccpp-physics - branch = update_gsl_develop_from_main_20210921 + url = https://github.com/NOAA-GSL/ccpp-physics + branch = gsl/develop diff --git a/ccpp/framework b/ccpp/framework index 1c09cc21e..e0e5a9c9b 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 1c09cc21e90587036503c16c7130a80ecd054ff9 +Subproject commit e0e5a9c9be891212df14d443260773b86a5cfe47 diff --git a/ccpp/physics b/ccpp/physics index 08cd1e2ce..097597ac2 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 08cd1e2cea3672239d3074d5c5046f3ee003f811 +Subproject commit 097597ac2d41657e27e65c380beb584522b16850