From 0b8f544aebc566fad1a0e9c53cda2510e79da633 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 18 Oct 2018 12:46:55 -0600 Subject: [PATCH] Move in updates to MOM6 cap to unify with EMC --- config_src/nuopc_driver/MOM_ocean_model.F90 | 552 +++---- .../nuopc_driver/MOM_surface_forcing.F90 | 209 +-- config_src/nuopc_driver/mom_cap.F90 | 1340 ++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 6 +- config_src/nuopc_driver/mom_cap_time.F90 | 425 ++++++ 5 files changed, 1394 insertions(+), 1138 deletions(-) create mode 100644 config_src/nuopc_driver/mom_cap_time.F90 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9d40dc6638..17d66789b5 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -1,72 +1,66 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. module MOM_ocean_model ! This file is part of MOM6. See LICENSE.md for the license. -!----------------------------------------------------------------------- -! ! This is the top level module for the MOM6 ocean model. It contains routines ! for initialization, termination and update of ocean model state. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! -! Robert Hallberg -! -! -! ! This code is a stop-gap wrapper of the MOM6 code to enable it to be called ! in the same way as MOM4. -! - -use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end -use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization -use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, step_offline -use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging -use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end -use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : allocate_forcing_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields -use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing -use MOM_forcing_type, only : set_derived_forcing_fields -use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags -use MOM_get_input, only : Get_MOM_Input, directories -use MOM_grid, only : ocean_grid_type -use MOM_io, only : close_file, file_exists, read_data, write_version_number -use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart -use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing, only : forcing_save_restart -use MOM_time_manager, only : time_type, get_time, set_time, operator(>) -use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) -use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real + +use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization +use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized +use MOM, only : get_ocean_stocks, step_offline +use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf +use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : TO_ALL, Omit_Corners +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use MOM_forcing_type, only : allocate_forcing_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields +use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing +use MOM_forcing_type, only : set_derived_forcing_fields +use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags +use MOM_get_input, only : Get_MOM_Input, directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : close_file, file_exists, read_data, write_version_number +use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS +use MOM_restart, only : MOM_restart_CS, save_restart +use MOM_string_functions, only : uppercase +use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing, only : forcing_save_restart +use MOM_time_manager, only : time_type, get_time, set_time, operator(>) +use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) +use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) +use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type -use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only : ice_shelf_end, ice_shelf_save_restart -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data -use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux -use fms_mod, only : stdout -use mpp_mod, only : mpp_chksum -use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct -use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init -use MOM_wave_interface, only : MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type +use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS +use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data +use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux +use fms_mod, only : stdout +use mpp_mod, only : mpp_chksum +use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct +use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init +use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves #include @@ -77,7 +71,6 @@ module MOM_ocean_model implicit none ; private public ocean_model_init, ocean_model_end, update_ocean_model -public get_ocean_grid ! add by Jiande public ocean_model_save_restart, Ocean_stock_pe public ice_ocean_boundary_type public ocean_model_init_sfc, ocean_model_flux_init @@ -85,12 +78,15 @@ module MOM_ocean_model public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get +public get_ocean_grid +!> This interface extracts a named scalar field or array from the ocean surface or public type interface ocean_model_data_get module procedure ocean_model_data1D_get module procedure ocean_model_data2D_get end interface + !> This type is used for communication with other components via the FMS coupler. !! The element names and types can be changed only with great deliberation, hence !! the persistnce of things like the cutsy element name "avg_kount". @@ -98,15 +94,14 @@ module MOM_ocean_model type(domain2d) :: Domain !< The domain for the surface fields. logical :: is_ocean_pe !< .true. on processors that run the ocean model. character(len=32) :: instance_name = '' !< A name that can be used to identify - !! this instance of an ocean model, for example - !! in ensembles when writing messages. + !! this instance of an ocean model, for example + !! in ensembles when writing messages. integer, pointer, dimension(:) :: pelist => NULL() !< The list of ocean PEs. logical, pointer, dimension(:,:) :: maskmap =>NULL() !< A pointer to an array - !! indicating which logical processors are actually - !! used for the ocean code. The other logical - !! processors would be all land points and are not - !! assigned to actual processors. This need not be - !! assigned if all logical processors are used. + !! indicating which logical processors are actually used for + !! the ocean code. The other logical processors would be all + !! land points and are not assigned to actual processors. + !! This need not be assigned if all logical processors are used. integer :: stagger = -999 !< The staggering relative to the tracer points !! points of the two velocity components. Valid entries @@ -221,20 +216,17 @@ module MOM_ocean_model contains -!======================================================================= -! -! -! -! Initialize the ocean model. -! - !> ocean_model_init initializes the ocean model, including registering fields !! for restarts and reading restart files if appropriate. +!! +!! This subroutine initializes both the ocean state and the ocean surface type. +!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! been used in a previous call to initialize_ocean_type. subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, input_restart_file) type(ocean_public_type), target, & - intent(inout) :: Ocean_sfc !< A structure containing various - !! publicly visible ocean surface properties after initialization, - !! the data in this type is intent(out). + intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, + !! the data in this type is intent out. type(ocean_state_type), pointer :: OS !< A structure whose internal !! contents are private to ocean_model_mod that may be used to !! contain all information about the ocean's interior state. @@ -247,14 +239,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. character(len=*), optional, intent(in) :: input_restart_file !< If present, name of restart file to read - -! This subroutine initializes both the ocean state and the ocean surface type. -! Because of the way that indicies and domains are handled, Ocean_sfc must have -! been used in a previous call to initialize_ocean_type. - + ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. @@ -411,17 +398,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call callTree_leave("ocean_model_init(") end subroutine ocean_model_init -! NAME="ocean_model_init" - - -!======================================================================= -! -! -! -! Update in time the ocean model fields. This code wraps the call to step_MOM -! with MOM4's call. -! -! !> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the !! ocean model's state from the input value of Ocean_state (which must be for @@ -452,33 +428,32 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the !! cumulative thermodynamic fluxes from the ocean, !! like frazil, have been used and should be reset. - - ! local variables - type(time_type) :: Master_time !< This allows step_MOM to temporarily change - !! the time that is seen by internal modules. - type(time_type) :: Time1 !< The value of the ocean model's time at the - !! start of a call to step_MOM. - integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocn boundary type - real :: weight !< Flux accumulation weight - real :: dt_coupling !< The coupling time step in seconds. - - integer :: nts ! The number of baroclinic dynamics time steps - ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + ! Local variables + type(time_type) :: Master_time ! This allows step_MOM to temporarily change + ! the time that is seen by internal modules. + type(time_type) :: Time1 ! The value of the ocean model's time at the + ! start of a call to step_MOM. + integer :: index_bnds(4) ! The computational domain index bounds in the + ! ice-ocean boundary type. + real :: weight ! Flux accumulation weight + real :: dt_coupling ! The coupling time step in seconds. + integer :: nts ! The number of baroclinic dynamics time steps + ! within dt_coupling. + real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) + real :: dt_dyn ! The dynamics time step in sec. + real :: dtdia ! The diabatic time step in sec. + real :: t_elapsed_seg ! The elapsed time in this update segment, in s. integer :: n, n_max, n_last_thermo - type(time_type) :: Time2 ! A temporary time. + type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans ! multiple dynamic timesteps. - logical :: do_dyn ! If true, step the ocean dynamics and transport. - logical :: do_thermo ! If true, step the ocean thermodynamics. - logical :: step_thermo ! If true, take a thermodynamic step. + logical :: do_dyn ! If true, step the ocean dynamics and transport. + logical :: do_thermo ! If true, step the ocean thermodynamics. + logical :: step_thermo ! If true, take a thermodynamic step. integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") + call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -512,19 +487,24 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%grid, OS%forcing_CSp) if (OS%fluxes%fluxes_used) then - - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, & OS%restore_salinity, OS%restore_temp) ! Add ice shelf fluxes if (OS%use_ice_shelf) then + if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif @@ -538,34 +518,36 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. OS%fluxes%dt_buoy_accum = dt_coupling - else - OS%flux_tmp%C_p = OS%fluxes%C_p - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_thermo) & + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types - ! are time-averages must be copied back to the forces type. + ! (e.g., ustar) are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) #ifdef _USE_GENERIC_TRACER call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif - endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) @@ -673,130 +655,85 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call callTree_leave("update_ocean_model()") end subroutine update_ocean_model -! NAME="update_ocean_model" - -!======================================================================= -! -! -! -! write out restart file. -! Arguments: -! timestamp (optional, intent(in)) : A character string that represents the model time, -! used for writing restart. timestamp will prepend to -! the any restart file name as a prefix. -! +!> This subroutine writes out the ocean model restart file. subroutine ocean_model_restart(OS, timestamp, restartname) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state being saved to a restart file - character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be - !! prepended to the file name. (Currently this is unused.) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state being saved to a restart file + character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be + !! prepended to the file name. (Currently this is unused.) character(len=*), optional, intent(in) :: restartname !< Name of restart file to use - !! This option distinguishes the cesm interface from the - !! non-cesm interface + !! This option distinguishes the cesm interface from the + !! non-cesm interface if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") if (present(restartname)) then - - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname) - - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir) ! Is this needed? - - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) - endif - + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV, filename=restartname) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) ! Is this needed? + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, & + OS%dirs%restart_output_dir) + endif else - - if (BTEST(OS%Restart_control,1)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, .true., GV=OS%GV) - - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir, .true.) - - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) - endif - endif - - if (BTEST(OS%Restart_control,0)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV) - - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir) - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) - endif - endif - - end if + if (BTEST(OS%Restart_control,1)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, .true., GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir, .true.) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) + endif + endif + if (BTEST(OS%Restart_control,0)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) + endif + endif + endif end subroutine ocean_model_restart ! NAME="ocean_model_restart" -!======================================================================= -! -! -! -! Close down the ocean model. Terminate the model run, optionally -! saving the ocean state in a restart file and deallocating any data -! associated with the ocean. - -! Arguments: Ocean_sfc - An ocean_public_type structure that is to be -! deallocated upon termination. -! (inout) Ocean_state - A pointer to the structure containing the internal -! ocean state to be deallocated upon termination. -! (in) Time - The model time, used for writing restarts. -! (in) write_restart - Write restart file if true -! +!> ocean_model_end terminates the model run, saving the ocean state in a restart +!! and deallocating any data associated with the ocean. subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) - type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is - !! to be deallocated upon termination. - type(ocean_state_type), pointer :: Ocean_state !< A pointer to the structure containing - !! the internal ocean state to be deallocated - !! upon termination. - type(time_type), intent(in) :: Time !< The model time, used for writing restarts. + type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is + !! to be deallocated upon termination. + type(ocean_state_type), pointer :: Ocean_state !< A pointer to the structure containing + !! the internal ocean state to be deallocated + !! upon termination. + type(time_type), intent(in) :: Time !< The model time, used for writing restarts. logical, intent(in) :: write_restart !< true => write restart file - if (write_restart) then - call ocean_model_save_restart(Ocean_state, Time) - end if + call ocean_model_save_restart(Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) - end subroutine ocean_model_end -! NAME="ocean_model_end" -!======================================================================= !> ocean_model_save_restart causes restart files associated with the ocean to be !! written out. subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state (in). - type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. - character(len=*), optional, intent(in) :: directory !< An optional directory into which to - !! write these restart files. + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (in). + type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. + character(len=*), optional, intent(in) :: directory !< An optional directory into which to + !! write these restart files. character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-stamp) - !! to append to the restart file names. -! Arguments: Ocean_state - A structure containing the internal ocean state (in). -! (in) Time - The model time at this call. This is needed for mpp_write calls. -! (in, opt) directory - An optional directory into which to write these restart files. -! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append -! to the restart file names. - + !! to append to the restart file names. ! Note: This is a new routine - it will need to exist for the new incremental ! checkpointing. It will also be called by ocean_model_end, giving the same ! restart behavior as now in FMS. @@ -806,16 +743,12 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") - if (present(directory)) then - restart_dir = directory - else - restart_dir = OS%dirs%restart_output_dir - endif + if (present(directory)) then ; restart_dir = directory + else ; restart_dir = OS%dirs%restart_output_dir ; endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) @@ -827,15 +760,17 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) end subroutine ocean_model_save_restart -!======================================================================= - +!> Initialize the public ocean type subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & gas_fields_ocn) - type(domain2D), intent(in) :: input_domain - type(ocean_public_type), intent(inout) :: Ocean_sfc - type(diag_ctrl), intent(in) :: diag + type(domain2D), intent(in) :: input_domain !< The ocean model domain description + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements are allocated here. + type(diag_ctrl), intent(in) :: diag !< A structure that regulates diagnsotic output logical, dimension(:,:), & - optional, intent(in) :: maskmap + optional, intent(in) :: maskmap !< A mask indicating which virtual processors + !! are actually in use. If missing, all are used. type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the !! ocean and surface-ice fields that will participate @@ -850,9 +785,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, call mpp_get_layout(input_domain,layout) call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) if (PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) endif call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) @@ -880,22 +815,23 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, end subroutine initialize_ocean_public_type -!======================================================================= -! This subroutine translates the coupler's ocean_data_type into MOM's -! surface state variable. This may eventually be folded into the MOM -! code that calculates the surface state in the first place. -! Note the offset in the arrays because the ocean_data_type has no -! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & - patm, press_to_z) - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. +!> This subroutine translates the coupler's ocean_data_type into MOM's +!! surface state variable. This may eventually be folded into the MOM +!! code that calculates the surface state in the first place. +!! Note the offset in the arrays because the ocean_data_type has no +!! halo points in its arrays and always uses absolute indicies. +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. type(ocean_public_type), & - target, intent(inout) :: Ocean_sfc - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, optional, intent(in) :: patm(:,:) - real, optional, intent(in) :: press_to_z - + target, intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface fields, whose elements + !! have their data set here. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. + real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and + !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. + ! Local variables real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -955,13 +891,17 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & if (Ocean_sfc%stagger == AGRID) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0)) - Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0) * 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0)) + Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == BGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0) * 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1)) - Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0) * 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1)) + Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == CGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd @@ -984,20 +924,15 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & end subroutine convert_state_to_ocean_type -!======================================================================= -! -! -! -! This subroutine extracts the surface properties from the ocean's internal -! state and stores them in the ocean type returned to the calling ice model. -! It has to be separate from the ocean_initialization call because the coupler -! module allocates the space for some of these variables. -! - +!> This subroutine extracts the surface properties from the ocean's internal +!! state and stores them in the ocean type returned to the calling ice model. +!! It has to be separate from the ocean_initialization call because the coupler +!! module allocates the space for some of these variables. subroutine ocean_model_init_sfc(OS, Ocean_sfc) - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(inout) :: Ocean_sfc - + type(ocean_state_type), pointer :: OS !< The structure with the complete ocean state + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements have their data set here. integer :: is, ie, js, je is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -1009,9 +944,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) end subroutine ocean_model_init_sfc -! -!======================================================================= !> ocean_model_flux_init is used to initialize properties of the air-sea fluxes !! as determined by various run-time parameters. It can be called from !! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely @@ -1035,17 +968,13 @@ subroutine ocean_model_flux_init(OS, verbosity) end subroutine ocean_model_flux_init -!======================================================================= -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! Ocean_stock_pe - returns stocks of heat, water, etc. for conservation checks.! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Ocean_stock_pe - returns the integrated stocks of heat, water, etc. for conservation checks. !! Because of the way FMS is coded, only the root PE has the integrated amount, !! while all other PEs get 0. subroutine Ocean_stock_pe(OS, index, value, time_index) use stock_constants_mod, only : ISTOCK_WATER, ISTOCK_HEAT,ISTOCK_SALT type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state. - !! The data in OS is intent(in). + !! The data in OS is intent in. integer, intent(in) :: index !< The stock index for the quantity of interest. real, intent(out) :: value !< Sum returned for the conservation quantity of interest. integer, optional, intent(in) :: time_index !< An unused optional argument, present only for @@ -1081,13 +1010,18 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) end subroutine Ocean_stock_pe -subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) +!> This subroutine extracts a named 2-D field from the ocean surface or public type +subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) use MOM_constants, only : CELSIUS_KELVIN_OFFSET - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real, dimension(isc:,jsc:), intent(out):: array2D - integer , intent(in) :: isc,jsc + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must + !! cover only the computational domain + integer , intent(in) :: isc !< The starting i-index of array2D + integer , intent(in) :: jsc !< The starting j-index of array2D integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j @@ -1105,23 +1039,23 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result ! do j=g_jsc,g_jec ; do i=g_isc,g_iec ! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) ! enddo ; enddo case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('btfHeat') - array2D(isc:,jsc:) = 0 + array2D(isc:,jsc:) = 0 case('tlat') array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') @@ -1143,37 +1077,40 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) case('sin_rot') array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default - call MOM_error(FATAL,'ocean_model_data2D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select - end subroutine ocean_model_data2D_get -subroutine ocean_model_data1D_get(OS,Ocean, name, value) - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real , intent(out):: value +!> This subroutine extracts a named scalar field from the ocean surface or public type +subroutine ocean_model_data1D_get(OS, Ocean, name, value) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real , intent(out):: value !< The value of the named field if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return select case(name) case('c_p') - value = OS%C_p + value = OS%C_p case default - call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) end select - end subroutine ocean_model_data1D_get +!> Write out FMS-format checsums on fields from the ocean surface state subroutine ocean_public_type_chksum(id, timestep, ocn) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ocean_public_type), intent(in) :: ocn - integer :: n,m, outunit + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ocean_public_type), intent(in) :: ocn !< A structure containing various publicly + !! visible ocean surface fields. + integer :: n, m, outunit outunit = stdout() @@ -1190,21 +1127,14 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) end subroutine ocean_public_type_chksum -!####################################################################### -! -! -! -! Obtain the ocean grid. -! -! subroutine get_ocean_grid(OS, Gridp) + ! Obtain the ocean grid. type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp + type(ocean_grid_type) , pointer :: Gridp Gridp => OS%grid return - end subroutine get_ocean_grid -! NAME="get_ocean_grid" end module MOM_ocean_model + diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index e601e83347..19a0ddbf86 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -45,9 +45,7 @@ module MOM_surface_forcing #include -public IOB_allocate -public convert_IOB_to_fluxes -public convert_IOB_to_forces +public convert_IOB_to_fluxes, convert_IOB_to_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -63,9 +61,6 @@ module MOM_surface_forcing logical :: use_temperature ! If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - ! smg: remove when have A=B code reconciled - logical :: bulkmixedlayer ! If true, model based on bulk mixed layer code - real :: Rho0 ! Boussinesq reference density (kg/m^3) real :: area_surf = -1.0 ! total ocean surface area (m^2) real :: latent_heat_fusion ! latent heat of fusion (J/kg) @@ -116,7 +111,7 @@ module MOM_surface_forcing logical :: adjust_net_srestore_by_scaling ! adjust srestore w/o moving zero contour logical :: adjust_net_fresh_water_to_zero ! adjust net surface fresh-water (w/ restoring) to zero logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW - logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour + logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour logical :: mask_srestore_under_ice ! If true, use an ice mask defined by frazil ! criteria for salinity restoring. real :: ice_salt_concentration ! salt concentration for sea ice (kg/kg) @@ -205,8 +200,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model - type(forcing), intent(inout) :: fluxes !< A structure containing pointers to - !! all possible mass, heat or salt flux forcing fields. + type(forcing), intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the @@ -215,12 +210,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the - !! surface state of the ocean. + !! surface state of the ocean. logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - ! local variables real, dimension(SZI_(G),SZJ_(G)) :: & data_restore, & ! The surface value toward which to restore (g/kg or degC) SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value (deg C) @@ -477,7 +471,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) if (associated(IOB%sw_flux_nir_dif)) & fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) - fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) @@ -496,6 +489,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) enddo ; enddo endif + fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. endif ! more salt restoring logic @@ -649,6 +643,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) endif + forces%accumulate_rigidity = .true. ! Multiple components may contribute to rigidity. if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 @@ -665,7 +660,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif + else + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = 0.0 + forces%p_surf(i,j) = 0.0 + enddo ; enddo endif + forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. wind_stagger = CS%wind_stagger if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & @@ -843,58 +844,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -subroutine IOB_allocate(IOB, isc, iec, jsc, jec) - - type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive - integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size - - allocate ( IOB% u_flux (isc:iec,jsc:jec), & - IOB% v_flux (isc:iec,jsc:jec), & - IOB% t_flux (isc:iec,jsc:jec), & - IOB% q_flux (isc:iec,jsc:jec), & - IOB% salt_flux (isc:iec,jsc:jec), & - IOB% lw_flux (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dir (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dif (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dir (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dif (isc:iec,jsc:jec), & - IOB% lprec (isc:iec,jsc:jec), & - IOB% fprec (isc:iec,jsc:jec), & - IOB% runoff (isc:iec,jsc:jec), & - IOB% ustar_berg (isc:iec,jsc:jec), & - IOB% area_berg (isc:iec,jsc:jec), & - IOB% mass_berg (isc:iec,jsc:jec), & - IOB% calving (isc:iec,jsc:jec), & - IOB% runoff_hflx (isc:iec,jsc:jec), & - IOB% calving_hflx (isc:iec,jsc:jec), & - IOB% mi (isc:iec,jsc:jec), & - IOB% p (isc:iec,jsc:jec)) - - IOB%u_flux = 0.0 - IOB%v_flux = 0.0 - IOB%t_flux = 0.0 - IOB%q_flux = 0.0 - IOB%salt_flux = 0.0 - IOB%lw_flux = 0.0 - IOB%sw_flux_vis_dir = 0.0 - IOB%sw_flux_vis_dif = 0.0 - IOB%sw_flux_nir_dir = 0.0 - IOB%sw_flux_nir_dif = 0.0 - IOB%lprec = 0.0 - IOB%fprec = 0.0 - IOB%runoff = 0.0 - IOB%ustar_berg = 0.0 - IOB%area_berg = 0.0 - IOB%mass_berg = 0.0 - IOB%calving = 0.0 - IOB%runoff_hflx = 0.0 - IOB%calving_hflx = 0.0 - IOB%mi = 0.0 - IOB%p = 0.0 - -end subroutine IOB_allocate - - !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -998,23 +947,19 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments +!> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to surface_forcing_init type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(time_type), intent(in) :: Time - character(len=*), intent(in) :: directory - logical, optional, intent(in) :: time_stamped - character(len=*), optional, intent(in) :: filename_suffix -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. -! (in) G - The ocean's grid structure. -! (in) Time - The model time at this call. This is needed for mpp_write calls. -! (in, opt) directory - An optional directory into which to write these restart files. -! (in, opt) time_stamped - If true, the restart file names include -! a unique time stamp. The default is false. -! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append -! to the restart file names. + type(time_type), intent(in) :: Time !< The current model time + character(len=*), intent(in) :: directory !< The directory into which to write the + !! restart files + logical, optional, intent(in) :: time_stamped !< If true, the restart file names include + !! a unique time stamp. The default is false. + character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time- + !! stamp) to append to the restart file names. if (.not.associated(CS)) return if (.not.associated(CS%restart_CSp)) return @@ -1022,22 +967,21 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart +!> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(surface_forcing_CS), pointer :: CS - logical, optional, intent(in) :: restore_salt, restore_temp -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in) restore_salt - If present and true, salinity restoring will be -! applied in this model. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate + !! diagnostic output + type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + logical, optional, intent(in) :: restore_salt !< If present and true surface salinity + !! restoring will be applied in this model. + logical, optional, intent(in) :: restore_temp !< If present and true surface temperature + !! restoring will be applied in this model. + + ! Local variables real :: utide ! The RMS tidal velocity, in m s-1. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags @@ -1129,11 +1073,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "limited by max_p_surf instead of the full atmospheric \n"//& "pressure.", default=.true.) -! smg: should get_param call should be removed when have A=B code reconciled. -! this param is used to distinguish how to diagnose surface heat content from water. - call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, & - default=CS%use_temperature,do_not_log=.true.) - call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the \n"//& "staggering of the input wind stress field. Valid \n"//& @@ -1209,7 +1148,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "The name of the surface temperature variable to read from "//& "SST_RESTORE_FILE for restoring sst.", & default="temp") -! Convert CS%Flux_const from m day-1 to m s-1. + ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & @@ -1360,13 +1299,14 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init +!> Clean up and deallocate any memory associated with this module and its children. subroutine surface_forcing_end(CS, fluxes) - type(surface_forcing_CS), pointer :: CS - type(forcing), optional, intent(inout) :: fluxes -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init, it will be deallocated here. -! (inout) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by + !! a previous call to surface_forcing_init, it will + !! be deallocated here. + type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. + !! If present, it will be deallocated here. if (present(fluxes)) call deallocate_forcing_type(fluxes) @@ -1377,40 +1317,43 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end +!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_ocean_boundary_type), intent(in) :: iobt - integer :: n,m, outunit - - outunit = stdout() - - write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep - write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux ) - write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux ) - write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux ) - write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux ) - write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux ) - write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux ) - write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir) - write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif) - write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir) - write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif) - write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec ) - write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec ) - write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff ) - write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) - write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) - if (associated(iobt%ustar_berg)) & - write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) - if (associated(iobt%area_berg)) & - write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) - if (associated(iobt%mass_berg)) & - write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ice_ocean_boundary_type), & + intent(in) :: iobt !< An ice-ocean boundary type with fluxes to drive the + !! ocean in a coupled model whose checksums are reported + integer :: n,m, outunit + + outunit = stdout() + + write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep + write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux ) + write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux ) + write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux ) + write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux ) + write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux ) + write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux ) + write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir) + write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif) + write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir) + write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif) + write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec ) + write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec ) + write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff ) + write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) + write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) + if (associated(iobt%ustar_berg)) & + write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) + if (associated(iobt%area_berg)) & + write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) + if (associated(iobt%mass_berg)) & + write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) - call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') + call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') end subroutine ice_ocn_bnd_type_chksum diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 9aa394bce3..d638b82b94 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -363,7 +363,6 @@ !! module mom_cap_mod use constants_mod, only: constants_init - use data_override_mod, only: data_override_init, data_override use diag_manager_mod, only: diag_manager_init, diag_manager_end use field_manager_mod, only: field_manager_init, field_manager_end use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error @@ -387,7 +386,6 @@ module mom_cap_mod use time_manager_mod, only: date_to_string use time_manager_mod, only: fms_get_calendar_type => get_calendar_type use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - use MOM_surface_forcing, only: IOB_allocate use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var @@ -397,25 +395,22 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid + use mom_cap_time, only: AlarmInit #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export - use shr_nuopc_scalars_mod, only: flds_scalar_name, flds_scalar_num - use shr_nuopc_scalars_mod, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel - use shr_nuopc_time_mod, only: shr_nuopc_time_alarmInit - use, intrinsic :: iso_fortran_env, only: output_unit #endif - use ESMF ! TODO: only: ... - use NUOPC ! TODO: only: ... - use NUOPC_Model, & ! TODO: only: ... + use, intrinsic :: iso_fortran_env, only: output_unit + + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & - model_label_DataInitialize => label_DataInitialize, & model_label_Advance => label_Advance, & -#ifdef CESMCOUPLED + model_label_DataInitialize => label_DataInitialize, & model_label_SetRunClock => label_SetRunClock, & -#endif model_label_Finalize => label_Finalize use time_utils_mod, only: esmf2fms_time @@ -453,20 +448,16 @@ module mom_cap_mod integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr - integer :: dbrc type(ESMF_Grid) :: mom_grid_i - -#ifdef CESMCOUPLED - logical :: write_diagnostics = .false. - integer :: logunit ! stdout logging unit number - character(len=32) :: runtype ! run type -#else - logical :: write_diagnostics = .true. -#endif - logical :: profile_memory = .true. - logical :: grid_attach_area = .false. - integer(ESMF_KIND_I8) :: restart_interval - logical :: sw_decomp + logical :: write_diagnostics = .false. + character(len=32) :: runtype ! run type + integer :: logunit ! stdout logging unit number + logical :: profile_memory = .true. + logical :: grid_attach_area = .false. + character(len=128) :: scalar_field_name + integer :: scalar_field_count + integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -504,13 +495,13 @@ subroutine SetServices(gcomp, rc) ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -534,7 +525,6 @@ subroutine SetServices(gcomp, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -546,7 +536,6 @@ subroutine SetServices(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out -#endif call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & specRoutine=ocean_model_finalize, rc=rc) @@ -576,71 +565,159 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=10) :: value + logical :: isPresent, isSet + integer :: iostat + character(len=64) :: value, logmsg character(len=*),parameter :: subname='(mom_cap:InitializeP0)' rc = ESMF_SUCCESS - ! Switch to IPDv01 by filtering all other phaseMap entries + ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv01p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - 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 ! bail out - ! write_diagnostics=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + acceptStringList=(/"IPDv03p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + write_diagnostics = .false. + call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") + + write(logmsg,*) write_diagnostics + call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + profile_memory = .false. + call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) profile_memory=(trim(value)=="true") + write(logmsg,*) profile_memory + call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + grid_attach_area = .false. + call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") + write(logmsg,*) grid_attach_area + call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + scalar_field_name = "" + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + scalar_field_name = trim(value) + call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - profile_memory=(trim(value)/="false") - call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + scalar_field_count = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_count + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldCount not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_count + call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif -#ifndef CESMCOUPLED - ! Retrieve restart_interval in (seconds) - ! A restart_interval value of 0 means no restart will be written. - call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - restart_interval = ESMF_UtilString2Int(value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + scalar_field_idx_grid_nx = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_nx + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif - if(restart_interval < 0) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + scalar_field_idx_grid_ny = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_ny + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif - call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) -#endif - call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) + call NUOPC_CompAttributeAdd(gcomp, & + attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - grid_attach_area=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - + line=__LINE__, & + file=__FILE__)) & + return + end subroutine !=============================================================================== @@ -656,7 +733,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance, shr_nuopc_utils_ChkErr type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -680,29 +756,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom integer :: i,n - character(80) :: stdname, shortname -#ifdef CESMCOUPLED - integer :: nflds + character(len=256) :: stdname, shortname character(len=32) :: starttype ! model start type character(len=512) :: diro character(len=512) :: logfile - character(len=64) :: cvalue - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - logical :: isPresent - character(len=384) :: restart_pointer_file ! File name for restart pointer file - character(len=384) :: restartfile ! Path/Name of restart file - character(len=384) :: restartname ! The restart file name (no dir) - integer :: nu ! i/o unit to read pointer file -#endif - - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + character(ESMF_MAXSTR) :: cvalue + logical :: isPresent, isPresentDiro, isPresentLogfile, isSet + logical :: existflag + integer :: userRc + character(len=512) :: restartfile ! Path/Name of restart file + character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' !-------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer allocate(ocean_public) @@ -752,92 +825,170 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) -#ifdef CESMCOUPLED - - ! determine instance information - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "OCN"//trim(inst_suffix) + ! rsd need to figure out how to get this without share code + !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file - if(is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + if (is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + isPresent=isPresentDiro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & + isPresent=isPresentLogfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresentDiro .and. isPresentLogfile) then + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + else + logunit = output_unit + endif else logunit = output_unit endif - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + starttype = "" + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) starttype + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(cvalue,*) starttype + else + call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + runtype = "" if (trim(starttype) == trim('startup')) then - runtype = "initial" + runtype = "initial" else if (trim(starttype) == trim('continue') ) then - runtype = "continue" + runtype = "continue" else if (trim(starttype) == trim('branch')) then - runtype = "continue" - else - call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + runtype = "continue" + else if (len_trim(starttype) > 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": unknown starttype - "//trim(starttype), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + if (len_trim(runtype) > 0) then + call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + restartfile = "" if (runtype == "initial") then - - ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') - - - else ! hybrid or branch or continuos runs - - ! read name of restart file in the pointer file - nu = shr_file_getUnit() - restart_pointer_file = 'rpointer.ocn' - if (is_root_pe()) then - write(logunit,*) 'Reading ocn pointer file: ',restart_pointer_file - end if - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile - close(nu) - - ! initialize from restart file - if (is_root_pe()) then - write(logunit,*) 'Reading restart file: ',trim(restartfile) - end if - call shr_file_freeUnit(nu) - - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) + ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml + restartfile = "n" + else if (runtype == "continue") then ! hybrid or branch or continuos runs + + ! optionally call into system-specific implementation to get restart file name + call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + restartfile = trim(cvalue) + call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + else + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif end if - call ocean_model_init_sfc(ocean_state, ocean_public) - -#else - + ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time) - -#endif + if (len_trim(restartfile) > 0) then + call ocean_model_init(ocean_public, ocean_state, Time, Time, & + input_restart_file=trim(restartfile)) + else + call ocean_model_init(ocean_public, ocean_state, Time, Time) + endif - !tcx tcraig This results in errors in CESM with help from Alper - ! FATAL error "MPP_OPEN: error in OPEN for data_table" - ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE - !tcx call data_override_init(ocean_domain_in = ocean_public%domain) + call ocean_model_init_sfc(ocean_state, ocean_public) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) - - call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -849,13 +1000,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -867,7 +1020,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -884,7 +1037,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -908,11 +1061,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_co2a - ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_co2c - ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! if (flds_co2a .or. flds_co2c) then ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") @@ -920,11 +1073,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) ice_ncat - ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_i2o_per_cat - ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! if (flds_i2o_per_cat) then ! do num = 1, ice_ncat ! name = 'Si_ifrac_' // cnum @@ -942,7 +1095,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! end do !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf @@ -950,7 +1105,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used @@ -960,7 +1115,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1043,19 +1198,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return ! bail out enddo - ! When running mom6 solo, the rotation angles are not computed internally - ! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; - ! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot - ! The rotation angles are retrieved during run time to rotate incoming - ! and outgoing vectors - ! call calculate_rot_angle(ocean_state, ocean_public) - ! tcraig, this is handled fine internally and if not, then later call this - ! call initialize_grid_rotation_angle(ocean_grid, PF) - - write(*,*) '----- MOM initialization phase Advertise completed' -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif end subroutine InitializeAdvertise !=============================================================================== @@ -1111,21 +1253,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Field) :: field_t_surf integer :: mpicom integer :: localPet -#ifdef CESMCOUPLED - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - character(len=64) :: cvalue - logical :: isPresent -#endif - character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- rc = ESMF_SUCCESS + #ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) #endif + !---------------------------------------------------------------------------- ! Get pointers to ocean internal state !---------------------------------------------------------------------------- @@ -1162,8 +1298,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1171,16 +1311,20 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe if (ntiles /= 1) then rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1189,11 +1333,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) call mpp_get_pelist(ocean_public%domain, pe) if (debug > 0) then - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + enddo end if + !--------------------------------- ! create delayout and distgrid @@ -1211,11 +1360,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deBlockList(2,2,n) = ye(n) petMap(n) = pe(n) ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side enddo @@ -1225,6 +1374,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out + ! rsd this assumes tripole grid, but sometimes in CESM a bipole + ! grid is used -- need to introduce conditional logic here + allocate(connectionList(2)) ! bipolar boundary condition at top row: nyg @@ -1269,17 +1421,25 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out allocate(indexList(cnt)) write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1389,20 +1549,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ubnd4 = ubound(dataPtr_xcor,2) write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif allocate(ofld(isc:iec,jsc:jec)) @@ -1410,10 +1569,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1425,10 +1584,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if(grid_attach_area) then call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1440,10 +1599,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1455,10 +1614,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1469,10 +1628,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 j1 = j - lbnd4 + jsc - 1 @@ -1492,17 +1651,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) enddo enddo ! MOM6 runs on C-Grid. call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 j1 = j - lbnd4 + jsc - 1 @@ -1519,29 +1678,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) enddo enddo write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if(grid_attach_area) then write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) endif write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) deallocate(gfld) @@ -1564,21 +1723,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED - call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, localPet, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, localPet, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif + if (len_trim(scalar_field_name) > 0) then + call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1618,18 +1777,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deallocate(ofld) endif -! tcraig, turn this off for now, have issues with overwriting failures -! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & -! timeslice=1, relaxedFlag=.true., rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - write(*,*) '----- MOM initialization phase Realize completed' -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif + !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & + ! timeslice=1, relaxedFlag=.true., rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + end subroutine InitializeRealize !=============================================================================== @@ -1670,11 +1824,13 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) +#ifdef CESMCOUPLED call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out +#endif call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1737,6 +1893,8 @@ subroutine ModelAdvance(gcomp, rc) integer, intent(out) :: rc ! local variables + integer :: userRc + logical :: existflag, isPresent, isSet type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm type(ESMF_State) :: importState, exportState @@ -1757,15 +1915,10 @@ subroutine ModelAdvance(gcomp, rc) integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 integer :: nc -#ifdef CESMCOUPLED type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute - integer :: nu ! i/o unit to write pointer file - character(ESMF_MAXSTR) :: cvalue - character(ESMF_MAXSTR) :: runid ! Run ID - character(len=384) :: restartname ! restart file name (no dir) - character(len=384) :: restart_pointer_file ! file name for restart pointer file -#else + character(ESMF_MAXSTR) :: restartname, cvalue +#ifndef CESMCOUPLED real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) @@ -1784,9 +1937,11 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + #ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) #endif + ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) @@ -1849,10 +2004,6 @@ subroutine ModelAdvance(gcomp, rc) Time_step_coupled = esmf2fms_time(timeStep) dt_cpld = dth*3600+dtm*60+dts - call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - - call external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - if(write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & timeslice=import_slice, relaxedFlag=.true., rc=rc) @@ -1870,7 +2021,6 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED - ! Reset shr logging to my log file call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -1914,16 +2064,24 @@ subroutine ModelAdvance(gcomp, rc) dataPtr_evap = - dataPtr_evap dataPtr_sensi = - dataPtr_sensi + print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc +! j1 = j - lbnd2 + jsc ! work around local vs global indexing +! i1 = i - lbnd1 + isc + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 +! mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & +! + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) +! mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & +! - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -1931,22 +2089,22 @@ subroutine ModelAdvance(gcomp, rc) deallocate(mzmf, mmmf) !Optionally write restart files when currTime-startTime is integer multiples of restart_interval - if (restart_interval > 0 ) then - time_elapsed = currTime - startTime - call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - n_interval = time_elapsed_sec / restart_interval - if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - time_restart_current = esmf2fms_time(currTime) - timestamp = date_to_string(time_restart_current) - call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) - write(*,*) 'calling ocean_model_restart' - call ocean_model_restart(ocean_state, timestamp) - endif - endif +! if (restart_interval > 0 ) then +! time_elapsed = currTime - startTime +! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! n_interval = time_elapsed_sec / restart_interval +! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then +! time_restart_current = esmf2fms_time(currTime) +! timestamp = date_to_string(time_restart_current) +! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) +! write(*,*) 'calling ocean_model_restart' +! call ocean_model_restart(ocean_state, timestamp) +! endif +! endif #endif ! Update MOM6 @@ -1956,75 +2114,15 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! If restart alarm is ringing - write restart file - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine restart filename - ! Need to use next time step since clock is not advanced until the end of the time interval - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) runid - - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds - - ! write name of restart file in the rpointer file - nu = shr_file_getUnit() - if (is_root_pe()) then - restart_pointer_file = 'rpointer.ocn' - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - write(nu,'(a)') trim(restartname) //'.nc' - close(nu) - write(logunit,*) 'ocn restart pointer file written: ',trim(restartname) - endif - call shr_file_freeUnit(nu) - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - end if - endif - ! reset shr logging to my original values call shr_file_setLogUnit (output_unit) + #else allocate(ofld(isc:iec,jsc:jec)) @@ -2065,83 +2163,116 @@ subroutine ModelAdvance(gcomp, rc) ocm = dataPtr_ocm do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) + + ocean_grid%sin_rot(i1,j1)*ocm(i,j) dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - - !call ESMF_LogWrite("B4 writing diags", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) + - ocean_grid%sin_rot(i1,j1)*ocz(i,j) + ! multiply by mask to zero out non-ocean points + dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) + dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) enddo enddo deallocate(ocz, ocm) #endif - + + ! If restart alarm is ringing - write restart file + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmRingerOff(alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! call into system specific method to get desired restart filename + restartname = "" + call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & + isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + restartname = trim(cvalue) + call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + endif + + if (len_trim(restartname) == 0) then + ! none provided, so use a default restart filename + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "ocn", year, month, day, hour, minute, seconds + call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) + end if + endif + if (write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 endif - - !call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) - !write(*,*) 'MOM: --- run phase called ---' - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif + end subroutine ModelAdvance !=============================================================================== @@ -2161,6 +2292,7 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) type(ESMF_ALARM) :: restart_alarm + logical :: isPresent, isSet logical :: first_time = .true. character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' !-------------------------------- @@ -2203,9 +2335,9 @@ subroutine ModelSetRunClock(gcomp, rc) file=__FILE__)) & return ! bail out - call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & - ESMF_LOGMSG_ERROR, rc=dbrc) - rc = ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2222,30 +2354,44 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !-------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) restart_n + ! defaults + restart_n = 0 + restart_ymd = 0 - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & + isSet=isSet, value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - read(cvalue,*) restart_ymd - - call shr_nuopc_time_alarmInit(mclock, & + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_n + endif + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + endif + else + restart_option = "none" + endif + + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & opt_n = restart_n, & @@ -2256,13 +2402,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if !-------------------------------- @@ -2283,6 +2437,7 @@ subroutine ModelSetRunClock(gcomp, rc) end subroutine ModelSetRunClock + !=============================================================================== !> Called by NUOPC at the end of the run to clean up. @@ -2331,14 +2486,14 @@ subroutine ocean_model_finalize(gcomp, rc) Time = esmf2fms_time(currTime) #ifdef CESMCOUPLED - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.false.) + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) #else - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.true.) + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) #endif - call field_manager_end + call field_manager_end() - call fms_io_exit - call fms_end + call fms_io_exit() + call fms_end() write(*,*) 'MOM: --- completed ---' @@ -2346,165 +2501,6 @@ end subroutine ocean_model_finalize !==================================================================== - ! get forcing data from data_overide - subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) - - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled - - !call data_override('OCN', 't_flux', x%t_flux , Time_next) - !call data_override('OCN', 'u_flux', x%u_flux , Time_next) - !call data_override('OCN', 'v_flux', x%v_flux , Time_next) - !call data_override('OCN', 'q_flux', x%q_flux , Time_next) - !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) - !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) - !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) - !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) - !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) - !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) - !call data_override('OCN', 'lprec', x%lprec , Time_next) - !call data_override('OCN', 'fprec', x%fprec , Time_next) - !call data_override('OCN', 'runoff', x%runoff , Time_next) - !call data_override('OCN', 'calving', x%calving , Time_next) - !call data_override('OCN', 'p', x%p , Time_next) - - end subroutine ice_ocn_bnd_from_data - -!----------------------------------------------------------------------------------------- -! -! Subroutines for enabling coupling to external programs through a third party coupler -! such as OASIS/PRISM. -! If no external coupler then these will mostly be dummy routines. -! These routines can also serve as spots to call other user defined routines -!----------------------------------------------------------------------------------------- - -!----------------------------------------------------------------------------------------- - -! Dummy subroutines. - - subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) - implicit none - integer, intent(out) :: mom_local_communicator - logical, intent(out) :: external_initialization - external_initialization = .false. - mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? - ! probably wouldn't need logical flag. - return - end subroutine external_coupler_mpi_init - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) - implicit none - type(domain2d) :: Dom - integer :: dt_cpld - type(time_type) :: Run_len - return - end subroutine external_coupler_sbc_init - - subroutine external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - implicit none - type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary - type (ocean_public_type) , intent(INOUT) :: ocean_public - integer , intent(IN) :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_before - - - subroutine external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - type (ice_ocean_boundary_type) :: Ice_ocean_boundary - type (ocean_public_type) :: ocean_public - integer :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_after - - subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) - implicit none - integer, intent(in) :: dt_cpld, num_cpld_calls - return - end subroutine external_coupler_restart - - subroutine external_coupler_exit - return - end subroutine external_coupler_exit - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) - implicit none - integer, intent(in) :: mom_local_communicator - logical, intent(in) :: external_initialization - return - end subroutine external_coupler_mpi_exit -!----------------------------------------------------------------------------------------- - subroutine writeSliceFields(state, filename_prefix, slice, rc) - type(ESMF_State) :: state - character(len=*) :: filename_prefix - integer :: slice - integer, intent(out), optional :: rc - - integer :: n, nfields - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - character(len=40) :: fileName - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' - - if (present(rc)) rc = ESMF_SUCCESS - - if (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then - - call ESMF_StateGet(state, itemCount=nfields, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(nfields)) - call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n=1, size(fieldNameList) - call ESMF_StateGet(state, itemName=fieldNameList(n), & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - ! field is available in the state - call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! -> output to file - write (fileName,"(A)") & - filename_prefix//trim(fieldNameList(n))//".nc" - call ESMF_FieldWrite(field, fileName=trim(fileName), & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - enddo - - deallocate(fieldNameList) - - endif - - end subroutine writeSliceFields - - !----------------------------------------------------------------------------- - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST character(len=*) , intent(in) :: fldname @@ -2533,7 +2529,7 @@ end subroutine State_GetFldPtr !----------------------------------------------------------------------------- - subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_num, rc) + subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- @@ -2541,8 +2537,8 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name - integer, intent(in) :: scalar_num + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_count integer, intent(inout) :: rc ! local variables @@ -2560,11 +2556,11 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", & - ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > scalar_count) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ERROR in scalar_id", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif farrayptr(1,scalar_id) = value @@ -2588,6 +2584,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) integer :: npet, nx, ny, pet integer :: elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) type(ESMF_VM) :: vm + real(ESMF_KIND_R8), pointer :: fldptr(:,:) character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' rc = ESMF_SUCCESS @@ -2596,12 +2593,12 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - if (field_defs(i)%shortname == flds_scalar_name) then + if (field_defs(i)%shortname == scalar_field_name) then call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) call SetScalarField(field, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2613,11 +2610,11 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=rc) field = ESMF_FieldCreate(grid=grid, & farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & @@ -2631,13 +2628,22 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & name=field_defs(i)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + + ! initialize to zero + call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr = 0.0 + endif call NUOPC_Realize(state, field=field, rc=rc) @@ -2645,19 +2651,12 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - ! call ESMF_FieldPrint(field=field, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out else call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) - ! TODO: Initialize the value in the pointer to 0 after proper restart is setup - ! if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + rc=rc) ! remove a not connected Field from State call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2693,10 +2692,10 @@ subroutine SetScalarField(field, rc) grid = ESMF_GridCreate(distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, & + field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, & typekind=ESMF_TYPEKIND_R8, & ungriddedLBound=(/1/), & - ungriddedUBound=(/flds_scalar_num/), & ! num of scalar values + ungriddedUBound=(/scalar_field_count/), & ! num of scalar values rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -2723,9 +2722,10 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) num = num + 1 if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return + call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & + msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif fldlist(num)%stdname = trim(stdname) @@ -2747,50 +2747,4 @@ end subroutine fld_list_add !----------------------------------------------------------------------------- -#if (1 == 0) - subroutine calculate_rot_angle(OS, OSFC) - type(ocean_state_type), intent(in) :: OS - type(ocean_public_type), intent(in) :: OSFC - - integer :: i,j,ishift,jshift,ilb,iub,jlb,jub - real :: angle, lon_scale - type(ocean_grid_type), pointer :: grid - - call get_ocean_grid(OS, grid) - - !print *, 'lbound: ', lbound(grid%geoLatT), lbound(grid%geoLonT), lbound(grid%sin_rot) - !print *, 'ubound: ', ubound(grid%geoLatT), ubound(grid%geoLonT), ubound(grid%sin_rot) - - !print *, minval(grid%geoLatT), maxval(grid%geoLatT) - !print *, minval(grid%geoLonT), maxval(grid%geoLonT) - !print *, grid%isc, grid%jsc, grid%iec, grid%jec - - ! - ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 - ! - call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) - ishift = ilb-grid%isc - jshift = jlb-grid%jsc - !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift - !print *, 'sizes', iub-ilb, jub-jlb, grid%iec-grid%isc, grid%jec-grid%jsc -! allocate(grid%sin_rot(ilb:iub, jlb:jub)) -! allocate(grid%cos_rot(ilb:iub, jlb:jub)) - - ! loop 5-104 - do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec - lon_scale = cos((grid%geoLatBu(I-1,J-1) + grid%geoLatBu(I,J-1 ) + & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((grid%geoLonBu(I-1,J) + grid%geoLonBu(I,J) - & - grid%geoLonBu(I-1,J-1) - grid%geoLonBu(I,J-1))*lon_scale, & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J) - & - grid%geoLatBu(I-1,J-1) - grid%geoLatBu(I,J-1) ) - grid%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - grid%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo - !print *, minval(grid%sin_rot), maxval(grid%sin_rot) - !print *, minval(grid%cos_rot), maxval(grid%cos_rot) - - end subroutine -#endif - end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index be9cd4e966..6e3558efc5 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -3,6 +3,7 @@ module mom_cap_methods use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet + use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -15,8 +16,10 @@ module mom_cap_methods private ! Public member functions +#ifdef CESMCOUPLED public :: mom_export public :: mom_import +#endif public :: mom_import_nems integer :: rc,dbrc @@ -27,6 +30,7 @@ module mom_cap_methods contains !----------------------------------------------------------------------- +#ifdef CESMCOUPLED !> Maps outgoing ocean data to ESMF State !! See \ref section_mom_export for a summary of the data !! that is transferred from MOM6 to MCT. @@ -468,7 +472,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end if end subroutine mom_import - +#endif !----------------------------------------------------------------------------- subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc) diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 new file mode 100644 index 0000000000..c85d68b1ae --- /dev/null +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -0,0 +1,425 @@ +! +! This was originally share code in CIME, but required CIME as a +! dependency to build the MOM cap. The options here for setting +! a restart alarm are useful for all caps, so a second step is to +! determine if/how these could be offered more generally in a +! shared library. For now we really want the MOM cap to only +! depend on MOM and ESMF/NUOPC. +! +module mom_cap_time + + ! !USES: + use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm + use ESMF , only : ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet + use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_RC_ARG_BAD + use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + + implicit none + private ! default private + + public :: AlarmInit ! initialize an alarm + + private :: TimeInit + private :: date2ymd + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine AlarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + integer :: nyy,nmm,ndd,nsec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + character(len=*), parameter :: subname = '(AlarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + ! verify parameters + if (trim(option) == optNSteps .or. trim(option) == optNStep .or. & + trim(option) == optNSeconds .or. trim(option) == optNSecond .or. & + trim(option) == optNMinutes .or. trim(option) == optNMinute .or. & + trim(option) == optNHours .or. trim(option) == optNHour .or. & + trim(option) == optNDays .or. trim(option) == optNDay .or. & + trim(option) == optNMonths .or. trim(option) == optNMonth .or. & + trim(option) == optNYears .or. trim(option) == optNYear .or. & + trim(option) == optIfdays0) then + if (.not. present(opt_n)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (opt_n <= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' invalid opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + endif + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE, optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (lymd < 0 .or. ltod < 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNSteps, optNStep) + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds, optNSecond) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes, optNMinute) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours, optNHour) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays, optNDay) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths, optNMonth) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNYears, optNYear) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case default + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' unknown option: '//trim(option), & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + end subroutine AlarmInit + + !=============================================================================== + + subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) + + ! Create the ESMF_Time object corresponding to the given input time, given in + ! YMD (Year Month Day) and TOD (Time-of-day) format. + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + + ! input/output parameters: + type(ESMF_Time) , intent(inout) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in), optional :: tod ! time of day in seconds + character(len=*) , intent(in), optional :: desc ! description of time to set + integer , intent(in), optional :: logunit + integer , intent(out), optional :: rc + + ! local varaibles + integer :: yr, mon, day ! Year, month, day as integers + integer :: ltod ! local tod + character(len=256) :: ldesc ! local desc + character(len=*), parameter :: subname = '(TimeInit) ' + !------------------------------------------------------------------------------- + + ltod = 0 + if (present(tod)) ltod = tod + ldesc = '' + if (present(desc)) ldesc = desc + + if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then + if (present(logunit)) then + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod + end if + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' yymmdd is negative or time-of-day out of bounds ', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + + call date2ymd (ymd,yr,mon,day) + + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + end subroutine TimeInit + + !=============================================================================== + + subroutine date2ymd (date, year, month, day) + + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day + + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(date2ymd)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + end subroutine date2ymd + +end module