From d30900b261966137cd2f4e6bf73208ae1228ddde Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 9 Mar 2018 17:20:16 -0700 Subject: [PATCH] update mom6 nuopc cap --- .../coupled_driver/MOM_surface_forcing.F90 | 53 + config_src/coupled_driver/ocean_model_MOM.F90 | 4 +- config_src/nuopc_driver/mom_cap.F90 | 622 +++-- config_src/nuopc_driver/mom_cap.F90.00 | 2245 +++++++++++++++ config_src/nuopc_driver/mom_cap.F90.02 | 2432 +++++++++++++++++ config_src/nuopc_driver/mom_cap_methods.F90 | 500 ++++ config_src/nuopc_driver/ocn_comp_nuopc.F90.01 | 0 config_src/nuopc_driver/ocn_comp_nuopc.F90.02 | 2218 +++++++++++++++ 8 files changed, 7858 insertions(+), 216 deletions(-) create mode 100644 config_src/nuopc_driver/mom_cap.F90.00 create mode 100644 config_src/nuopc_driver/mom_cap.F90.02 create mode 100644 config_src/nuopc_driver/mom_cap_methods.F90 create mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90.01 create mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90.02 diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a9fcd00844..13eb003e1d 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -44,6 +44,7 @@ module MOM_surface_forcing #include +public IOB_allocate public convert_IOB_to_fluxes public surface_forcing_init public ice_ocn_bnd_type_chksum @@ -188,6 +189,58 @@ module MOM_surface_forcing contains +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 + + subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, & sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index a020db3af9..21269cb551 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -1184,7 +1184,7 @@ 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,'get_ocean_grid_data2D: unknown argument name='//name) + call MOM_error(FATAL,'ocean_model_data2D_get: unknown argument name='//name) end select @@ -1203,7 +1203,7 @@ subroutine ocean_model_data1D_get(OS,Ocean, name, value) case('c_p') value = OS%C_p case default - call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) + call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) end select diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 56c4b5cd35..6b8d2f5795 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -139,7 +139,7 @@ !! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a !! call into the MOM update routine: !! -!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) !! !! Prior to this call, the cap performs a few steps: !! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock @@ -166,8 +166,8 @@ !! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. !! The cosine and sine of the rotation angle are: !! -!! Ocean_grid%cos_rot(i,j) -!! Ocean_grid%sin_rot(i,j) +!! ocean_grid%cos_rot(i,j) +!! ocean_grid%sin_rot(i,j) !! !! The rotation of momentum flux from regular lat-lon to tripolar is: !! \f[ @@ -206,7 +206,7 @@ !! at the end of the run. This subroutine is a hook to call into MOM's native shutdown !! procedures: !! -!! call ocean_model_end (Ocean_sfc, Ocean_State, Time) +!! call ocean_model_end (ocean_public, ocean_State, Time) !! call diag_manager_end(Time ) !! call field_manager_end !! call fms_io_exit @@ -242,7 +242,7 @@ !! !! @subsection ExportField Export Fields !! -!! Export fields are populated from the `ocean_sfc` parameter (type `ocean_public_type`) +!! Export fields are populated from the `ocean_public` parameter (type `ocean_public_type`) !! after the call to `update_ocean_model()`. !! !! Standard Name | Units | Model Variable | Description | Notes @@ -377,16 +377,37 @@ module mom_cap_mod use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) 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 + +!#ifdef CESMCOUPLED +! use ocn_comp_nuopc, only: ocean_public_type, ocean_state_type +! use ocn_comp_nuopc, only: update_ocean_model, ocean_model_init +! use ocn_comp_nuopc, only: ocn_export, get_ocean_grid, ocean_model_data_get +! use ocn_comp_nuopc, only: ocean_model_end, ocean_model_init_sfc +!#else use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type use ocean_model_mod, only: ocean_model_data_get use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid + use MOM_surface_forcing, only: IOB_allocate +!#endif + 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 #ifdef MOM6_CAP use ocean_model_mod, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type #else use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type #endif +#ifdef CESMCOUPLED + use mom_cap_methods, only: ocn_export, ocn_import + use shr_nuopc_flds_mod, only: flds_scalar_name + use shr_nuopc_flds_mod, only: flds_x2o, flds_o2x, flds_x2o_map, flds_o2x_map + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_SetScalarField, shr_nuopc_fldList_type + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Advertise, shr_nuopc_fldList_Realize + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Zero, shr_nuopc_fldList_Add + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_fromflds +#endif use ESMF use NUOPC @@ -405,13 +426,16 @@ module mom_cap_mod type(ocean_public_type), pointer :: ocean_public_type_ptr type(ocean_state_type), pointer :: ocean_state_type_ptr type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr - type(ocean_grid_type), pointer :: ocean_grid_ptr end type type ocean_internalstate_wrapper type(ocean_internalstate_type), pointer :: ptr end type +#ifdef CESMCOUPLED + type (shr_nuopc_fldList_Type) :: fldsToOcn + type (shr_nuopc_fldList_Type) :: fldsFrOcn +#else type fld_list_type character(len=64) :: stdname character(len=64) :: shortname @@ -425,18 +449,22 @@ module mom_cap_mod type (fld_list_type) :: fldsToOcn(fldsMax) integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsFrOcn(fldsMax) +#endif integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr integer :: dbrc - type(ESMF_Grid), save :: mom_grid_i + type(ESMF_Grid) :: mom_grid_i logical :: write_diagnostics = .true. logical :: profile_memory = .true. logical :: ocean_solo = .true. logical :: grid_attach_area = .false. integer(ESMF_KIND_I8) :: restart_interval + logical :: sw_decomp + real(ESMF_KIND_R8) :: c1, c2, c3, c4 + character(len=*),parameter :: u_file_u = __FILE__ contains !----------------------------------------------------------------------- @@ -533,7 +561,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="true", & + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -617,10 +645,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_Time) :: MyTime type(ESMF_TimeInterval) :: TINT - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type), pointer :: ocean_grid => NULL() type(time_type) :: Run_len ! length of experiment type(time_type) :: Time @@ -631,22 +660,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: dt_cpld = 86400 integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom + integer :: npes, pe0, i type(ESMF_Grid) :: gridIn type(ESMF_Grid) :: gridOut - + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + type(directories) :: dirs_tmp !< A structure containing several relevant directory paths + character(len=384) :: pointer_filename integer :: npet, npet_x, npet_y character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' rc = ESMF_SUCCESS allocate(Ice_ocean_boundary) - !allocate(Ocean_state) ! ocean_model_init allocate this pointer - allocate(Ocean_sfc) + !allocate(ocean_state) ! ocean_model_init allocate this pointer + allocate(ocean_public) allocate(ocean_internalstate%ptr) ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary - ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_sfc - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + ocean_internalstate%ptr%ocean_public_type_ptr => ocean_public + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -669,7 +701,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet (MyTime, & YY=YEAR, MM=MONTH, DD=DAY, & H=HOUR, M =MINUTE, S =SECOND, & - RC=rc ) + RC=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -681,6 +713,89 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out +#ifdef XXCESMCOUPLEDXX + + ! Initialize MOM6 comm + call MOM_infra_init(mpi_comm_mom) + call set_calendar_type(NOLEAP) !TODO: confirm this + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + +! tcx, todo, first coupling period +! ! Compute time_in: time at the beginning of the first ocn coupling interval +! call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) +! if (runtype /= "continue") then +! ! In startup runs, take the one ocn coupling interval lag into account to +! ! compute the initial ocn time. (time_in = time_init + ocn_cpl_interval) +! time_in_ESMF = ESMF_TimeInc(current_time, ocn_cpl_interval) +! else +! time_in_ESMF = current_time +! endif +! call ESMF_TimeGet(time_in_ESMF, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) +! time_in = set_date(year, month, day, hour, minute, seconds, err_msg=err_msg) + +! tcx, todo, restart +! if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't +! ! specify input_filename in input.nml + call ocean_model_init(ocean_public, ocean_state, time, time, input_restart_file = 'n') +! else ! hybrid or branch or continuos runs +! ! output path root +! call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) +! ! read name of restart file in the pointer file +! nu = shr_file_getUnit() +! restart_pointer_file = trim(glb%pointer_filename) +! if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file +! open(nu, file=restart_pointer_file, form='formatted', status='unknown') +! read(nu,'(a)') restartfile +! close(nu) +! !restartfile = trim(restartpath) // trim(restartfile) +! if (is_root_pe()) write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) +! !endif +! call shr_file_freeUnit(nu) +! call ocean_model_init(glb%ocean_public, glb%ocn_state, time_init, time_in, input_restart_file=trim(restartfile)) +! endif + + npes = num_pes() + pe0 = root_pe() + + ocean_public%is_ocean_pe = .true. + allocate(ocean_public%pelist(npes)) + ocean_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) + + ! This include declares and sets the variable "version". + ! read useful runtime params + call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) + !call log_version(param_file, subname, version, "") + call get_param(param_file, subname, "POINTER_FILENAME", pointer_filename, & + "Name of the ascii file that contains the path and filename of" // & + " the latest restart file.", default='rpointer.ocn') + call get_param(param_file, subname, "SW_DECOMP", sw_decomp, & + "If True, read coeffs c1, c2, c3 and c4 and decompose" // & + "the net shortwave radiation (SW) into four components:\n" // & + "visible, direct shortwave = c1 * SW \n" // & + "visible, diffuse shortwave = c2 * SW \n" // & + "near-IR, direct shortwave = c3 * SW \n" // & + "near-IR, diffuse shortwave = c4 * SW", default=.true.) + if (sw_decomp) then + call get_param(param_file, subname, "SW_c1", c1, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, direct shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c2", c2, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, diffuse shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c3", c3, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, direct shortwave.", units="nondim", default=0.215) + call get_param(param_file, subname, "SW_c4", c4, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, diffuse shortwave.", units="nondim", default=0.215) + else + c1 = 0.0; c2 = 0.0; c3 = 0.0; c4 = 0.0 + endif + + ! Initialize ocn_state%state out of sight + call ocean_model_init_sfc(ocean_state, ocean_public) + +#else call fms_init(mpi_comm_mom) call constants_init call field_manager_init @@ -691,16 +806,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - Ocean_sfc%is_ocean_pe = .true. - call ocean_model_init(Ocean_sfc, Ocean_state, Time, Time) + ocean_public%is_ocean_pe = .true. + call ocean_model_init(ocean_public, ocean_state, Time, Time) !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_sfc%domain) +!tcx call data_override_init(ocean_domain_in = ocean_public%domain) - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) +#if (1 == 0) 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), & @@ -738,18 +855,28 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%calving_hflx = 0.0 Ice_ocean_boundary%mi = 0.0 Ice_ocean_boundary%p = 0.0 +#endif + +#endif - call external_coupler_sbc_init(Ocean_sfc%domain, dt_cpld, Run_len) + call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call MOM_FieldsSetup(ice_ocean_boundary, ocean_sfc) + call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Advertise(importState, fldsToOcn, subname//':MOM6Import', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Advertise(exportState, fldsFrOcn, subname//':MOM6Export', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -760,8 +887,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out +#endif -#ifdef MOM6_CAP +!#ifdef MOM6_CAP ! 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 @@ -769,9 +897,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! The rotation angles are retrieved during run time to rotate incoming ! and outgoing vectors ! - call calculate_rot_angle(Ocean_state, ocean_sfc, & - ocean_internalstate%ptr%ocean_grid_ptr) -#endif +! call calculate_rot_angle(ocean_state, ocean_public) +!#endif +! 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' @@ -801,8 +930,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_DeLayout) :: delayout type(ESMF_Distgrid) :: Distgrid type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate integer :: npet, ntiles @@ -838,8 +967,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -857,7 +986,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! global mom grid size !--------------------------------- - call mpp_get_global_domain(Ocean_sfc%domain, xsize=nxg, ysize=nyg) + 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) @@ -865,7 +994,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- - ntiles=mpp_get_ntile_count(Ocean_sfc%domain) ! this is tiles on this pe + 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) @@ -874,7 +1003,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out endif - ntiles=mpp_get_domain_npes(Ocean_sfc%domain) + 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) @@ -883,8 +1012,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) - call mpp_get_compute_domains(Ocean_sfc%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) - call mpp_get_pelist(Ocean_sfc%domain, pe) + call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(ocean_public%domain, pe) 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) @@ -1069,7 +1198,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! for esmf and also need to "make up" j=1 values. use wraparound in i !--------------------------------- - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) lbnd1 = lbound(dataPtr_mask,1) ubnd1 = ubound(dataPtr_mask,1) @@ -1101,10 +1230,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(ofld(isc:iec,jsc:jec)) allocate(gfld(nxg,nyg)) - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + 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 mpp_global_field(Ocean_sfc%domain, ofld, gfld) + 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) do j = lbnd2, ubnd2 @@ -1116,10 +1245,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo if(grid_attach_area) then - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'area', ofld, isc, jsc) + 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 mpp_global_field(Ocean_sfc%domain, ofld, gfld) + 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) do j = lbnd2, ubnd2 @@ -1131,10 +1260,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo endif - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlon', ofld, isc, jsc) + 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 mpp_global_field(Ocean_sfc%domain, ofld, gfld) + 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) do j = lbnd2, ubnd2 @@ -1146,10 +1275,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo enddo - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlat', ofld, isc, jsc) + 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 mpp_global_field(Ocean_sfc%domain, ofld, gfld) + 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) do j = lbnd2, ubnd2 @@ -1161,15 +1290,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo #ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulon', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'ulon', ofld, isc, jsc) #endif #ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLonBu', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) #endif write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + 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) do j = lbnd4, ubnd4 @@ -1198,16 +1327,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! The corner latitude values are treated differently because MOM5 runs on B-Grid while ! MOM6 runs on C-Grid. #ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulat', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'ulat', ofld, isc, jsc) #endif #ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLatBu', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) #endif write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + 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) do j = lbnd4, ubnd4 @@ -1258,6 +1387,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! realize fields on grid !--------------------------------- +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Realize(importState, grid=gridIn, fldlist=fldsToOcn, tag=subname//':MOM6Import', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Realize(exportState, grid=gridOut, fldlist=fldsFrOcn, tag=subname//':MOM6Export', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1268,6 +1404,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 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, & @@ -1288,7 +1425,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) lbnd1 = lbound(t_surf,1) ubnd1 = ubound(t_surf,1) @@ -1336,8 +1473,8 @@ subroutine ModelAdvance(gcomp, rc) integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec character(len=64) :: timestamp - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate @@ -1349,9 +1486,13 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 + integer :: nc +#ifdef CESMCOUPLED + ! in ocn_import, ocn_export + +#else real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - integer :: nc real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) @@ -1360,7 +1501,8 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - type(ocean_grid_type), pointer :: Ocean_grid +#endif + type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' @@ -1382,8 +1524,8 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep @@ -1431,7 +1573,7 @@ subroutine ModelAdvance(gcomp, rc) call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + 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_', & @@ -1445,9 +1587,20 @@ subroutine ModelAdvance(gcomp, rc) ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) if(.not. ocean_solo) then + +!#ifdef MOM5_CAP + call get_ocean_grid(ocean_state, ocean_grid) +!#endif +!#ifdef MOM6_CAP +! ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +!#endif + +#ifdef CESMCOUPLED + call ocn_import(ocean_public, ocean_grid, importState, ice_ocean_boundary) +#else call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1459,13 +1612,6 @@ subroutine ModelAdvance(gcomp, rc) lbnd2 = lbound(dataPtr_mask,2) ubnd2 = ubound(dataPtr_mask,2) -#ifdef MOM5_CAP - call get_ocean_grid(Ocean_grid) -#endif -#ifdef MOM6_CAP - Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr -#endif - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1496,17 +1642,21 @@ subroutine ModelAdvance(gcomp, rc) do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc ! work around local vs global indexing i1 = i - lbnd1 + isc - 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) + mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf dataPtr_mmmf = mmmf deallocate(mzmf, mmmf) +#endif endif ! not ocean_solo +#ifdef XXCESMCOUPLEDXX + ! tcx todo +#else !Optionally write restart files when currTime-startTime is integer multiples of restart_interval if(restart_interval > 0 ) then time_elapsed = currTime - startTime @@ -1521,18 +1671,82 @@ subroutine ModelAdvance(gcomp, rc) 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) + call ocean_model_restart(ocean_state, timestamp) endif endif +#endif if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) +#ifdef XXCESMCOUPLEDXX + call update_ocean_model(ImportState, ocean_state, ocean_public, Time, Time_step_coupled, & + sw_decomp, c1, c2, c3, c4) +#else + call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) +#endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") if(.not. ocean_solo) then + +!#ifdef MOM5_CAP + call get_ocean_grid(ocean_state, ocean_grid) +!#endif +!#ifdef MOM6_CAP +! ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +!#endif + +#ifdef CESMCOUPLED + call ocn_export(ocean_public, ocean_grid, exportState) +#else allocate(ofld(isc:iec,jsc:jec)) - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + call ocean_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) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite("Before writing diagnostics", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1570,16 +1784,16 @@ subroutine ModelAdvance(gcomp, rc) 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) + 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) enddo enddo deallocate(ocz, ocm) endif ! not ocean_solo - call ESMF_LogWrite("Before writing diagnostics", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(, rc=rc) if(write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -1588,10 +1802,11 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out export_slice = export_slice + 1 - endif +#endif + endif ! not ocean solo call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + 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 ---' @@ -1616,12 +1831,12 @@ subroutine ModelAdvance(gcomp, rc) !--------- export fields ------------- - call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) - call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_sfc%t_surf) - call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_sfc%s_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_sfc%u_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_sfc%v_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_sfc%sea_lev) +! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", ocean_public%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", ocean_public%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", ocean_public%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") @@ -1638,8 +1853,8 @@ subroutine ocean_model_finalize(gcomp, rc) integer, intent(out) :: rc ! local variables - type (ocean_public_type), pointer :: Ocean_sfc - type (ocean_state_type), pointer :: Ocean_state + type (ocean_public_type), pointer :: ocean_public + type (ocean_state_type), pointer :: ocean_state type(ocean_internalstate_wrapper) :: ocean_internalstate type(TIME_TYPE) :: Time type(ESMF_Clock) :: clock @@ -1656,8 +1871,8 @@ subroutine ocean_model_finalize(gcomp, rc) file=__FILE__)) & return ! bail out - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1672,7 +1887,7 @@ subroutine ocean_model_finalize(gcomp, rc) return ! bail out Time = esmf2fms_time(currTime) - call ocean_model_end (Ocean_sfc, Ocean_State, Time) + call ocean_model_end (ocean_public, ocean_State, Time) call diag_manager_end(Time ) call field_manager_end @@ -1745,18 +1960,18 @@ subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) return end subroutine external_coupler_sbc_init - subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + 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_sfc + 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_sfc, nsteps, dt_cpld ) + 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_sfc + type (ocean_public_type) :: ocean_public integer :: nsteps, dt_cpld return end subroutine external_coupler_sbc_after @@ -1870,6 +2085,7 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) end subroutine State_GetFldPtr +#ifndef CESMCOUPLED !----------------------------------------------------------------------------- subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) @@ -1919,46 +2135,63 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) do i = 1, nfields - if (field_defs(i)%assoc) then - write(tmpstr, *) subname, tag, ' Field ', 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) - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & -! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - 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 - endif - if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + + if (field_defs(i)%shortname == flds_scalar_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) + call shr_nuopc_fldList_SetScalarField(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + elseif (field_defs(i)%assoc) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected and associated.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + 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) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & +! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, 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 connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + 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 + endif + call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) ! 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 "// field_defs(i)%stdname // " is not connected.", & + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & @@ -1976,17 +2209,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) enddo end subroutine MOM_RealizeFields - +#endif !----------------------------------------------------------------------------- - subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) + subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - type(ocean_public_type), intent(in) :: Ocean_sfc - -#ifdef CESMCOUPLED -! type (shr_nuopc_fldList_Type) :: fldsList -#endif + type(ocean_public_type), intent(in) :: ocean_public + integer :: rc character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) @@ -2000,14 +2230,14 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) ! create import fields list !-------------------------------- -! call shr_nuopc_fldList_Zero(fldsList, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Zero(fldsToOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -! call shr_nuopc_fldList_fromflds(fldsList, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_fromflds(fldsToOcn, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Add(fldsToOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! convert to fldsToOcn @@ -2015,51 +2245,14 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) ! create export fields list !-------------------------------- -! call shr_nuopc_fldList_Zero(fldsList, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_fromflds(fldsList, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! WARNING tcx tcraig -! tcraig this is just a starting point, the fields are not complete or correct here -! tcraig we will need to figure out whether to adjust the mediator coupling fields for mom or vv or a bit of both - - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide", data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide", data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide", data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide", data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_salt" , "will provide", data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwdn" , "will provide", data=Ice_ocean_boundary%lw_flux ) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidr", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidf", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rain" , "will provide", data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_snow" , "will provide", data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide", data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_meltw", "will provide", data=Ice_ocean_boundary%calving) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "runoff_heat_flux" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_melth", "will provide", data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide", data=Ice_ocean_boundary%p ) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + call shr_nuopc_fldList_Zero(fldsFrOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -!--------- export fields ------------- - - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t", "will provide", data=Ocean_sfc%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide", data=Ocean_sfc%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u", "will provide", data=Ocean_sfc%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v", "will provide", data=Ocean_sfc%v_surf ) -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide", data=Ocean_sfc%frazil) + call shr_nuopc_fldList_fromflds(fldsFrOcn, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Add(fldsFrOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return #else !--------- import fields ------------- @@ -2088,21 +2281,21 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_sfc%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_sfc%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_sfc%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_sfc%v_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=ocean_public%v_surf ) ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_sfc%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) #endif end subroutine MOM_FieldsSetup !----------------------------------------------------------------------------- - +#ifndef CESMCOUPLED subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- ! Set up a list of field information @@ -2142,6 +2335,7 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) endif end subroutine fld_list_add +#endif subroutine dumpMomInternal(grid, slice, stdname, nop, farray) @@ -2193,53 +2387,53 @@ subroutine dumpMomInternal(grid, slice, stdname, nop, farray) end subroutine +#if (1 == 0) #ifdef MOM6_CAP - subroutine calculate_rot_angle(OS, OSFC, OG) + subroutine calculate_rot_angle(OS, OSFC) type(ocean_state_type), intent(in) :: OS type(ocean_public_type), intent(in) :: OSFC - type(ocean_grid_type), pointer :: OG integer :: i,j,ishift,jshift,ilb,iub,jlb,jub real :: angle, lon_scale - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: grid - call get_ocean_grid(OS, G) + call get_ocean_grid(OS, grid) - !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) - !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) + !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(G%geoLatT), maxval(G%geoLatT) - !print *, minval(G%geoLonT), maxval(G%geoLonT) - !print *, G%isc, G%jsc, G%iec, G%jec + !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-G%isc - jshift = jlb-G%jsc + 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, G%iec-G%isc, G%jec-G%jsc - allocate(OG) - allocate(OG%sin_rot(ilb:iub, jlb:jub)) - allocate(OG%cos_rot(ilb:iub, jlb:jub)) + !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=G%jsc,G%jec ; do i=G%isc,G%iec - lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & - G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & - G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) - OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + 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(OG%sin_rot), maxval(OG%sin_rot) - !print *, minval(OG%cos_rot), maxval(OG%cos_rot) + !print *, minval(grid%sin_rot), maxval(grid%sin_rot) + !print *, minval(grid%cos_rot), maxval(grid%cos_rot) end subroutine #endif +#endif end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap.F90.00 b/config_src/nuopc_driver/mom_cap.F90.00 new file mode 100644 index 0000000000..56c4b5cd35 --- /dev/null +++ b/config_src/nuopc_driver/mom_cap.F90.00 @@ -0,0 +1,2245 @@ +!> +!! @mainpage MOM NUOPC Cap +!! @author Fei Liu (fei.liu@gmail.com) +!! @date 5/10/13 Original documentation +!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) +!! @date 1/12/17 Moved to doxygen +!! +!! @tableofcontents +!! +!! @section Overview Overview +!! +!! **This MOM cap has been tested with MOM5 and MOM6.** +!! +!! This document describes the MOM "cap", which is a small software layer that is +!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! is used in [National Unified Operation Prediction Capability] +!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. +!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). +!! ESMF is a high-performance modeling framework that provides +!! data structures, interfaces, and operations suited for building coupled models +!! from a set of components. NUOPC refines the capabilities of ESMF by providing +!! a more precise definition of what it means for a model to be a component and +!! how components should interact and share data in a coupled system. The NUOPC +!! Layer software is designed to work with typical high-performance models in the +!! Earth sciences domain, most of which are written in Fortran and are based on a +!! distributed memory model of parallelism (MPI). +!! A NUOPC "cap" is a Fortran module that serves as the interface to a model +!! when it's used in a NUOPC-based coupled system. +!! The term "cap" is used because it is a small software layer that sits on top +!! of model code, making calls into it and exposing model data structures in a +!! standard way. For more information about creating NUOPC caps in general, please +!! see the [Building a NUOPC Model] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) +!! how-to document. +!! +!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a +!! set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time types, and two makefiles. Also included are self-describing dependency +!! makefile fragments (mom.mk and mom.mk.template), although these can be generated +!! by the makefiles for specific installations of the MOM cap. +!! +!! @subsection CapSubroutines Cap Subroutines +!! +!! The MOM cap Fortran module contains a set of subroutines that are required +!! by NUOPC. These subroutines are called by the NUOPC infrastructure according +!! to a predefined calling sequence. Some subroutines are called during +!! initialization of the coupled system, some during the run of the coupled +!! system, and some during finalization of the coupled system. The initialization +!! sequence is the most complex and is governed by the NUOPC technical rules. +!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). +!! +!! A particularly important part of the NUOPC intialization sequence is to establish +!! field connections between models. Simply put, a field connection is established +!! when a field output by one model can be consumed by another. As an example, the +!! MOM model is able to accept a precipitation rate when coupled to an atmosphere +!! model. In this case a field connection will be established between the precipitation +!! rate exported from the atmosphere and the precipitation rate imported into the +!! MOM model. Because models may uses different variable names for physical +!! quantities, NUOPC relies on a set of standard names and a built-in, extensible +!! standard name dictionary to match fields between models. More information about +!! the use of standard names can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). +!! +!! Two key initialization phases that appear in every NUOPC cap, including this MOM +!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special +!! NUOPC term that refers to a model participating in a coupled system +!! providing a list of standard names of required import fields and available export +!! fields. In other words, each model will advertise to the other models which physical fields +!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised +!! standard names and creates a set of unidirectional links, each from one export field +!! in a model to one import field in another model. When these connections have been established, +!! all models in the coupled system need to provide a description of their geographic +!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected +!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of +!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) +!! type, which describes logically rectangular grids and the [ESMF_Field] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) +!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports +!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), +!! it is not necessary that models share a grid. As you will see below +!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. +!! +!! The following table summarizes the NUOPC-required subroutines that appear in the +!! MOM cap. The "Phase" column says whether the subroutine is called during the +!! initialization, run, or finalize part of the coupled system run. +!! +!! Phase | MOM Cap Subroutine | Description +!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- +!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use +!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields +!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep +!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up +!! +!! @section UnderlyingModelInterfaces Underlying Model Interfaces +!! +!! +!! @subsection DomainCreation Domain Creation +!! +!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed +!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] +!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure +!! during the intialization sequence. +!! +!! The cap determines parameters for setting up the grid by calling subroutines in the +!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. +!! A check is in place to ensure that there is only a single tile in the domain (the +!! cap is currently limited to one tile; multi-tile mosaics are not supported). The +!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` +!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how +!! blocks are assigned to processors). +!! +!! The grid is created in several steps: +!! - an `ESMF_DELayout` is created based on the pelist from MOM +!! - an `ESMF_DistGrid` is created over the global index space. Connections are set +!! up so that the index space is periodic in the first dimension and has a +!! fold at the top for the bipole. The decompostion blocks are also passed in +!! along with the `ESMF_DELayout` mentioned above. +!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. +!! +!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` +!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. +!! +!! @subsection Initialization Initialization +!! +!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are +!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, +!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator +!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set +!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` +!! +!! +!! @subsection Run Run +!! +!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC +!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a +!! call into the MOM update routine: +!! +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) +!! +!! Prior to this call, the cap performs a few steps: +!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock +!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently +!! inactive, but may be modified to read in import data from file or from an external coupler +!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field +!! - import fields are prepared: +!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` +!! - momentum flux vectors are rotated to internal grid +!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` +!! +!! After the call to `update_ocean_model()`, the cap performs these steps: +!! - the `ocean_mask` export is set to match that of the internal MOM mask +!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval +!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid +!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field +!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) +!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) +!! +!! @subsubsection VectorRotations Vector Rotations +!! +!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and +!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided +!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. +!! The cosine and sine of the rotation angle are: +!! +!! Ocean_grid%cos_rot(i,j) +!! Ocean_grid%sin_rot(i,j) +!! +!! The rotation of momentum flux from regular lat-lon to tripolar is: +!! \f[ +!! \begin{bmatrix} +!! \tau_x' \\ +!! \tau_y' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & sin \theta \\ +!! -sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! \tau_x \\ +!! \tau_y +!! \end{bmatrix} +!! \f] +!! +!! The rotation of ocean current from tripolar to regular lat-lon is: +!! \f[ +!! \begin{bmatrix} +!! u' \\ +!! v' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & -sin \theta \\ +!! sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! u \\ +!! v +!! \end{bmatrix} +!! \f] +!! @subsection Finalization Finalization +!! +!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) +!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown +!! procedures: +!! +!! call ocean_model_end (Ocean_sfc, Ocean_State, Time) +!! call diag_manager_end(Time ) +!! call field_manager_end +!! call fms_io_exit +!! call fms_end +!! +!! @section ModelFields Model Fields +!! +!! The following tables list the import and export fields currently set up in the MOM cap. +!! +!! @subsection ImportFields Import Fields +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- +!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | +!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! +!! +!! @subsection ExportField Export Fields +!! +!! Export fields are populated from the `ocean_sfc` parameter (type `ocean_public_type`) +!! after the call to `update_ocean_model()`. +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- +!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export +!! ocean_mask | | | ocean mask | | +!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! s_surf | psu | s_surf | sea surface salinity on t-cell | | +!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! +!! @subsection MemoryManagement Memory Management +!! +!! The MOM cap has an internal state type with pointers to three +!! types defined by MOM. There is also a small wrapper derived type +!! required to associate an internal state instance +!! with the ESMF/NUOPC component: +!! +!! type ocean_internalstate_type +!! type(ocean_public_type), pointer :: ocean_public_type_ptr +!! type(ocean_state_type), pointer :: ocean_state_type_ptr +!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr +!! end type +!! +!! type ocean_internalstate_wrapper +!! type(ocean_internalstate_type), pointer :: ptr +!! end type +!! +!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. +!! The member of type `ocean_state_type` is required by the ocean driver, +!! although its internals are private (not to be used by the coupling directly). +!! This type is passed to the ocean init and update routines +!! so that it can maintain state there if desired. +!! The member of type `ice_ocean_boundary_type` is populated by this cap +!! with incoming coupling fields from other components. These three derived types are allocated during the +!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that +!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved +!! from `mpp_get_compute_domain()`. +!! +!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, +!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` +!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of +!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move +!! data from the cap's import and export states to the memory areas used internally +!! by MOM. +!! +!! @subsection IO I/O +!! +!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute +!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files +!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". +!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] +!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files +!! named "field_ocn_internal_.nc". In all cases these NetCDF files will +!! contain a time series of field data. +!! +!! @section BuildingAndInstalling Building and Installing +!! +!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. +!! The makefile.nuopc file is intended to be used within another build system, such +!! as the NEMSAppBuilder. The regular makefile can be used generally for building +!! and installing the cap. Two variables must be customized at the top: +!! - `INSTALLDIR` - where to copy the cap library and dependent libraries +!! - `NEMSMOMDIR` - location of the MOM library and FMS library +!! +!! To install run: +!! $ make install +!! +!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment +!! defines several variables that can be used by another build system to include the +!! MOM cap and its dependencies. +!! +!! @subsection Dependencies Dependencies +!! +!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS +!! library (lib_FMS.a). +!! +!! @section RuntimeConfiguration Runtime Configuration +!! +!! At runtime, the MOM cap can be configured with several options provided +!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver +!! above this cap, or in some systems (e.g., NEMS) attributes are set by +!! reading in from a configuration file. The available attributes are: +!! +!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields +!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this +!! information is written when entering and leaving the [ModelAdvance] +!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! `update_ocean_model()`. +!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run +!! uncoupled; in this case the vector rotations and other data manipulations +!! on import fields are skipped +!! * `restart_interval` - integer number of seconds indicating the interval at +!! which to call `ocean_model_restart()`; no restarts written if set to 0 +!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area +!! using internal values computed in MOM. The default value is "false", grid cell area will +!! be computed in ESMF. +!! +!! +!! @section Repository +!! The MOM NUOPC cap is maintained in a GitHub repository: +!! https://github.com/feiliuesmf/nems_mom_cap +!! +!! @section References +!! +!! - [MOM Home Page] (http://mom-ocean.org/web) +!! +!! +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 + use fms_mod, only: close_file, file_exist, uppercase + use fms_io_mod, only: fms_io_exit + use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains + use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain + use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field + use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE + use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist + use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id + use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC + use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES + use time_interp_external_mod, only: time_interp_external_init + use time_manager_mod, only: set_calendar_type, time_type, increment_date + use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) + use time_manager_mod, only: operator( + ), operator( - ), operator( / ) + use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) + use time_manager_mod, only: date_to_string + use time_manager_mod, only: fms_get_calendar_type => get_calendar_type + + use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type + use ocean_model_mod, only: ocean_model_data_get + use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid +#ifdef MOM6_CAP + use ocean_model_mod, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type +#else + use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type +#endif + + use ESMF + use NUOPC + use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_Advance => label_Advance, & + model_label_Finalize => label_Finalize + + use time_utils_mod + + implicit none + private + public SetServices + + type ocean_internalstate_type + type(ocean_public_type), pointer :: ocean_public_type_ptr + type(ocean_state_type), pointer :: ocean_state_type_ptr + type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr + type(ocean_grid_type), pointer :: ocean_grid_ptr + end type + + type ocean_internalstate_wrapper + type(ocean_internalstate_type), pointer :: ptr + end type + + type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: transferOffer + logical :: assoc ! is the farrayPtr associated with internal data + real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr + end type fld_list_type + + integer,parameter :: fldsMax = 100 + integer :: fldsToOcn_num = 0 + type (fld_list_type) :: fldsToOcn(fldsMax) + integer :: fldsFrOcn_num = 0 + type (fld_list_type) :: fldsFrOcn(fldsMax) + + integer :: import_slice = 1 + integer :: export_slice = 1 + character(len=256) :: tmpstr + integer :: dbrc + + type(ESMF_Grid), save :: mom_grid_i + logical :: write_diagnostics = .true. + logical :: profile_memory = .true. + logical :: ocean_solo = .true. + logical :: grid_attach_area = .false. + integer(ESMF_KIND_I8) :: restart_interval + + contains + !----------------------------------------------------------------------- + !------------------- Solo Ocean code starts here ----------------------- + !----------------------------------------------------------------------- + + !> NUOPC SetService method is the only public entry point. + !! SetServices registers all of the user-provided subroutines + !! in the module with the NUOPC layer. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine SetServices(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(mom_cap:SetServices)' + + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p1"/), 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) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! attach specializing method(s) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ocean_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine SetServices + + !----------------------------------------------------------------------------- + + !> First initialize subroutine called by NUOPC. The purpose + !! is to set which version of the Initialize Phase Definition (IPD) + !! to use. + !! + !! For this MOM cap, we are using IPDv01. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=10) :: value + character(len=*),parameter :: subname='(mom_cap:InitializeP0)' + + rc = ESMF_SUCCESS + + ! Switch to IPDv01 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="true", & + 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) + + 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) + + call ESMF_AttributeGet(gcomp, name="OceanSolo", 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 + ocean_solo=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + ! 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 + + 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 + endif + call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="GridAttachArea", 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 + grid_attach_area=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to advertise import and export fields. "Advertise" + !! simply means that the standard names of all import and export + !! fields are supplied. The NUOPC layer uses these to match fields + !! between components in the coupled system. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + type(ESMF_Time) :: MyTime + type(ESMF_TimeInterval) :: TINT + + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time + type(time_type) :: Time_restart + type(time_type) :: DT + integer :: DT_OCEAN + integer :: isc,iec,jsc,jec + integer :: dt_cpld = 86400 + integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 + integer :: mpi_comm_mom + + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + + integer :: npet, npet_x, npet_y + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + + rc = ESMF_SUCCESS + + allocate(Ice_ocean_boundary) + !allocate(Ocean_state) ! ocean_model_init allocate this pointer + allocate(Ocean_sfc) + allocate(ocean_internalstate%ptr) + ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary + ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_sfc + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, 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 =SECOND, & + RC=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call fms_init(mpi_comm_mom) + call constants_init + call field_manager_init + call set_calendar_type (JULIAN ) + call diag_manager_init + ! this ocean connector will be driven at set interval + dt_cpld = DT_OCEAN + DT = set_time (DT_OCEAN, 0) + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + + Ocean_sfc%is_ocean_pe = .true. + call ocean_model_init(Ocean_sfc, Ocean_state, Time, Time) + +!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_sfc%domain) + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + 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 + + call external_coupler_sbc_init(Ocean_sfc%domain, dt_cpld, Run_len) + + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_FieldsSetup(ice_ocean_boundary, ocean_sfc) + + call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +#ifdef MOM6_CAP + ! 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_sfc, & + ocean_internalstate%ptr%ocean_grid_ptr) +#endif + + write(*,*) '----- MOM initialization phase Advertise completed' + + end subroutine InitializeAdvertise + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to realize import and export fields. "Realizing" a field + !! means that its grid has been defined and an ESMF_Field object has been + !! created and put into the import or export State. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:), & + petMap(:),deLabelList(:), & + indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, icount + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) + real(ESMF_KIND_R8), pointer :: t_surf(:,:) + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + type(ESMF_Field) :: field_t_surf + character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, petCount=npet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! global mom grid size + !--------------------------------- + + call mpp_get_global_domain(Ocean_sfc%domain, xsize=nxg, ysize=nyg) + write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total + !--------------------------------- + + ntiles=mpp_get_ntile_count(Ocean_sfc%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) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + ntiles=mpp_get_domain_npes(Ocean_sfc%domain) + write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! get start and end indices of each tile and their PET + !--------------------------------- + + allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) + call mpp_get_compute_domains(Ocean_sfc%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(Ocean_sfc%domain, pe) + 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 + + !--------------------------------- + ! create delayout and distgrid + !--------------------------------- + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + 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) + ! 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) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo + + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(connectionList(2)) + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & +! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & +! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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_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 + 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) + deallocate(IndexList) + + !--------------------------------- + ! create grid + !--------------------------------- + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + mom_grid_i = gridIn + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + !--------------------------------- + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! for esmf and also need to "make up" j=1 values. use wraparound in i + !--------------------------------- + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) + + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + 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 + endif + + allocate(ofld(isc:iec,jsc:jec)) + allocate(gfld(nxg,nyg)) + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + 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 + + if(grid_attach_area) then + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'area', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) + enddo + enddo + endif + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlon', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + enddo + enddo + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlat', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) + enddo + enddo + +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulon', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLonBu', ofld, isc, jsc) +#endif + write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + 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) + enddo + enddo + +! The corner latitude values are treated differently because MOM5 runs on B-Grid while +! MOM6 runs on C-Grid. +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulat', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLatBu', ofld, isc, jsc) +#endif + + write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=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) + enddo + enddo + + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + 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) + endif + + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + deallocate(gfld) + + gridOut = gridIn ! for now out same as in + + !--------------------------------- + ! realize fields on grid + !--------------------------------- + + call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Do sst initialization if it's part of export state + if(icount /= 0) then + call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + + lbnd1 = lbound(t_surf,1) + ubnd1 = ubound(t_surf,1) + lbnd2 = lbound(t_surf,2) + ubnd2 = ubound(t_surf,2) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 + enddo + enddo + + 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' + + end subroutine InitializeRealize + + !> Called by NUOPC to advance the model a single timestep. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + character(len=64) :: timestamp + + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + ! define some time types + type(time_type) :: Time + type(time_type) :: Time_step_coupled + type(time_type) :: Time_restart_current + + integer :: dth, dtm, dts, dt_cpld = 86400 + integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 + integer :: i,j,i1,j1 + real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) + integer :: nc + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + type(ocean_grid_type), pointer :: Ocean_grid + character(240) :: msgString + character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing OCN from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Time = esmf2fms_time(currTime) + 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_sfc, nc, dt_cpld ) + + if(write_diagnostics) then + call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + import_slice = import_slice + 1 + endif + + ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + if(.not. ocean_solo) then + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + +#ifdef MOM5_CAP + call get_ocean_grid(Ocean_grid) +#endif +#ifdef MOM6_CAP + Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +#endif + + call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_evap = - dataPtr_evap + dataPtr_sensi = - dataPtr_sensi + + 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 + 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) + enddo + enddo + dataPtr_mzmf = mzmf + dataPtr_mmmf = mmmf + deallocate(mzmf, mmmf) + endif ! not ocean_solo + + !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(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") + call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + + if(.not. ocean_solo) then + allocate(ofld(isc:iec,jsc:jec)) + + call ocean_model_data_get(Ocean_state, Ocean_sfc, '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) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite("Before writing diagnostics", ESMF_LOGMSG_INFO, rc=rc) + 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 + endif + + call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) + call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + + call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) + !write(*,*) 'MOM: --- run phase called ---' + call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) + call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) + call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_sfc%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_sfc%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_sfc%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_sfc%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_sfc%sea_lev) + + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + + end subroutine ModelAdvance + + !> Called by NUOPC at the end of the run to clean up. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ocean_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type (ocean_public_type), pointer :: Ocean_sfc + type (ocean_state_type), pointer :: Ocean_state + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(TIME_TYPE) :: Time + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=64) :: timestamp + character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + + write(*,*) 'MOM: --- finalize called ---' + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime) + + call ocean_model_end (Ocean_sfc, Ocean_State, Time) + call diag_manager_end(Time ) + call field_manager_end + + call fms_io_exit + call fms_end + + write(*,*) 'MOM: --- completed ---' + + 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_sfc, nsteps, dt_cpld ) + implicit none + type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary + type (ocean_public_type) , intent(INOUT) :: Ocean_sfc + integer , intent(IN) :: nsteps, dt_cpld + return + end subroutine external_coupler_sbc_before + + + subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + type (ice_ocean_boundary_type) :: Ice_ocean_boundary + type (ocean_public_type) :: Ocean_sfc + 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 + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + + !----------------------------------------------------------------------------- + subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) + + type(ESMF_State), intent(inout) :: state + integer,intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + integer, intent(inout) :: rc + + integer :: i + character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + call NUOPC_Advertise(state, & + standardName=field_defs(i)%stdname, & + name=field_defs(i)%shortname, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + enddo + + end subroutine MOM_AdvertiseFields + + !----------------------------------------------------------------------------- + + subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + character(len=*), intent(in) :: tag + integer, intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + if (field_defs(i)%assoc) then + write(tmpstr, *) subname, tag, ' Field ', 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) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & +! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + 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 + endif + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) +! 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 "// 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 + ! 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, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + enddo + + end subroutine MOM_RealizeFields + + !----------------------------------------------------------------------------- + + subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + type(ocean_public_type), intent(in) :: Ocean_sfc + +#ifdef CESMCOUPLED +! type (shr_nuopc_fldList_Type) :: fldsList +#endif + + character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' + + !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) + +#ifdef CESMCOUPLED + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here + + !-------------------------------- + ! create import fields list + !-------------------------------- + +! call shr_nuopc_fldList_Zero(fldsList, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_fromflds(fldsList, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! convert to fldsToOcn + + !-------------------------------- + ! create export fields list + !-------------------------------- + +! call shr_nuopc_fldList_Zero(fldsList, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_fromflds(fldsList, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here +! tcraig we will need to figure out whether to adjust the mediator coupling fields for mom or vv or a bit of both + + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_salt" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwdn" , "will provide", data=Ice_ocean_boundary%lw_flux ) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidr", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidf", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rain" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_snow" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_meltw", "will provide", data=Ice_ocean_boundary%calving) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "runoff_heat_flux" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_melth", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide", data=Ice_ocean_boundary%p ) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t", "will provide", data=Ocean_sfc%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide", data=Ocean_sfc%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u", "will provide", data=Ocean_sfc%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v", "will provide", data=Ocean_sfc%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide", data=Ocean_sfc%frazil) + + +#else +!--------- import fields ------------- + +! tcraig, don't point directly into mom data YET (last field is optional in interface) +! instead, create space for the field when it's "realized". + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_sfc%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_sfc%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_sfc%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_sfc%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_sfc%frazil) + +#endif + + end subroutine MOM_FieldsSetup + + !----------------------------------------------------------------------------- + + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + real(ESMF_KIND_R8), dimension(:,:), optional, target :: data + character(len=*), intent(in),optional :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + + ! fill in the new entry + + 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 + endif + + fldlist(num)%stdname = trim(stdname) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + if (present(data)) then + fldlist(num)%assoc = .true. + fldlist(num)%farrayPtr => data + else + fldlist(num)%assoc = .false. + endif + + end subroutine fld_list_add + + subroutine dumpMomInternal(grid, slice, stdname, nop, farray) + + type(ESMF_Grid) :: grid + integer, intent(in) :: slice + character(len=*) :: stdname + character(len=*) :: nop + real(ESMF_KIND_R8), dimension(:,:), target :: farray + + type(ESMF_Field) :: field + real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d + integer :: rc + +#ifdef MOM6_CAP + return +#endif + + if(.not. write_diagnostics) return ! nop in production mode + if(ocean_solo) return ! do not dump internal fields in ocean solo mode + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & + indexflag=ESMF_INDEX_DELOCAL, & + name=stdname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + f2d(:,:) = farray(:,:) + + call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldDestroy(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + +#ifdef MOM6_CAP + subroutine calculate_rot_angle(OS, OSFC, OG) + type(ocean_state_type), intent(in) :: OS + type(ocean_public_type), intent(in) :: OSFC + type(ocean_grid_type), pointer :: OG + + integer :: i,j,ishift,jshift,ilb,iub,jlb,jub + real :: angle, lon_scale + type(ocean_grid_type), pointer :: G + + call get_ocean_grid(OS, G) + + !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) + !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) + + !print *, minval(G%geoLatT), maxval(G%geoLatT) + !print *, minval(G%geoLonT), maxval(G%geoLonT) + !print *, G%isc, G%jsc, G%iec, G%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-G%isc + jshift = jlb-G%jsc + !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift + !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc + allocate(OG) + allocate(OG%sin_rot(ilb:iub, jlb:jub)) + allocate(OG%cos_rot(ilb:iub, jlb:jub)) + + ! loop 5-104 + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo + !print *, minval(OG%sin_rot), maxval(OG%sin_rot) + !print *, minval(OG%cos_rot), maxval(OG%cos_rot) + + end subroutine +#endif + + +end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap.F90.02 b/config_src/nuopc_driver/mom_cap.F90.02 new file mode 100644 index 0000000000..632825be2d --- /dev/null +++ b/config_src/nuopc_driver/mom_cap.F90.02 @@ -0,0 +1,2432 @@ +!> +!! @mainpage MOM NUOPC Cap +!! @author Fei Liu (fei.liu@gmail.com) +!! @date 5/10/13 Original documentation +!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) +!! @date 1/12/17 Moved to doxygen +!! +!! @tableofcontents +!! +!! @section Overview Overview +!! +!! **This MOM cap has been tested with MOM5 and MOM6.** +!! +!! This document describes the MOM "cap", which is a small software layer that is +!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! is used in [National Unified Operation Prediction Capability] +!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. +!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). +!! ESMF is a high-performance modeling framework that provides +!! data structures, interfaces, and operations suited for building coupled models +!! from a set of components. NUOPC refines the capabilities of ESMF by providing +!! a more precise definition of what it means for a model to be a component and +!! how components should interact and share data in a coupled system. The NUOPC +!! Layer software is designed to work with typical high-performance models in the +!! Earth sciences domain, most of which are written in Fortran and are based on a +!! distributed memory model of parallelism (MPI). +!! A NUOPC "cap" is a Fortran module that serves as the interface to a model +!! when it's used in a NUOPC-based coupled system. +!! The term "cap" is used because it is a small software layer that sits on top +!! of model code, making calls into it and exposing model data structures in a +!! standard way. For more information about creating NUOPC caps in general, please +!! see the [Building a NUOPC Model] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) +!! how-to document. +!! +!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a +!! set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time types, and two makefiles. Also included are self-describing dependency +!! makefile fragments (mom.mk and mom.mk.template), although these can be generated +!! by the makefiles for specific installations of the MOM cap. +!! +!! @subsection CapSubroutines Cap Subroutines +!! +!! The MOM cap Fortran module contains a set of subroutines that are required +!! by NUOPC. These subroutines are called by the NUOPC infrastructure according +!! to a predefined calling sequence. Some subroutines are called during +!! initialization of the coupled system, some during the run of the coupled +!! system, and some during finalization of the coupled system. The initialization +!! sequence is the most complex and is governed by the NUOPC technical rules. +!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). +!! +!! A particularly important part of the NUOPC intialization sequence is to establish +!! field connections between models. Simply put, a field connection is established +!! when a field output by one model can be consumed by another. As an example, the +!! MOM model is able to accept a precipitation rate when coupled to an atmosphere +!! model. In this case a field connection will be established between the precipitation +!! rate exported from the atmosphere and the precipitation rate imported into the +!! MOM model. Because models may uses different variable names for physical +!! quantities, NUOPC relies on a set of standard names and a built-in, extensible +!! standard name dictionary to match fields between models. More information about +!! the use of standard names can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). +!! +!! Two key initialization phases that appear in every NUOPC cap, including this MOM +!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special +!! NUOPC term that refers to a model participating in a coupled system +!! providing a list of standard names of required import fields and available export +!! fields. In other words, each model will advertise to the other models which physical fields +!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised +!! standard names and creates a set of unidirectional links, each from one export field +!! in a model to one import field in another model. When these connections have been established, +!! all models in the coupled system need to provide a description of their geographic +!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected +!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of +!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) +!! type, which describes logically rectangular grids and the [ESMF_Field] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) +!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports +!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), +!! it is not necessary that models share a grid. As you will see below +!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. +!! +!! The following table summarizes the NUOPC-required subroutines that appear in the +!! MOM cap. The "Phase" column says whether the subroutine is called during the +!! initialization, run, or finalize part of the coupled system run. +!! +!! Phase | MOM Cap Subroutine | Description +!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- +!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use +!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields +!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep +!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up +!! +!! @section UnderlyingModelInterfaces Underlying Model Interfaces +!! +!! +!! @subsection DomainCreation Domain Creation +!! +!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed +!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] +!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure +!! during the intialization sequence. +!! +!! The cap determines parameters for setting up the grid by calling subroutines in the +!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. +!! A check is in place to ensure that there is only a single tile in the domain (the +!! cap is currently limited to one tile; multi-tile mosaics are not supported). The +!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` +!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how +!! blocks are assigned to processors). +!! +!! The grid is created in several steps: +!! - an `ESMF_DELayout` is created based on the pelist from MOM +!! - an `ESMF_DistGrid` is created over the global index space. Connections are set +!! up so that the index space is periodic in the first dimension and has a +!! fold at the top for the bipole. The decompostion blocks are also passed in +!! along with the `ESMF_DELayout` mentioned above. +!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. +!! +!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` +!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. +!! +!! @subsection Initialization Initialization +!! +!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are +!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, +!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator +!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set +!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` +!! +!! +!! @subsection Run Run +!! +!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC +!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a +!! call into the MOM update routine: +!! +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) +!! +!! Prior to this call, the cap performs a few steps: +!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock +!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently +!! inactive, but may be modified to read in import data from file or from an external coupler +!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field +!! - import fields are prepared: +!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` +!! - momentum flux vectors are rotated to internal grid +!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` +!! +!! After the call to `update_ocean_model()`, the cap performs these steps: +!! - the `ocean_mask` export is set to match that of the internal MOM mask +!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval +!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid +!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field +!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) +!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) +!! +!! @subsubsection VectorRotations Vector Rotations +!! +!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and +!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided +!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. +!! The cosine and sine of the rotation angle are: +!! +!! Ocean_grid%cos_rot(i,j) +!! Ocean_grid%sin_rot(i,j) +!! +!! The rotation of momentum flux from regular lat-lon to tripolar is: +!! \f[ +!! \begin{bmatrix} +!! \tau_x' \\ +!! \tau_y' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & sin \theta \\ +!! -sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! \tau_x \\ +!! \tau_y +!! \end{bmatrix} +!! \f] +!! +!! The rotation of ocean current from tripolar to regular lat-lon is: +!! \f[ +!! \begin{bmatrix} +!! u' \\ +!! v' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & -sin \theta \\ +!! sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! u \\ +!! v +!! \end{bmatrix} +!! \f] +!! @subsection Finalization Finalization +!! +!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) +!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown +!! procedures: +!! +!! call ocean_model_end (Ocean_public, Ocean_State, Time) +!! call diag_manager_end(Time ) +!! call field_manager_end +!! call fms_io_exit +!! call fms_end +!! +!! @section ModelFields Model Fields +!! +!! The following tables list the import and export fields currently set up in the MOM cap. +!! +!! @subsection ImportFields Import Fields +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- +!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | +!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! +!! +!! @subsection ExportField Export Fields +!! +!! Export fields are populated from the `ocean_public` parameter (type `ocean_public_type`) +!! after the call to `update_ocean_model()`. +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- +!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export +!! ocean_mask | | | ocean mask | | +!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! s_surf | psu | s_surf | sea surface salinity on t-cell | | +!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! +!! @subsection MemoryManagement Memory Management +!! +!! The MOM cap has an internal state type with pointers to three +!! types defined by MOM. There is also a small wrapper derived type +!! required to associate an internal state instance +!! with the ESMF/NUOPC component: +!! +!! type ocean_internalstate_type +!! type(ocean_public_type), pointer :: ocean_public_type_ptr +!! type(ocean_state_type), pointer :: ocean_state_type_ptr +!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr +!! end type +!! +!! type ocean_internalstate_wrapper +!! type(ocean_internalstate_type), pointer :: ptr +!! end type +!! +!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. +!! The member of type `ocean_state_type` is required by the ocean driver, +!! although its internals are private (not to be used by the coupling directly). +!! This type is passed to the ocean init and update routines +!! so that it can maintain state there if desired. +!! The member of type `ice_ocean_boundary_type` is populated by this cap +!! with incoming coupling fields from other components. These three derived types are allocated during the +!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that +!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved +!! from `mpp_get_compute_domain()`. +!! +!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, +!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` +!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of +!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move +!! data from the cap's import and export states to the memory areas used internally +!! by MOM. +!! +!! @subsection IO I/O +!! +!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute +!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files +!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". +!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] +!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files +!! named "field_ocn_internal_.nc". In all cases these NetCDF files will +!! contain a time series of field data. +!! +!! @section BuildingAndInstalling Building and Installing +!! +!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. +!! The makefile.nuopc file is intended to be used within another build system, such +!! as the NEMSAppBuilder. The regular makefile can be used generally for building +!! and installing the cap. Two variables must be customized at the top: +!! - `INSTALLDIR` - where to copy the cap library and dependent libraries +!! - `NEMSMOMDIR` - location of the MOM library and FMS library +!! +!! To install run: +!! $ make install +!! +!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment +!! defines several variables that can be used by another build system to include the +!! MOM cap and its dependencies. +!! +!! @subsection Dependencies Dependencies +!! +!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS +!! library (lib_FMS.a). +!! +!! @section RuntimeConfiguration Runtime Configuration +!! +!! At runtime, the MOM cap can be configured with several options provided +!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver +!! above this cap, or in some systems (e.g., NEMS) attributes are set by +!! reading in from a configuration file. The available attributes are: +!! +!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields +!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this +!! information is written when entering and leaving the [ModelAdvance] +!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! `update_ocean_model()`. +!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run +!! uncoupled; in this case the vector rotations and other data manipulations +!! on import fields are skipped +!! * `restart_interval` - integer number of seconds indicating the interval at +!! which to call `ocean_model_restart()`; no restarts written if set to 0 +!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area +!! using internal values computed in MOM. The default value is "false", grid cell area will +!! be computed in ESMF. +!! +!! +!! @section Repository +!! The MOM NUOPC cap is maintained in a GitHub repository: +!! https://github.com/feiliuesmf/nems_mom_cap +!! +!! @section References +!! +!! - [MOM Home Page] (http://mom-ocean.org/web) +!! +!! +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 + use fms_mod, only: close_file, file_exist, uppercase + use fms_io_mod, only: fms_io_exit + use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains + use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain + use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field + use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE + use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist + use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id + use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC + use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES + use time_interp_external_mod, only: time_interp_external_init + use time_manager_mod, only: set_calendar_type, time_type, increment_date + use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) + use time_manager_mod, only: operator( + ), operator( - ), operator( / ) + use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) + 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 + +#ifdef CESMCOUPLED + use ocn_comp_nuopc, only: ocean_public_type, ocean_state_type + use ocn_comp_nuopc, only: update_ocean_model, ocean_model_init + use ocn_comp_nuopc, only: ocn_export, get_ocean_grid, ocean_model_data_get + use ocn_comp_nuopc, only: ocean_model_end, ocean_model_init_sfc +#else + use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type + use ocean_model_mod, only: ocean_model_data_get + use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid +#endif + 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 +#ifdef MOM6_CAP + use ocean_model_mod, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type +#else + use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type +#endif +#ifdef CESMCOUPLED + use shr_nuopc_flds_mod, only: flds_scalar_name + use shr_nuopc_flds_mod, only: flds_x2o, flds_o2x, flds_x2o_map, flds_o2x_map + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_SetScalarField, shr_nuopc_fldList_type + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Advertise, shr_nuopc_fldList_Realize + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Zero, shr_nuopc_fldList_Add + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_fromflds +#endif + + use ESMF + use NUOPC + use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_Advance => label_Advance, & + model_label_Finalize => label_Finalize + + use time_utils_mod + + implicit none + private + public SetServices + + type ocean_internalstate_type + type(ocean_public_type), pointer :: ocean_public_type_ptr + type(ocean_state_type), pointer :: ocean_state_type_ptr + type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr + type(ocean_grid_type), pointer :: ocean_grid_ptr + end type + + type ocean_internalstate_wrapper + type(ocean_internalstate_type), pointer :: ptr + end type + +#ifdef CESMCOUPLED + type (shr_nuopc_fldList_Type) :: fldsToOcn + type (shr_nuopc_fldList_Type) :: fldsFrOcn +#else + type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: transferOffer + logical :: assoc ! is the farrayPtr associated with internal data + real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr + end type fld_list_type + + integer,parameter :: fldsMax = 100 + integer :: fldsToOcn_num = 0 + type (fld_list_type) :: fldsToOcn(fldsMax) + integer :: fldsFrOcn_num = 0 + type (fld_list_type) :: fldsFrOcn(fldsMax) +#endif + + integer :: import_slice = 1 + integer :: export_slice = 1 + character(len=256) :: tmpstr + integer :: dbrc + + type(ESMF_Grid) :: mom_grid_i + logical :: write_diagnostics = .true. + logical :: profile_memory = .true. + logical :: ocean_solo = .true. + logical :: grid_attach_area = .false. + integer(ESMF_KIND_I8) :: restart_interval + logical :: sw_decomp + real(ESMF_KIND_R8) :: c1, c2, c3, c4 + character(len=*),parameter :: u_file_u = __FILE__ + + contains + !----------------------------------------------------------------------- + !------------------- Solo Ocean code starts here ----------------------- + !----------------------------------------------------------------------- + + !> NUOPC SetService method is the only public entry point. + !! SetServices registers all of the user-provided subroutines + !! in the module with the NUOPC layer. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine SetServices(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(mom_cap:SetServices)' + + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p1"/), 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) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! attach specializing method(s) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ocean_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine SetServices + + !----------------------------------------------------------------------------- + + !> First initialize subroutine called by NUOPC. The purpose + !! is to set which version of the Initialize Phase Definition (IPD) + !! to use. + !! + !! For this MOM cap, we are using IPDv01. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=10) :: value + character(len=*),parameter :: subname='(mom_cap:InitializeP0)' + + rc = ESMF_SUCCESS + + ! Switch to IPDv01 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) + + 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) + + call ESMF_AttributeGet(gcomp, name="OceanSolo", 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 + ocean_solo=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + ! 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 + + 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 + endif + call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="GridAttachArea", 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 + grid_attach_area=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to advertise import and export fields. "Advertise" + !! simply means that the standard names of all import and export + !! fields are supplied. The NUOPC layer uses these to match fields + !! between components in the coupled system. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + type(ESMF_Time) :: MyTime + type(ESMF_TimeInterval) :: TINT + + type (ocean_public_type), pointer :: Ocean_public => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time + type(time_type) :: Time_restart + type(time_type) :: DT + integer :: DT_OCEAN + integer :: isc,iec,jsc,jec + integer :: dt_cpld = 86400 + integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 + integer :: mpi_comm_mom + integer :: npes, pe0, i + + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + type(directories) :: dirs_tmp !< A structure containing several relevant directory paths + character(len=384) :: pointer_filename + integer :: npet, npet_x, npet_y + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + + rc = ESMF_SUCCESS + + allocate(Ice_ocean_boundary) + !allocate(Ocean_state) ! ocean_model_init allocate this pointer + allocate(Ocean_public) + allocate(ocean_internalstate%ptr) + ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary + ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_public + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, 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 =SECOND, & + RC=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +#ifdef CESMCOUPLED + + ! Initialize MOM6 comm + call MOM_infra_init(mpi_comm_mom) + call set_calendar_type(NOLEAP) !TODO: confirm this + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + +! tcx, todo, first coupling period +! ! Compute time_in: time at the beginning of the first ocn coupling interval +! call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) +! if (runtype /= "continue") then +! ! In startup runs, take the one ocn coupling interval lag into account to +! ! compute the initial ocn time. (time_in = time_init + ocn_cpl_interval) +! time_in_ESMF = ESMF_TimeInc(current_time, ocn_cpl_interval) +! else +! time_in_ESMF = current_time +! endif +! call ESMF_TimeGet(time_in_ESMF, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) +! time_in = set_date(year, month, day, hour, minute, seconds, err_msg=err_msg) + +! tcx, todo, restart +! if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't +! ! specify input_filename in input.nml + call ocean_model_init(ocean_public, ocean_state, time, time, input_restart_file = 'n') +! else ! hybrid or branch or continuos runs +! ! output path root +! call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) +! ! read name of restart file in the pointer file +! nu = shr_file_getUnit() +! restart_pointer_file = trim(glb%pointer_filename) +! if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file +! open(nu, file=restart_pointer_file, form='formatted', status='unknown') +! read(nu,'(a)') restartfile +! close(nu) +! !restartfile = trim(restartpath) // trim(restartfile) +! if (is_root_pe()) write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) +! !endif +! call shr_file_freeUnit(nu) +! call ocean_model_init(glb%ocean_public, glb%ocn_state, time_init, time_in, input_restart_file=trim(restartfile)) +! endif + + npes = num_pes() + pe0 = root_pe() + + Ocean_public%is_ocean_pe = .true. + allocate(ocean_public%pelist(npes)) + ocean_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) + + ! This include declares and sets the variable "version". + ! read useful runtime params + call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) + !call log_version(param_file, subname, version, "") + call get_param(param_file, subname, "POINTER_FILENAME", pointer_filename, & + "Name of the ascii file that contains the path and filename of" // & + " the latest restart file.", default='rpointer.ocn') + call get_param(param_file, subname, "SW_DECOMP", sw_decomp, & + "If True, read coeffs c1, c2, c3 and c4 and decompose" // & + "the net shortwave radiation (SW) into four components:\n" // & + "visible, direct shortwave = c1 * SW \n" // & + "visible, diffuse shortwave = c2 * SW \n" // & + "near-IR, direct shortwave = c3 * SW \n" // & + "near-IR, diffuse shortwave = c4 * SW", default=.true.) + if (sw_decomp) then + call get_param(param_file, subname, "SW_c1", c1, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, direct shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c2", c2, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, diffuse shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c3", c3, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, direct shortwave.", units="nondim", default=0.215) + call get_param(param_file, subname, "SW_c4", c4, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, diffuse shortwave.", units="nondim", default=0.215) + else + c1 = 0.0; c2 = 0.0; c3 = 0.0; c4 = 0.0 + endif + + ! Initialize ocn_state%state out of sight + call ocean_model_init_sfc(ocean_state, ocean_public) + +#else + call fms_init(mpi_comm_mom) + call constants_init + call field_manager_init + call set_calendar_type (JULIAN ) + call diag_manager_init + ! this ocean connector will be driven at set interval + dt_cpld = DT_OCEAN + DT = set_time (DT_OCEAN, 0) + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + + Ocean_public%is_ocean_pe = .true. + call ocean_model_init(Ocean_public, Ocean_state, Time, Time) + +!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 mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) + + 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 +#endif + + call external_coupler_sbc_init(Ocean_public%domain, dt_cpld, Run_len) + + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) + +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Advertise(importState, fldsToOcn, subname//':MOM6Import', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Advertise(exportState, fldsFrOcn, subname//':MOM6Export', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else + call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +#endif + +#ifdef MOM6_CAP + ! 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, & + ocean_internalstate%ptr%ocean_grid_ptr) +#endif + + write(*,*) '----- MOM initialization phase Advertise completed' + + end subroutine InitializeAdvertise + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to realize import and export fields. "Realizing" a field + !! means that its grid has been defined and an ESMF_Field object has been + !! created and put into the import or export State. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type (ocean_public_type), pointer :: Ocean_public => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:), & + petMap(:),deLabelList(:), & + indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, icount + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) + real(ESMF_KIND_R8), pointer :: t_surf(:,:) + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + type(ESMF_Field) :: field_t_surf + character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, petCount=npet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! global mom grid size + !--------------------------------- + + 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) + + !--------------------------------- + ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total + !--------------------------------- + + 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) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + 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) + + !--------------------------------- + ! get start and end indices of each tile and their PET + !--------------------------------- + + allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) + call mpp_get_compute_domains(Ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(Ocean_public%domain, pe) + 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 + + !--------------------------------- + ! create delayout and distgrid + !--------------------------------- + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + 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) + ! 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) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo + + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(connectionList(2)) + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & +! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & +! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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_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 + 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) + deallocate(IndexList) + + !--------------------------------- + ! create grid + !--------------------------------- + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + mom_grid_i = gridIn + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + !--------------------------------- + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! for esmf and also need to "make up" j=1 values. use wraparound in i + !--------------------------------- + + call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) + + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + 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 + endif + + allocate(ofld(isc:iec,jsc:jec)) + allocate(gfld(nxg,nyg)) + + 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 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) + 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 + + 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 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) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) + enddo + enddo + endif + + 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 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) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + enddo + enddo + + 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 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) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) + enddo + enddo + +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'ulon', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'geoLonBu', ofld, isc, jsc) +#endif + write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + 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) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + 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) + enddo + enddo + +! The corner latitude values are treated differently because MOM5 runs on B-Grid while +! MOM6 runs on C-Grid. +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'ulat', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'geoLatBu', ofld, isc, jsc) +#endif + + write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + 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) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=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) + enddo + enddo + + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + 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) + endif + + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + deallocate(gfld) + + gridOut = gridIn ! for now out same as in + + !--------------------------------- + ! realize fields on grid + !--------------------------------- + +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Realize(importState, grid=gridIn, fldlist=fldsToOcn, tag=subname//':MOM6Import', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Realize(exportState, grid=gridOut, fldlist=fldsFrOcn, tag=subname//':MOM6Export', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else + call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", 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, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Do sst initialization if it's part of export state + if(icount /= 0) then + call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ocean_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) + + lbnd1 = lbound(t_surf,1) + ubnd1 = ubound(t_surf,1) + lbnd2 = lbound(t_surf,2) + ubnd2 = ubound(t_surf,2) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 + enddo + enddo + + 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' + + end subroutine InitializeRealize + + !> Called by NUOPC to advance the model a single timestep. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + character(len=64) :: timestamp + + type (ocean_public_type), pointer :: Ocean_public => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + ! define some time types + type(time_type) :: Time + type(time_type) :: Time_step_coupled + type(time_type) :: Time_restart_current + + integer :: dth, dtm, dts, dt_cpld = 86400 + integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 + integer :: i,j,i1,j1 + integer :: nc +#ifdef CESMCOUPLED + ! in ocn_import, ocn_export + +#else + real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) +#endif + type(ocean_grid_type), pointer :: Ocean_grid + character(240) :: msgString + character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing OCN from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Time = esmf2fms_time(currTime) + 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) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + import_slice = import_slice + 1 + endif + + ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system + + call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) + + if(.not. ocean_solo) then + +#ifdef MOM5_CAP + call get_ocean_grid(Ocean_grid) +#endif +#ifdef MOM6_CAP + Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +#endif + +#ifdef CESMCOUPLED + ! unpacked in update_ocean_ +#else + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_evap = - dataPtr_evap + dataPtr_sensi = - dataPtr_sensi + + 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 + 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) + enddo + enddo + dataPtr_mzmf = mzmf + dataPtr_mmmf = mmmf + deallocate(mzmf, mmmf) +#endif + endif ! not ocean_solo + +#ifdef CESMCOUPLED + ! tcx todo +#else + !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 +#endif + + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") +#ifdef CESMCOUPLED + call update_ocean_model(ImportState, Ocean_state, Ocean_public, Time, Time_step_coupled, & + sw_decomp, c1, c2, c3, c4) +#else + call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) +#endif + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + + if(.not. ocean_solo) then + +#ifdef MOM5_CAP + call get_ocean_grid(Ocean_grid) +#endif +#ifdef MOM6_CAP + Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +#endif + +#ifdef CESMCOUPLED + call ocn_export(ocean_public, ocean_grid, exportState) +#else + allocate(ofld(isc:iec,jsc:jec)) + + call ocean_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) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite("Before writing diagnostics", 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) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite(, rc=rc) + 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 +#endif + endif ! not ocean solo + + 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 ---' + call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) + call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) + call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) + +!--------- export fields ------------- + +! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_public%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_public%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_public%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_public%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_public%sea_lev) + + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + + end subroutine ModelAdvance + + !> Called by NUOPC at the end of the run to clean up. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ocean_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type (ocean_public_type), pointer :: Ocean_public + type (ocean_state_type), pointer :: Ocean_state + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(TIME_TYPE) :: Time + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=64) :: timestamp + character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + + write(*,*) 'MOM: --- finalize called ---' + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime) + + call ocean_model_end (Ocean_public, Ocean_State, Time) + call diag_manager_end(Time ) + call field_manager_end + + call fms_io_exit + call fms_end + + write(*,*) 'MOM: --- completed ---' + + 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 + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + +#ifndef CESMCOUPLED + !----------------------------------------------------------------------------- + subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) + + type(ESMF_State), intent(inout) :: state + integer,intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + integer, intent(inout) :: rc + + integer :: i + character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + call NUOPC_Advertise(state, & + standardName=field_defs(i)%stdname, & + name=field_defs(i)%shortname, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + enddo + + end subroutine MOM_AdvertiseFields + + !----------------------------------------------------------------------------- + + subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + character(len=*), intent(in) :: tag + integer, intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + + if (field_defs(i)%shortname == flds_scalar_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) + call shr_nuopc_fldList_SetScalarField(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + elseif (field_defs(i)%assoc) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected and associated.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + 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) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & +! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, 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 connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + 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 + endif + + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + 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 + ! 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, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + enddo + + end subroutine MOM_RealizeFields +#endif + !----------------------------------------------------------------------------- + + subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + type(ocean_public_type), intent(in) :: Ocean_public + + integer :: rc + character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' + + !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) + +#ifdef CESMCOUPLED + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here + + !-------------------------------- + ! create import fields list + !-------------------------------- + + call shr_nuopc_fldList_Zero(fldsToOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_fromflds(fldsToOcn, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Add(fldsToOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! convert to fldsToOcn + + !-------------------------------- + ! create export fields list + !-------------------------------- + + call shr_nuopc_fldList_Zero(fldsFrOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_fromflds(fldsFrOcn, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Add(fldsFrOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +#else +!--------- import fields ------------- + +! tcraig, don't point directly into mom data YET (last field is optional in interface) +! instead, create space for the field when it's "realized". + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_public%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_public%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_public%frazil) + +#endif + + end subroutine MOM_FieldsSetup + + !----------------------------------------------------------------------------- +#ifndef CESMCOUPLED + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + real(ESMF_KIND_R8), dimension(:,:), optional, target :: data + character(len=*), intent(in),optional :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + + ! fill in the new entry + + 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 + endif + + fldlist(num)%stdname = trim(stdname) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + if (present(data)) then + fldlist(num)%assoc = .true. + fldlist(num)%farrayPtr => data + else + fldlist(num)%assoc = .false. + endif + + end subroutine fld_list_add +#endif + + subroutine dumpMomInternal(grid, slice, stdname, nop, farray) + + type(ESMF_Grid) :: grid + integer, intent(in) :: slice + character(len=*) :: stdname + character(len=*) :: nop + real(ESMF_KIND_R8), dimension(:,:), target :: farray + + type(ESMF_Field) :: field + real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d + integer :: rc + +#ifdef MOM6_CAP + return +#endif + + if(.not. write_diagnostics) return ! nop in production mode + if(ocean_solo) return ! do not dump internal fields in ocean solo mode + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & + indexflag=ESMF_INDEX_DELOCAL, & + name=stdname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + f2d(:,:) = farray(:,:) + + call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldDestroy(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + +#ifdef MOM6_CAP + subroutine calculate_rot_angle(OS, OSFC, OG) + type(ocean_state_type), intent(in) :: OS + type(ocean_public_type), intent(in) :: OSFC + type(ocean_grid_type), pointer :: OG + + integer :: i,j,ishift,jshift,ilb,iub,jlb,jub + real :: angle, lon_scale + type(ocean_grid_type), pointer :: G + + call get_ocean_grid(OS, G) + + !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) + !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) + + !print *, minval(G%geoLatT), maxval(G%geoLatT) + !print *, minval(G%geoLonT), maxval(G%geoLonT) + !print *, G%isc, G%jsc, G%iec, G%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-G%isc + jshift = jlb-G%jsc + !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift + !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc + allocate(OG) + allocate(OG%sin_rot(ilb:iub, jlb:jub)) + allocate(OG%cos_rot(ilb:iub, jlb:jub)) + + ! loop 5-104 + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo + !print *, minval(OG%sin_rot), maxval(OG%sin_rot) + !print *, minval(OG%cos_rot), maxval(OG%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 new file mode 100644 index 0000000000..cb851f530f --- /dev/null +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -0,0 +1,500 @@ +!> This is the main driver for MOM6 in CIME +module mom_cap_methods + +! This file is part of MOM6. See LICENSE.md for the license. + +! mct modules +use ESMF +use perf_mod, only: t_startf, t_stopf +use ocean_model_mod, only: ocean_public_type, ocean_state_type +use ocean_model_mod, only: ice_ocean_boundary_type +use MOM_grid, only: ocean_grid_type +use MOM_domains, only: pass_var +use mpp_domains_mod, only: mpp_get_compute_domain + +! By default make data private +implicit none; private + +! Public member functions +public :: ocn_export +public :: ocn_import + +integer :: rc,dbrc +character(len=1024) :: tmpstr + +!--------------------------- +contains +!--------------------------- + +!> Maps outgoing ocean data to ESMF State +!! See \ref section_ocn_export for a summary of the data +!! that is transferred from MOM6 to MCT. +subroutine ocn_export(ocean_public, grid, exportState) + type(ocean_public_type), intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + type(ESMF_State), intent(inout) :: exportState !< outgoing data + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, i1, j1, isc, iec, jsc, jec !< Grid indices + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) + + character(len=*),parameter :: subname = '(ocn_export)' + + call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + + lbnd1 = lbound(dataPtr_t,1) + ubnd1 = ubound(dataPtr_t,1) + lbnd2 = lbound(dataPtr_t,2) + ubnd2 = ubound(dataPtr_t,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + +!tcx + write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx3',lbound(ssh,1),ubound(ssh,1),lbound(ssh,2),ubound(ssh,2) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1),lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ! surface temperature in Kelvin + dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(i,j) + dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(i,j) + dataPtr_u(i1,j1) = (grid%cos_rot(i,j) * ocean_public%u_surf(i,j) & + - grid%sin_rot(i,j) * ocean_public%v_surf(i,j)) * grid%mask2dT(i,j) + dataPtr_v(i1,j1) = (grid%cos_rot(i,j) * ocean_public%v_surf(i,j) & + + grid%sin_rot(i,j) * ocean_public%u_surf(i,j)) * grid%mask2dT(i,j) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + do j=jsc, jec + j1 = j + lbnd2 - jsc + do i=isc,iec + i1 = i + lbnd1 - isc + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 + end do + end do + + ! d/dy ssh + do j=jsc, jec + j1 = j + lbnd2 - jsc + do i=isc,iec + i1 = i + lbnd1 - isc + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 + end do + end do + +end subroutine ocn_export + + +!> This function has a few purposes: 1) it allocates and initializes the data +!! in the fluxes structure; 2) it imports surface fluxes using data from +!! the coupler; and 3) it can apply restoring in SST and SSS. +!! See \ref section_ocn_import for a summary of the surface fluxes that are +!! passed from MCT to MOM6, including fluxes that need to be included in +!! the future. +subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) + type(ocean_public_type), intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + type(ESMF_State), intent(inout) :: importState !< incoming data + type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + + integer :: i, j, i1, j1, isc, iec, jsc, jec !< Grid indices + real(ESMF_KIND_R8) :: c1,c2,c3,c4 + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + + real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + + character(len=*),parameter :: subname = '(ocn_import)' + + call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_osalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwdn" , dataPtr_lwdn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_meltw", dataPtr_meltw, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_melth", dataPtr_melth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_iosalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_prec" , dataPtr_prec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rain" , dataPtr_rain, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_snow" , dataPtr_snow, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_p,1) + ubnd1 = ubound(dataPtr_p,1) + lbnd2 = lbound(dataPtr_p,2) + ubnd2 = ubound(dataPtr_p,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + +!tcx +! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx3',i,j,i1,j1 +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ice_ocean_boundary%p,1),ubound(ice_ocean_boundary%p,1),lbound(ice_ocean_boundary%p,2),ubound(ice_ocean_boundary%p,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + do j = jsc,jec + do i = isc,iec + i1 = i + lbnd1 - isc + j1 = j + lbnd2 - jsc + + ice_ocean_boundary%p(i,j) = GRID%mask2dT(i,j) * dataPtr_p(i1,j1) + + ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(i1,j1)*dataPtr_taux(i1,j1) + & + GRID%sin_rot(i1,j1)*dataPtr_tauy(i1,j1)) + ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(i1,j1)*dataPtr_tauy(i1,j1) + & + GRID%sin_rot(i1,j1)*dataPtr_taux(i1,j1)) + + ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) * GRID%mask2dT(i,j) +! ice_ocean_boundary%latent(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(i,j) + +! tcx TO DO c1-c4 + c1 = 0.25_ESMF_KIND_R8 + c2 = 0.25_ESMF_KIND_R8 + c3 = 0.25_ESMF_KIND_R8 + c4 = 0.25_ESMF_KIND_R8 + ice_ocean_boundary%sw_flux_vis_dir(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c1 + ice_ocean_boundary%sw_flux_vis_dif(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c2 + ice_ocean_boundary%sw_flux_nir_dir(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c3 + ice_ocean_boundary%sw_flux_nir_dif(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c4 + +! ice_ocean_boundary%sw(i,j) = ice_ocean_boundary%sw_flux_vis_dir(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) + & +! ice_ocean_boundary%sw_flux_nir_dir(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) + + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(i,j) + ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(i,j)*dataPtr_iosalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(i,j)*(dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) + + ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(i,j) + + enddo + enddo + +end subroutine ocn_import + + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + +end module mom_cap_methods diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90.01 b/config_src/nuopc_driver/ocn_comp_nuopc.F90.01 new file mode 100644 index 0000000000..e69de29bb2 diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90.02 b/config_src/nuopc_driver/ocn_comp_nuopc.F90.02 new file mode 100644 index 0000000000..5b7b394c0c --- /dev/null +++ b/config_src/nuopc_driver/ocn_comp_nuopc.F90.02 @@ -0,0 +1,2218 @@ +!> This is the main driver for MOM6 in CIME +module ocn_comp_nuopc + +! This file is part of MOM6. See LICENSE.md for the license. + +! mct modules +use ESMF +use perf_mod, only: t_startf, t_stopf +use shr_kind_mod, only: shr_kind_r8 +use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit, shr_file_setIO, & + shr_file_getLogUnit, shr_file_getLogLevel, & + shr_file_setLogUnit, shr_file_setLogLevel + +! MOM6 modules +use MOM_coms, only : reproducing_sum +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT +use MOM, only: initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only: calculate_surface_state, allocate_surface_state +use MOM, only: finish_MOM_initialization, step_offline +use MOM_forcing_type, only: forcing, forcing_diags, register_forcing_type_diags +use MOM_forcing_type, only: allocate_forcing_type, deallocate_forcing_type +use MOM_forcing_type, only: mech_forcing_diags, forcing_accumulate, forcing_diagnostics +use MOM_forcing_type, only: mech_forcing, allocate_mech_forcing, copy_back_forcing_fields +use MOM_forcing_type, only: set_net_mass_forcing, set_derived_forcing_fields +use MOM_forcing_type, only: copy_common_forcing_fields +use MOM_restart, only: save_restart +use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here +use MOM_domains, only: pass_vector, BGRID_NE, CGRID_NE, To_All +use MOM_domains, only: pass_var, AGRID, fill_symmetric_edges +use MOM_grid, only: ocean_grid_type, get_global_grid_size +use MOM_verticalGrid, only: verticalGrid_type +use MOM_variables, only: surface +use MOM_error_handler, only: MOM_error, FATAL, is_root_pe, WARNING +use MOM_error_handler, only: callTree_enter, callTree_leave +use MOM_time_manager, only: time_type, set_date, set_time, set_calendar_type, NOLEAP, get_date +use MOM_time_manager, only: operator(+), operator(-), operator(*), operator(/) +use MOM_time_manager, only: operator(/=), operator(>), get_time +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_diag_mediator, only: diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only: diag_mediator_close_registration, diag_mediator_end +use MOM_diag_mediator, only: safe_alloc_ptr +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 MOM_sum_output, only: MOM_sum_output_init, sum_output_CS +use MOM_sum_output, only: write_energy, accumulate_net_input +use MOM_string_functions, only: uppercase +use MOM_constants, only: CELSIUS_KELVIN_OFFSET, hlf, hlv +use MOM_EOS, only: gsw_sp_from_sr, gsw_pt_from_ct +use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init +use user_revise_forcing, only : user_revise_forcing_CS +use MOM_restart, only : restart_init, MOM_restart_CS +use MOM_restart, only : restart_init_end, save_restart, restore_state +use data_override_mod, only : data_override_init, data_override +use MOM_io, only : slasher, write_version_number +use MOM_spatial_means, only : adjust_area_mean_to_zero + +! FMS modules +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain, mpp_get_data_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain +use time_interp_external_mod, only : init_external_field, time_interp_external +use time_interp_external_mod, only : time_interp_external_init +use fms_mod, only : read_data + +! GFDL coupler modules +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn +use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data + +! By default make data private +implicit none; private + +#include + +! Public member functions +public :: ocean_model_init +public :: ocean_model_init_sfc +public :: update_ocean_model +public :: ocn_export +public :: ocean_model_data_get +public :: get_ocean_grid +public :: ocean_model_end + +interface ocean_model_data_get + module procedure ocean_model_data1D_get + module procedure ocean_model_data2D_get +end interface + +! Flag for debugging +logical, parameter :: debug=.true. + +!> 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". +type, public :: ocean_public_type + 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. + 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. + + integer :: stagger = -999 !< The staggering relative to the tracer points + !! of the two velocity components. Valid entries + !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, + !! corresponding to the community-standard Arakawa notation. + !! (These are named integers taken from mpp_parameter_mod.) + !! Following MOM, this is BGRID_NE by default when the ocean + !! is initialized, but here it is set to -999 so that a + !! global max across ocean and non-ocean processors can be + !! used to determine its value. + real, pointer, dimension(:,:) :: & + t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) + s_surf => NULL(), & !< SSS on t-cell (psu) + u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. + v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. + sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, + !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) + frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil + !! formation in the ocean. + area => NULL() !< cell area of the ocean surface, in m2. + type(coupler_2d_bc_type) :: fields !< A structure that may contain an + !! array of named tracer-related fields. + integer :: avg_kount !< Used for accumulating averages of this type. + integer, dimension(2) :: axes = 0 !< Axis numbers that are available + ! for I/O using this surface data. +end type ocean_public_type + +!> Contains pointers to the forcing fields which may be used to drive MOM. +!! All fluxes are positive downward. +type, public :: surface_forcing_CS ; private + integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integer values + !! from MOM_domains) to indicate the staggering of + !! the winds that are being provided in calls to + !! update_ocean_model. CIME uses AGRID, so this option + !! is being hard coded for now. + 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) + real :: latent_heat_vapor !< latent heat of vaporization (J/kg) + real :: max_p_surf !< maximum surface pressure that can be + !! exerted by the atmosphere and floating sea-ice, + !! in Pa. This is needed because the FMS coupling + !! structure does not limit the water that can be + !! frozen out of the ocean and the ice-ocean heat + !! fluxes are treated explicitly. + logical :: use_limited_P_SSH !< If true, return the sea surface height with + !! the correction for the atmospheric (and sea-ice) + !! pressure limited by max_p_surf instead of the + !! full atmospheric pressure. The default is true. + real :: gust_const !< constant unresolved background gustiness for ustar (Pa) + logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied + !! from an input file. + real, pointer, dimension(:,:) :: & + TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the + !! bottom boundary layer by drag on the tidal flows, + !! in W m-2. + gust => NULL(), & !< spatially varying unresolved background + !! gustiness that contributes to ustar (Pa). + !! gust is used when read_gust_2d is true. + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity (m/s) + real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) + real :: utide !< constant tidal velocity to use if read_tideamp + !! is false, in m s-1. + logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. + logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts + !! to damp surface deflections (especially surface + !! gravity waves). The default is false. + real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions (m^2/s) + real :: density_sea_ice !< typical density of sea-ice (kg/m^3). The value is + !! only used to convert the ice pressure into + !! appropriate units for use with Kv_sea_ice. + real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which + !! sea-ice viscosity becomes effective, in kg m-2, + !! typically of order 1000 kg m-2. + logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + real :: Flux_const !< piston velocity for surface restoring (m/s) + logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux + logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) + 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 :: 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) + logical :: mask_srestore_marginal_seas !< if true, then mask SSS restoring in marginal seas + real :: max_delta_srestore !< maximum delta salinity used for restoring + real :: max_delta_trestore !< maximum delta sst used for restoring + real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring + type(diag_ctrl), pointer :: diag !< structure to regulate diagnostic output timing + character(len=200) :: inputdir !< directory where NetCDF input files are + character(len=200) :: salt_restore_file !< filename for salt restoring data + character(len=30) :: salt_restore_var_name !< name of surface salinity in salt_restore_file + character(len=200) :: temp_restore_file !< filename for sst restoring data + character(len=30) :: temp_restore_var_name !< name of surface temperature in temp_restore_file + integer :: id_srestore = -1 !< id number for time_interp_external. + integer :: id_trestore = -1 !< id number for time_interp_external. + type(forcing_diags), public :: handles !< diagnostics handles + !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer + type(user_revise_forcing_CS), pointer :: urf_CS => NULL()!< user revise pointer +end type surface_forcing_CS + +!> Contains information about the ocean state, although it is not necessary that +!! this is implemented with all models. This type is private, and can therefore vary +!! between different ocean models. +type, public :: ocean_state_type ; private + logical :: is_ocean_PE = .false. !< True if this is an ocean PE. + type(time_type) :: Time !< The ocean model's time and master clock. + integer :: Restart_control !< An integer that is bit-tested to determine whether + !! incremental restart files are saved and whether they + !! have a time stamped name. +1 (bit 0) for generic + !! files and +2 (bit 1) for time-stamped files. A + !! restart file is saved at the end of a run segment + !! unless Restart_control is negative. + type(time_type) :: energysavedays !< The interval between writing the energies + !! and other integral quantities of the run. + type(time_type) :: write_energy_time !< The next time to write to the energy file. + integer :: nstep = 0 !< The number of calls to update_ocean. + logical :: use_ice_shelf !< If true, the ice shelf model is enabled. + logical :: icebergs_apply_rigid_boundary !< If true, the icebergs can change ocean bd condition. + real :: kv_iceberg !< The viscosity of the icebergs in m2/s (for ice rigidity) + real :: berg_area_threshold !< Fraction of grid cell which iceberg must occupy + !! so that fluxes below are set to zero. (0.5 is a + !! good value to use. Not applied for negative values. + real :: latent_heat_fusion !< Latent heat of fusion + real :: density_iceberg !< A typical density of icebergs in kg/m3 (for ice rigidity) + type(ice_shelf_CS), pointer :: Ice_shelf_CSp => NULL() !< ice shelf structure. + logical :: restore_salinity !< If true, the coupled MOM driver adds a term to + !! restore salinity to a specified value. + logical :: restore_temp !< If true, the coupled MOM driver adds a term to + !! restore sst to a specified value. + real :: press_to_z !< A conversion factor between pressure and ocean + !! depth in m, usually 1/(rho_0*g), in m Pa-1. + real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. + type(directories) :: dirs !< A structure containing several relevant directory paths. + type(mech_forcing) :: forces!< A structure with the driving mechanical forces + type(forcing) :: fluxes !< A structure containing pointers to + !! the ocean forcing fields. + type(forcing) :: flux_tmp !< A secondary structure containing pointers to the + !! ocean forcing fields for when multiple coupled + !! timesteps are taken per thermodynamic step. + type(surface) :: state !< A structure containing pointers to + !! the ocean surface state fields. + type(ocean_grid_type), pointer :: grid => NULL() !< A pointer to a grid structure + !! containing metrics and related information. + type(verticalGrid_type), pointer :: GV => NULL() !< A pointer to a vertical grid + !! structure containing metrics and related information. + type(MOM_control_struct), pointer :: MOM_CSp => NULL() + type(surface_forcing_CS), pointer :: forcing_CSp => NULL() + type(sum_output_CS), pointer :: sum_output_CSp => NULL() +end type ocean_state_type + +integer :: id_clock_forcing +integer :: rc + +contains + + +!> Initializes the ocean model, including registering fields +!! for restarts and reading restart files if appropriate. +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). + 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. + type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar + type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. + 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 + !! in the calculation of additional gas or other + !! 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. + + real :: Time_unit !< The time unit in seconds for ENERGYSAVEDAYS. + 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. + character(len=48) :: stagger + integer :: secs, days + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + logical :: offline_tracer_mode + + call callTree_enter("ocean_model_init(), ocn_comp_nuopc.F90") + if (associated(OS)) then + call MOM_error(WARNING, "ocean_model_init called with an associated "// & + "ocean_state_type structure. Model is already initialized.") + return + endif + allocate(OS) + + OS%is_ocean_pe = Ocean_sfc%is_ocean_pe + if (.not.OS%is_ocean_pe) return + + OS%Time = Time_in + call initialize_MOM(OS%Time, param_file, OS%dirs, OS%MOM_CSp, Time_in, & + offline_tracer_mode=offline_tracer_mode, input_restart_file=input_restart_file) + OS%grid => OS%MOM_CSp%G ; OS%GV => OS%MOM_CSp%GV + OS%C_p = OS%MOM_CSp%tv%C_p + OS%fluxes%C_p = OS%MOM_CSp%tv%C_p + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & + "An integer whose bits encode which restart files are \n"//& + "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& + "(bit 0) for a non-time-stamped file. A restart file \n"//& + "will be saved at the end of the run segment for any \n"//& + "non-negative value.", default=1) + call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & + "The time unit for ENERGYSAVEDAYS.", & + units="s", default=86400.0) + call get_param(param_file, mdl, "ENERGYSAVEDAYS",OS%energysavedays, & + "The interval in units of TIMEUNIT between saves of the \n"//& + "energies of the run and other globally summed diagnostics.", & + default=set_time(0,days=1), timeunit=Time_unit) + + call get_param(param_file, mdl, "OCEAN_SURFACE_STAGGER", stagger, & + "A case-insensitive character string to indicate the \n"//& + "staggering of the surface velocity field that is \n"//& + "returned to the coupler. Valid values include \n"//& + "'A', 'B', or 'C'.", default="C") + if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID + elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE + elseif (uppercase(stagger(1:1)) == 'C') then ; Ocean_sfc%stagger = CGRID_NE + else ; call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif + + call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & + "If true, the coupled driver will add a globally-balanced \n"//& + "fresh-water flux that drives sea-surface salinity \n"//& + "toward specified values.", default=.false.) + call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & + "If true, the coupled driver will add a \n"//& + "heat flux that drives sea-surface temperauture \n"//& + "toward specified values.", default=.false.) + call get_param(param_file, mdl, "RHO_0", Rho0, & + "The mean ocean density used with BOUSSINESQ true to \n"//& + "calculate accelerations and the mass for conservation \n"//& + "properties, or with BOUSSINSEQ false to convert some \n"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) + call get_param(param_file, mdl, "G_EARTH", G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + + call get_param(param_file, mdl, "ICE_SHELF", OS%use_ice_shelf, & + "If true, enables the ice shelf model.", default=.false.) + + call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_apply_rigid_boundary, & + "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) + + if (OS%icebergs_apply_rigid_boundary) then + call get_param(param_file, mdl, "KV_ICEBERG", OS%kv_iceberg, & + "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) + call get_param(param_file, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & + "A typical density of icebergs.", units="kg m-3", default=917.0) + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & + "The latent heat of fusion.", units="J/kg", default=hlf) + call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & + "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& + "below berg are set to zero. Not applied for negative \n"//& + " values.", units="non-dim", default=-1.0) + endif + + OS%press_to_z = 1.0/(Rho0*G_Earth) + + ! Consider using a run-time flag to determine whether to do the diagnostic + ! vertical integrals, since the related 3-d sums are not negligible in cost. + call allocate_surface_state(OS%state, OS%grid, OS%MOM_CSp%use_temperature, & + do_integrals=.true., gas_fields_ocn=gas_fields_ocn) + + call surface_forcing_init(Time_in, OS%grid, param_file, OS%MOM_CSp%diag, & + OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) + + if (OS%use_ice_shelf) then + call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & + OS%MOM_CSp%diag, OS%forces, OS%fluxes) + endif + if (OS%icebergs_apply_rigid_boundary) then + !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) + !This assumes that the iceshelf and ocean are on the same grid. I hope this is true + if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.) + endif + + call MOM_sum_output_init(OS%grid, param_file, OS%dirs%output_directory, & + OS%MOM_CSp%ntrunc, Time_init, OS%sum_output_CSp) + + ! This call has been moved into the first call to update_ocean_model. +! call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & +! OS%Time, 0, OS%grid, OS%GV, OS%sum_output_CSp, OS%MOM_CSp%tracer_flow_CSp) + + ! write_energy_time is the next integral multiple of energysavedays. + OS%write_energy_time = Time_init + OS%energysavedays * & + (1 + (OS%Time - Time_init) / OS%energysavedays) + + if (ASSOCIATED(OS%grid%Domain%maskmap)) then + call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & + OS%MOM_CSp%diag, maskmap=OS%grid%Domain%maskmap, & + gas_fields_ocn=gas_fields_ocn) + else + call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & + OS%MOM_CSp%diag, gas_fields_ocn=gas_fields_ocn) + endif + + ! This call can only occur here if the coupler_bc_type variables have been + ! initialized already using the information from gas_fields_ocn. + if (present(gas_fields_ocn)) then + call calculate_surface_state(OS%state, OS%MOM_CSp%u, & + OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%ave_ssh,& + OS%grid, OS%GV, OS%MOM_CSp) + + call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & + OS%MOM_CSp%use_conT_absS) + endif + + call close_param_file(param_file) + call diag_mediator_close_registration(OS%MOM_CSp%diag) + +! if (is_root_pe()) & +! write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + + call callTree_leave("ocean_model_init(") +end subroutine ocean_model_init + +!> 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 + + integer :: is, ie, js, je + + is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec + call coupler_type_spawn(Ocean_sfc%fields, OS%state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + call calculate_surface_state(OS%state, OS%MOM_CSp%u, & + OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%ave_ssh,& + OS%grid, OS%GV, OS%MOM_CSp) + + call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & + OS%MOM_CSp%use_conT_absS) + +end subroutine ocean_model_init_sfc + +!> Initializes surface forcing: get relevant parameters and allocate arrays. +subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) + 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 !< 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, restore_temp !< If present and true, + !! temp/salt restoring will be applied + + ! local variables + real :: utide !< The RMS tidal velocity, in m s-1. + type(directories) :: dirs + logical :: new_sim, iceberg_flux_diags + type(time_type) :: Time_frc + character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "ocn_comp_nuopc" ! This module's name. + character(len=48) :: stagger + character(len=240) :: basin_file + integer :: i, j, isd, ied, jsd, jed + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + if (associated(CS)) then + call MOM_error(WARNING, "surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + id_clock_forcing=cpu_clock_id('Ocean surface forcing', grain=CLOCK_SUBCOMPONENT) + call cpu_clock_begin(id_clock_forcing) + + CS%diag => diag + + call write_version_number (version) + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & + "The directory in which all input files are found.", & + default=".") + CS%inputdir = slasher(CS%inputdir) + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & + "The mean ocean density used with BOUSSINESQ true to \n"//& + "calculate accelerations and the mass for conservation \n"//& + "properties, or with BOUSSINSEQ false to convert some \n"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & + "The latent heat of fusion.", units="J/kg", default=hlf) + call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & + "The latent heat of fusion.", units="J/kg", default=hlv) + call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & + "The maximum surface pressure that can be exerted by the \n"//& + "atmosphere and floating sea-ice or ice shelves. This is \n"//& + "needed because the FMS coupling structure does not \n"//& + "limit the water that can be frozen out of the ocean and \n"//& + "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "limit is applied if a negative value is used.", units="Pa", & + default=-1.0) + call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & + CS%adjust_net_srestore_to_zero, & + "If true, adjusts the salinity restoring seen to zero\n"//& + "whether restoring is via a salt flux or virtual precip.",& + default=restore_salt) + call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & + CS%adjust_net_srestore_by_scaling, & + "If true, adjustments to salt restoring to achieve zero net are\n"//& + "made by scaling values without moving the zero contour.",& + default=.false.) + call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_TO_ZERO", & + CS%adjust_net_fresh_water_to_zero, & + "If true, adjusts the net fresh-water forcing seen \n"//& + "by the ocean (including restoring) to zero.", default=.false.) + call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & + CS%adjust_net_fresh_water_by_scaling, & + "If true, adjustments to net fresh water to achieve zero net are\n"//& + "made by scaling values without moving the zero contour.",& + default=.false.) + call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & + CS%ice_salt_concentration, & + "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "melt flux (or ice-ocean fresh-water flux).", & + units="kg/kg", default=0.005) + call get_param(param_file, mdl, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & + "If true, return the sea surface height with the \n"//& + "correction for the atmospheric (and sea-ice) pressure \n"//& + "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"//& + "values are 'A', 'B', or 'C'.", default="C") + if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID + elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE + elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE + else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif + call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & + "A factor multiplying the wind-stress given to the ocean by the\n"//& + "coupler. This is used for testing and should be =1.0 for any\n"//& + "production runs.", default=1.0) + + if (restore_salt) then + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "velocity). Note the non-MKS units.", units="m day-1", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & + "A file in which to find the surface salinity to use for restoring.", & + default="salt_restore.nc") + call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & + "The name of the surface salinity variable to read from "//& + "SALT_RESTORE_FILE for restoring salinity.", & + default="salt") +! 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, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & + "If true, the restoring of salinity is applied as a salt \n"//& + "flux instead of as a freshwater flux.", default=.false.) + call get_param(param_file, mdl, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & + "The maximum salinity difference used in restoring terms.", & + units="PSU or g kg-1", default=999.0) + call get_param(param_file, mdl, "MASK_SRESTORE_UNDER_ICE", & + CS%mask_srestore_under_ice, & + "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & + default=.false.) + call get_param(param_file, mdl, "MASK_SRESTORE_MARGINAL_SEAS", & + CS%mask_srestore_marginal_seas, & + "If true, disable SSS restoring in marginal seas. Only used when\n"//& + "RESTORE_SALINITY is True.", default=.false.) + call get_param(param_file, mdl, "BASIN_FILE", basin_file, & + "A file in which to find the basin masks, in variable 'basin'.", & + default="basin.nc") + basin_file = trim(CS%inputdir) // trim(basin_file) + call safe_alloc_ptr(CS%basin_mask,isd,ied,jsd,jed) ; CS%basin_mask(:,:) = 1.0 + if (CS%mask_srestore_marginal_seas) then + call read_data(basin_file,'basin',CS%basin_mask,domain=G%domain%mpp_domain,timelevel=1) + do j=jsd,jed ; do i=isd,ied + if (CS%basin_mask(i,j) >= 6.0) then ; CS%basin_mask(i,j) = 0.0 + else ; CS%basin_mask(i,j) = 1.0 ; endif + enddo ; enddo + endif + endif + + if (restore_temp) then + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "velocity). Note the non-MKS units.", units="m day-1", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & + "A file in which to find the surface temperature to use for restoring.", & + default="temp_restore.nc") + call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & + "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. + CS%Flux_const = CS%Flux_const / 86400.0 + + call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & + "The maximum sst difference used in restoring terms.", & + units="degC ", default=999.0) + + endif + +! Optionally read tidal amplitude from input file (m s-1) on model grid. +! Otherwise use default tidal amplitude for bottom frictionally-generated +! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of +! work done against tides globally using OSU tidal amplitude. + call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & + "The drag coefficient that applies to the tides.", & + units="nondim", default=1.0e-4) + call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & + "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) + if (CS%read_TIDEAMP) then + call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & + "The path to the file containing the spatially varying \n"//& + "tidal amplitudes with INT_TIDE_DISSIPATION.", & + default="tideamp.nc") + CS%utide=0.0 + else + call get_param(param_file, mdl, "UTIDE", CS%utide, & + "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & + units="m s-1", default=0.0) + endif + + call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed) + + if (CS%read_TIDEAMP) then + TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) + call read_data(TideAmp_file,'tideamp',CS%TKE_tidal,domain=G%domain%mpp_domain,timelevel=1) + do j=jsd, jed; do i=isd, ied + utide = CS%TKE_tidal(i,j) + CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + else + do j=jsd,jed; do i=isd,ied + utide=CS%utide + CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + endif + + call time_interp_external_init + +! Optionally read a x-y gustiness field in place of a global +! constant. + + call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & + "If true, use a 2-dimensional gustiness supplied from \n"//& + "an input file", default=.false.) + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & + "The background gustiness in the winds.", units="Pa", & + default=0.02) + if (CS%read_gust_2d) then + call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & + "The file in which the wind gustiness is found in \n"//& + "variable gustiness.") + + call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) + gust_file = trim(CS%inputdir) // trim(gust_file) + call read_data(gust_file,'gustiness',CS%gust,domain=G%domain%mpp_domain, & + timelevel=1) ! units should be Pa + endif + +! See whether sufficiently thick sea ice should be treated as rigid. + call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & + "If true, sea-ice is rigid enough to exert a \n"//& + "nonhydrostatic pressure that resist vertical motion.", & + default=.false.) + if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & + "A typical density of sea ice, used with the kinematic \n"//& + "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & + default=900.0) + call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & + "The kinematic viscosity of sufficiently thick sea ice \n"//& + "for use in calculating the rigidity of sea ice.", & + units="m2 s-1", default=1.0e9) + call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & + "The mass of sea-ice per unit area at which the sea-ice \n"//& + "starts to exhibit rigidity", units="kg m-2", default=1000.0) + endif + + call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & + "If true, makes available diagnostics of fluxes from icebergs\n"//& + "as seen by MOM6.", default=.false.) + call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & + use_berg_fluxes=iceberg_flux_diags) + + call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & + "If true, allows flux adjustments to specified via the \n"//& + "data_table using the component name 'OCN'.", default=.false.) + if (CS%allow_flux_adjustments) then + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) + endif + + if (present(restore_salt)) then ; if (restore_salt) then + salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) + CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) + endif ; endif + + if (present(restore_temp)) then ; if (restore_temp) then + temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) + CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) + endif ; endif + + ! Set up any restart fields associated with the forcing. + call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") +!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!### CS%restart_CSp) + call restart_init_end(CS%restart_CSp) + + if (associated(CS%restart_CSp)) then + call Get_MOM_Input(dirs=dirs) + + new_sim = .false. + if ((dirs%input_filename(1:1) == 'n') .and. & + (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. + if (.not.new_sim) then + call restore_state(dirs%input_filename, dirs%restart_input_dir, Time_frc, & + G, CS%restart_CSp) + endif + endif + +!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) + + call user_revise_forcing_init(param_file, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) +end subroutine surface_forcing_init + +!> Initializes domain and state variables contained in the ocean public type. +subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & + gas_fields_ocn) + type(domain2D), intent(in) :: input_domain !< The FMS domain for the input structure + type(ocean_public_type), intent(inout) :: Ocean_sfc !< Ocean surface state + type(diag_ctrl), intent(in) :: diag !< A structure used to control diagnostics. + logical, intent(in), optional :: maskmap(:,:) !< A pointer to an array indicating which + !! logical processors are actually used for the ocean code. + 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 + !! in the calculation of additional gas or other + !! tracer fluxes. + ! local variables + integer :: xsz, ysz, layout(2) + integer :: isc, iec, jsc, jec + + 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) + else + 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) + + allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & + Ocean_sfc%s_surf (isc:iec,jsc:jec), & + Ocean_sfc%u_surf (isc:iec,jsc:jec), & + Ocean_sfc%v_surf (isc:iec,jsc:jec), & + Ocean_sfc%sea_lev(isc:iec,jsc:jec), & + Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%frazil (isc:iec,jsc:jec)) + + Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model + Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models + Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav + Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%area = 0.0 + Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics + + if (present(gas_fields_ocn)) then + call coupler_type_spawn(gas_fields_ocn, Ocean_sfc%fields, (/isc,isc,iec,iec/), & + (/jsc,jsc,jec,jec/), suffix = '_ocn', as_needed=.true.) + endif + +end subroutine initialize_ocean_public_type + +!> Translates the coupler's ocean_data_type into MOM6's surface state variable. +!! This may eventually be folded into the MOM6's code that calculates the +!! surface state in the first place. +subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, use_conT_absS, & + patm, press_to_z) + type(surface), intent(inout) :: state + type(ocean_public_type), target, intent(inout) :: Ocean_sfc !< Ocean surface state + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + logical, intent(in) :: use_conT_absS !< If true, , the prognostics + !! T&S are the conservative temperature + real, optional, intent(in) :: patm(:,:) !< Atmospheric pressure. + real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric + !! pressure to z? + + ! local variables + real :: IgR0 + character(len=48) :: val_str + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd + integer :: i, j, i0, j0, is, ie, js, je + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + call pass_vector(state%u,state%v,G%Domain) + + call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & + jsc_bnd, jec_bnd) + if (present(patm)) then + ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). + if (.not.present(press_to_z)) call MOM_error(FATAL, & + 'convert_state_to_ocean_type: press_to_z must be present if patm is.') + endif + + i0 = is - isc_bnd ; j0 = js - jsc_bnd + !If directed convert the surface T&S + !from conservative T to potential T and + !from absolute (reference) salinity to practical salinity + ! + if(use_conT_absS) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(state%SSS(i+i0,j+j0)) + Ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(state%SSS(i+i0,j+j0),state%SST(i+i0,j+j0)) + CELSIUS_KELVIN_OFFSET + enddo ; enddo + else + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%t_surf(i,j) = state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET + Ocean_sfc%s_surf(i,j) = state%SSS(i+i0,j+j0) + enddo ; enddo + endif + + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%sea_lev(i,j) = state%sea_lev(i+i0,j+j0) + if (present(patm)) & + Ocean_sfc%sea_lev(i,j) = Ocean_sfc%sea_lev(i,j) + patm(i,j) * press_to_z + if (associated(state%frazil)) & + Ocean_sfc%frazil(i,j) = state%frazil(i+i0,j+j0) + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + + 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*(state%u(I+i0,j+j0)+state%u(I-1+i0,j+j0)) + Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0)*0.5*(state%v(i+i0,J+j0)+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*(state%u(I+i0,j+j0)+state%u(I+i0,j+j0+1)) + Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0)*0.5*(state%v(i+i0,J+j0)+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 + Ocean_sfc%u_surf(i,j) = G%mask2dCu(I+i0,j+j0)*state%u(I+i0,j+j0) + Ocean_sfc%v_surf(i,j) = G%mask2dCv(i+i0,J+j0)*state%v(i+i0,J+j0) + enddo ; enddo + else + write(val_str, '(I8)') Ocean_sfc%stagger + call MOM_error(FATAL, "convert_state_to_ocean_type: "//& + "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) + endif + + if (coupler_type_initialized(state%tr_fields)) then + if (.not.coupler_type_initialized(Ocean_sfc%fields)) then + call MOM_error(FATAL, "convert_state_to_ocean_type: "//& + "Ocean_sfc%fields has not been initialized.") + endif + call coupler_type_copy_data(state%tr_fields, Ocean_sfc%fields) + endif + +end subroutine convert_state_to_ocean_type + +!> Returns pointers to objects within ocean_state_type +subroutine get_state_pointers(OS, grid, surf) + type(ocean_state_type), pointer :: OS !< Ocean state type + type(ocean_grid_type), optional, pointer :: grid !< Ocean grid + type(surface), optional, pointer :: surf !< Ocean surface state + + if (present(grid)) grid => OS%grid + if (present(surf)) surf=> OS%state + +end subroutine get_state_pointers + +!> Maps outgoing ocean data to MCT buffer. +!! See \ref section_ocn_export for a summary of the data +!! that is transferred from MOM6 to MCT. +subroutine ocn_export(ocn_public, grid, exportState) + type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + type(ESMF_State), intent(inout) :: exportState !< outgoing data + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, i1, j1, n, ig, jg !< Grid indices + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) + + call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + + lbnd1 = lbound(dataPtr_t,1) + ubnd1 = ubound(dataPtr_t,1) + lbnd2 = lbound(dataPtr_t,2) + ubnd2 = ubound(dataPtr_t,2) + + ! Copy from ocn_public to exportstate. ocn_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + j1 = j + lbnd2 - grid%jsc + do i=grid%isc,grid%iec + ig = i + grid%idg_offset + i1 = i + lbnd1 - grid%isc + ! surface temperature in Kelvin + dataPtr_t(i1,j1) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_s(i1,j1) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_u(i1,j1) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_v(i1,j1) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocn_public%sea_lev(ig,jg) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + do j=grid%jsc, grid%jec + j1 = j + lbnd2 - grid%jsc + do i=grid%isc,grid%iec + i1 = i + lbnd1 - grid%isc + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 + end do + end do + + ! d/dy ssh + do j=grid%jsc, grid%jec + j1 = j + lbnd2 - grid%jsc + do i=grid%isc,grid%iec + i1 = i + lbnd1 - grid%isc + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 + end do + end do + +end subroutine ocn_export + + +!> Saves restart fields associated with the forcing +subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & + filename_suffix) + type(surface_forcing_CS), pointer :: CS !< 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 !< model time at this call + character(len=*), intent(in) :: directory !< optional directory into which + !! to write these restart files + logical, optional, intent(in) :: time_stamped !< If true, the restart file + !! names include a unique time + !! stamp + character(len=*), optional, intent(in) :: filename_suffix !< 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 + call save_restart(directory, Time, G, CS%restart_CSp, time_stamped) + +end subroutine forcing_save_restart + +!> Updates the ocean model fields. This code wraps the call to step_MOM with MOM6's call. +!! It uses the forcing to advance the ocean model's state from the +!! input value of Ocean_state (which must be for time time_start_update) for a time interval +!! of Ocean_coupling_time_step, returning the publicly visible ocean surface properties in +!! Ocean_sfc and storing the new ocean properties in Ocean_state. +subroutine update_ocean_model(ImportState, OS, Ocean_sfc, time_start_update, & + Ocean_coupling_time_step, sw_decomp, & + c1, c2, c3, c4) + type(ESMF_State), intent(in) :: ImportState + type(ocean_state_type), pointer :: OS !< Structure containing the internal ocean state + type(ocean_public_type), intent(inout) :: Ocean_sfc !< Structure containing all the publicly + !! visible ocean surface fields after a coupling time step + type(time_type), intent(in) :: time_start_update !< Time at the beginning of the update step + type(time_type), intent(in) :: Ocean_coupling_time_step !< Amount of time over which to + !! advance the ocean + logical, intent(in) :: sw_decomp !< controls if shortwave is + !!decomposed into four components + real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + + ! 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. + real :: weight !< Flux accumulation weight + real :: time_step !< The time step of a call to step_MOM in seconds. + integer :: secs, days + integer :: is, ie, js, je + + call callTree_enter("update_ocean_model(), ocn_comp_nuopc.F90") + call get_time(Ocean_coupling_time_step, secs, days) + time_step = 86400.0*real(days) + real(secs) + + if (time_start_update /= OS%Time) then + call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& + "agree with time_start_update argument.") + endif + + if (.not.associated(OS)) then + call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & + "ocean_state_type structure. ocean_model_init must be "// & + "called first to allocate this structure.") + return + endif + + ! This is benign but not necessary if ocean_model_init_sfc was called or if + ! OS%state%tr_fields was spawnded in ocean_model_init. Consider removing it. + is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec + call coupler_type_spawn(Ocean_sfc%fields, OS%state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + weight = 1.0 + + if (OS%fluxes%fluxes_used) then + ! GMM, is enable_averaging needed now? + call enable_averaging(time_step, OS%Time + Ocean_coupling_time_step, OS%MOM_CSp%diag) + call ocn_import(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, OS%state, ImportState, sw_decomp, & + c1, c2, c3, c4, OS%restore_salinity,OS%restore_temp) + + ! Fields that exist in both the forcing and mech_forcing types must be copied. + call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) + +#ifdef _USE_GENERIC_TRACER + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes +#endif + + ! Add ice shelf fluxes + if (OS%use_ice_shelf) then + call shelf_calc_flux(OS%State, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp) + endif + + ! GMM, check ocean_model_MOM.F90 to enable the following option + !if (OS%icebergs_apply_rigid_boundary) then + !This assumes that the iceshelf and ocean are on the same grid. I hope this is true + ! call add_berg_flux_to_shelf(OS%grid, OS%fluxes,OS%use_ice_shelf,OS%density_iceberg,OS%kv_iceberg, OS%latent_heat_fusion, OS%State, time_step, OS%berg_area_threshold) + !endif + + ! Indicate that there are new unused fluxes. + OS%fluxes%fluxes_used = .false. + OS%fluxes%dt_buoy_accum = time_step + else + OS%flux_tmp%C_p = OS%fluxes%C_p + ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed. + call ocn_import(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & + OS%state, ImportState, sw_decomp, c1, c2, c3, c4, & + OS%restore_salinity,OS%restore_temp) + + if (OS%use_ice_shelf) then + call shelf_calc_flux(OS%State, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) + endif + + ! GMM, check ocean_model_MOM.F90 to enable the following option + !if (OS%icebergs_apply_rigid_boundary) then + !This assumes that the iceshelf and ocean are on the same grid. I hope this is true + ! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg,OS%kv_iceberg, OS%latent_heat_fusion, OS%State, time_step, OS%berg_area_threshold) + !endif + + ! Accumulate the forcing over time steps + call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, 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. + 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) + + if (OS%nstep==0) then + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes) + + call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & + OS%Time, 0, OS%grid, OS%GV, OS%sum_output_CSp, & + OS%MOM_CSp%tracer_flow_CSp) + endif + + call disable_averaging(OS%MOM_CSp%diag) + Master_time = OS%Time ; Time1 = OS%Time + + if(OS%MOM_Csp%offline_tracer_mode) then + call step_offline(OS%forces, OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) + else + call step_MOM(OS%forces, OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) + endif + + OS%Time = Master_time + Ocean_coupling_time_step + OS%nstep = OS%nstep + 1 + + call enable_averaging(time_step, OS%Time, OS%MOM_CSp%diag) + call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & + OS%MOM_CSp%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%MOM_CSp%diag) + + if (OS%fluxes%fluxes_used) then + call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%MOM_CSp%diag) + call forcing_diagnostics(OS%fluxes, OS%state, OS%fluxes%dt_buoy_accum, & + OS%grid, OS%MOM_CSp%diag, OS%forcing_CSp%handles) + call accumulate_net_input(OS%fluxes, OS%state, OS%fluxes%dt_buoy_accum, & + OS%grid, OS%sum_output_CSp) + call disable_averaging(OS%MOM_CSp%diag) + endif + +! See if it is time to write out the energy. + if ((OS%Time + ((Ocean_coupling_time_step)/2) > OS%write_energy_time) .and. & + (OS%MOM_CSp%t_dyn_rel_adv==0.0)) then + call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & + OS%Time, OS%nstep, OS%grid, OS%GV, OS%sum_output_CSp, & + OS%MOM_CSp%tracer_flow_CSp) + OS%write_energy_time = OS%write_energy_time + OS%energysavedays + endif + +! Translate state into Ocean. +! call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & +! Ice_ocean_boundary%p, OS%press_to_z) + call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & + OS%MOM_CSp%use_conT_absS) + + call callTree_leave("update_ocean_model()") +end subroutine update_ocean_model + +!> This function has a few purposes: 1) it allocates and initializes the data +!! in the fluxes structure; 2) it imports surface fluxes using data from +!! the coupler; and 3) it can apply restoring in SST and SSS. +!! See \ref section_ocn_import for a summary of the surface fluxes that are +!! passed from MCT to MOM6, including fluxes that need to be included in +!! the future. +subroutine ocn_import(forces, fluxes, Time, G, CS, state, ImportState, sw_decomp, & + c1, c2, c3, c4, restore_salt, restore_temp) + type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), intent(inout) :: fluxes !< Surface fluxes + type(time_type), intent(in) :: Time !< Model time + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid + type(surface_forcing_CS), pointer :: CS !< control structure returned by + !! a previous call to surface_forcing_init + type(surface), intent(in) :: state !< control structure to ocean + !! surface state fields. + type(ESMF_State), intent(in) :: ImportState !< fluxes from top level + logical, intent(in) :: sw_decomp !< controls if shortwave is + !!decomposed into four components + real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are + !! restored + + ! local variables + real, dimension(SZIB_(G),SZJB_(G)) :: & + taux_at_q, & ! Zonal wind stresses at q points (Pa) + tauy_at_q ! Meridional wind stresses at q points (Pa) + + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_h, & ! Zonal wind stresses at h points (Pa) + tauy_at_h, & ! Meridional wind stresses at h points (Pa) + 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) + SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value (g/kg) + SSS_mean, & ! A (mean?) salinity about which to normalize local salinity + ! anomalies when calculating restorative precipitation anomalies (g/kg) + PmE_adj, & ! The adjustment to PminusE that will cause the salinity + ! to be restored toward its target value (kg/(m^2 * s)) + net_FW, & ! The area integrated net freshwater flux into the ocean (kg/s) + net_FW2, & ! The area integrated net freshwater flux into the ocean (kg/s) + work_sum, & ! A 2-d array that is used as the work space for a global + ! sum, used with units of m2 or (kg/s) + open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria + + real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) + real :: Irho0 ! inverse of the mean density in (m^3/kg) + real :: taux2, tauy2 ! squared wind stresses (Pa^2) + real :: tau_mag ! magnitude of the wind stress (Pa) + real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) + real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) + real :: mass_ice ! mass of sea ice at a face (kg/m^2) + real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) + + integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0, i1, j1 + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + + logical :: restore_salinity ! local copy of the argument restore_salt, if it + ! is present, or false (no restoring) otherwise. + logical :: restore_sst ! local copy of the argument restore_temp, if it + ! is present, or false (no restoring) otherwise. + real :: delta_sss ! temporary storage for sss diff from restoring value + real :: delta_sst ! temporary storage for sst diff from restoring value + + real :: C_p ! heat capacity of seawater ( J/(K kg) ) + + real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + + call cpu_clock_begin(id_clock_forcing) + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 + + C_p = fluxes%C_p + Irho0 = 1.0/CS%Rho0 + open_ocn_mask(:,:) = 1.0 + pme_adj(:,:) = 0.0 + fluxes%vPrecGlobalAdj = 0.0 + fluxes%vPrecGlobalScl = 0.0 + fluxes%saltFluxGlobalAdj = 0.0 + fluxes%saltFluxGlobalScl = 0.0 + fluxes%netFWGlobalAdj = 0.0 + fluxes%netFWGlobalScl = 0.0 + + restore_salinity = .false. + if (present(restore_salt)) restore_salinity = restore_salt + restore_sst = .false. + if (present(restore_temp)) restore_sst = restore_temp + + ! if true, allocation and initialization + if (fluxes%dt_buoy_accum < 0) then + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & + ustar=.true., press=.true.) + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & + press=.true.) + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) + + call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%p_surf_SSH,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) + + if (CS%allow_flux_adjustments) then + call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + endif + + do j=js-2,je+2 ; do i=is-2,ie+2 + fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + enddo; enddo + + if (CS%rigid_sea_ice) then + call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) + call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) + endif + + if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + + fluxes%dt_buoy_accum = 0.0 + endif ! endif for allocation and initialization + + if (CS%allow_flux_adjustments) then + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 + endif + + if (CS%area_surf < 0.0) then + do j=js,je ; do i=is,ie + work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + enddo ; enddo + CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) + endif ! endif for allocation and initialization + + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 + enddo ; enddo + + ! Salinity restoring logic + if (restore_salinity) then + call time_interp_external(CS%id_srestore,Time,data_restore) + ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) + open_ocn_mask(:,:) = 1.0 + if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice + do j=js,je ; do i=is,ie + if (state%SST(i,j) .le. -0.0539*state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + enddo; enddo + endif + if (CS%salt_restore_as_sflux) then + do j=js,je ; do i=is,ie + delta_sss = data_restore(i,j)- state%SSS(i,j) + delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) + fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & + (CS%basin_mask(i,j)*open_ocn_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + fluxes%saltFluxGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + endif + endif + fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic + else + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.5) then + delta_sss = state%SSS(i,j) - data_restore(i,j) + delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) + fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j))* & + (CS%Rho0*CS%Flux_const) * & + delta_sss / (0.5*(state%SSS(i,j) + data_restore(i,j))) + endif + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + fluxes%vPrecGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif + endif + endif + endif + + ! SST restoring logic + if (restore_sst) then + call time_interp_external(CS%id_trestore,Time,data_restore) + do j=js,je ; do i=is,ie + delta_sst = data_restore(i,j)- state%SST(i,j) + delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) + fluxes%heat_added(i,j) = G%mask2dT(i,j) * (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + enddo; enddo + endif + + ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later + wind_stagger = AGRID + + if (wind_stagger == BGRID_NE) then + ! This is necessary to fill in the halo points. + taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif + + call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_osalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwdn" , dataPtr_lwdn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_meltw", dataPtr_meltw, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_melth", dataPtr_melth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_iosalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_prec" , dataPtr_prec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rain" , dataPtr_rain, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_snow" , dataPtr_snow, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_p,1) + ubnd1 = ubound(dataPtr_p,1) + lbnd2 = lbound(dataPtr_p,2) + ubnd2 = ubound(dataPtr_p,2) + + do j=js,je ; do i=is,ie + i1 = i + lbnd1 - is + j1 = j + lbnd2 - js + + if (wind_stagger == BGRID_NE) then + taux_at_q(i,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier + tauy_at_q(i,j) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier + ! GMM, cime uses AGRID + elseif (wind_stagger == AGRID) then + taux_at_h(i,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier + tauy_at_h(i,j) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + forces%taux(I,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier + forces%tauy(i,J) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier + endif + + ! liquid precipitation (rain) + if (ASSOCIATED(fluxes%lprec)) & + fluxes%lprec(i,j) = dataPtr_rain(i1,j1) * G%mask2dT(i,j) + + ! frozen precipitation (snow) + if (ASSOCIATED(fluxes%fprec)) & + fluxes%fprec(i,j) = dataPtr_snow(i1,j1) * G%mask2dT(i,j) + + ! evaporation + if (ASSOCIATED(fluxes%evap)) & + fluxes%evap(i,j) = dataPtr_evap(i1,j1) * G%mask2dT(i,j) + + ! river runoff flux + if (ASSOCIATED(fluxes%lrunoff)) & + fluxes%lrunoff(i,j) = dataPtr_rofl(i1,j1) * G%mask2dT(i,j) + + ! ice runoff flux + if (ASSOCIATED(fluxes%frunoff)) & + fluxes%frunoff(i,j) = dataPtr_rofi(i1,j1) * G%mask2dT(i,j) + + ! GMM, we don't have an icebergs yet so the following is not needed + !if (((ASSOCIATED(IOB%ustar_berg) .and. (.not. ASSOCIATED(fluxes%ustar_berg))) & + ! .or. (ASSOCIATED(IOB%area_berg) .and. (.not. ASSOCIATED(fluxes%area_berg)))) & + ! .or. (ASSOCIATED(IOB%mass_berg) .and. (.not. ASSOCIATED(fluxes%mass_berg)))) & + ! call allocate_forcing_type(G, fluxes, iceberg=.true.) + !if (ASSOCIATED(IOB%ustar_berg)) & + ! fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + !if (ASSOCIATED(IOB%area_berg)) & + ! fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + !if (ASSOCIATED(IOB%mass_berg)) & + ! fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + + ! GMM, cime does not not have an equivalent for heat_content_lrunoff and + ! heat_content_frunoff. I am seeting these to zero for now. + if (ASSOCIATED(fluxes%heat_content_lrunoff)) & + fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) + + if (ASSOCIATED(fluxes%heat_content_frunoff)) & + fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) + + ! longwave radiation, sum up and down (W/m2) + if (ASSOCIATED(fluxes%LW)) & + fluxes%LW(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * G%mask2dT(i,j) + + ! sensible heat flux (W/m2) + if (ASSOCIATED(fluxes%sens)) & + fluxes%sens(i,j) = dataPtr_sen(i1,j1) * G%mask2dT(i,j) + + ! latent heat flux (W/m^2) + if (ASSOCIATED(fluxes%latent)) & + fluxes%latent(i,j) = dataPtr_lat(i1,j1) * G%mask2dT(i,j) + + if (sw_decomp) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ! 1) visible, direct shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_vis_dir)) & + fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c1 + ! 2) visible, diffuse shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_vis_dif)) & + fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c2 + ! 3) near-IR, direct shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_nir_dir)) & + fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c3 + ! 4) near-IR, diffuse shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_nir_dif)) & + fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c4 + + 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) + else + call MOM_error(FATAL,"fill_data_ice_ocean_bnd: this option has not been implemented yet."// & + "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); + endif + + ! applied surface pressure from atmosphere and cryosphere + ! sea-level pressure (Pa) + if (ASSOCIATED(forces%p_surf_full) .and. ASSOCIATED(forces%p_surf)) then + forces%p_surf_full(i,j) = G%mask2dT(i,j) * dataPtr_p(i1,j1) + if (CS%max_p_surf >= 0.0) then + forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) + else + forces%p_surf(i,j) = forces%p_surf_full(i,j) + endif + + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH(i,j) = forces%p_surf(i,j) + else + forces%p_surf_SSH(i,j) = forces%p_surf_full(i,j) + endif + + endif + + ! salt flux + ! more salt restoring logic + if (ASSOCIATED(fluxes%salt_flux)) & + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(dataPtr_osalt(i1,j1) + fluxes%salt_flux(i,j)) + + if (ASSOCIATED(fluxes%salt_flux_in)) & + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*dataPtr_iosalt(i1,j1) + + enddo ; enddo + ! ############################ END OF MCT to MOM ############################## + + ! adjust the NET fresh-water flux to zero, if flagged + if (CS%adjust_net_fresh_water_to_zero) then + do j=js,je ; do i=is,ie + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & + (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + ! The following contribution appears to be calculating the volume flux of sea-ice + ! melt. This calculation is clearly WRONG if either sea-ice has variable + ! salinity or the sea-ice is completely fresh. + ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system + ! is constant. + ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA + if (ASSOCIATED(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & + net_FW(i,j) = net_FW(i,j) - G%areaT(i,j) * & + (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) + net_FW2(i,j) = net_FW(i,j) + enddo ; enddo + + if (CS%adjust_net_fresh_water_by_scaling) then + call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)) * G%mask2dT(i,j) + enddo; enddo + else + fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif + + endif + + ! surface momentum stress related fields as function of staggering + if (wind_stagger == BGRID_NE) then + if (G%symmetric) & + call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo ; enddo + + elseif (wind_stagger == AGRID) then + call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo ; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo ; enddo + + else ! C-grid wind stresses. + if (G%symmetric) & + call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) + call pass_vector(forces%taux, forces%tauy, G%Domain) + + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo ; enddo + + endif ! endif for wind related fields + + + ! sea ice related fields + if (CS%rigid_sea_ice) then + ! The commented out code here and in the following lines is the correct + ! version, but the incorrect version is being retained temporarily to avoid + ! changing answers. + call pass_var(forces%p_surf_full, G%Domain) + I_GEarth = 1.0 / G%G_Earth + Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) + do I=isd,ied-1 ; do j=jsd,jed + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this + ! a maximum for the second call. + forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff + enddo ; enddo + do i=isd,ied ; do J=jsd,jed-1 + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_v(i,J) = Kv_rho_ice * mass_eff + enddo ; enddo + endif + + if (CS%allow_flux_adjustments) then + ! Apply adjustments to fluxes + call apply_flux_adjustments(G, CS, Time, forces, fluxes) + endif + + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(state, fluxes, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) + +end subroutine ocn_import + +!> Adds flux adjustments obtained via data_override +!! Component name is 'OCN' +!! Available adjustments are: +!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) +!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) +subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure + type(time_type), intent(in) :: Time !< Model time structure + type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), optional, intent(inout) :: fluxes !< Surface fluxes structure + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h ! Fluxes at h points (W m-2 or kg m-2 s-1) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y, overrode_h + + isc = G%isc; iec = G%iec + jsc = G%jsc; jec = G%jec + + overrode_h = .false. + call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) + + if (overrode_h) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo; enddo + endif + + call pass_var(fluxes%heat_added, G%Domain) + + overrode_h = .false. + call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) + + if (overrode_h) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo; enddo + endif + + call pass_var(fluxes%salt_flux_added, G%Domain) + overrode_h = .false. + + call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) + + if (overrode_h) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo; enddo + endif + + call pass_var(fluxes%vprec, G%Domain) + + + tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 + ! Either reads data or leaves contents unchanged + overrode_x = .false. ; overrode_y = .false. + call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) + call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) + + if (overrode_x .or. overrode_y) then + if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& + "Both taux_adj and tauy_adj must be specified, or neither, in data_table") + + ! Rotate winds + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) + dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) + rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) + if (rDlon > 0.) rDlon = 1. / rDlon + cosA = dLonDx * rDlon + sinA = dLonDy * rDlon + zonal_tau = tempx_at_h(i,j) + merid_tau = tempy_at_h(i,j) + tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau + tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau + enddo ; enddo + + ! Average to C-grid locations + do j=G%jsc,G%jec ; do I=G%isc-1,G%iec + forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) + enddo ; enddo + + do J=G%jsc-1,G%jec ; do i=G%isc,G%iec + forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) + enddo ; enddo + endif ! overrode_x .or. overrode_y + +end subroutine apply_flux_adjustments + +!> Terminates the model run, saving the ocean state in a +!! restart file and deallocating any data associated with the ocean. +subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time) + 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!< 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. + + !if (debug .and. is_root_pe()) write(glb%stdout,*)'Here 1' + !GMM call save_restart(Ocean_state, Time) + call diag_mediator_end(Time, Ocean_state%MOM_CSp%diag) + call MOM_end(Ocean_state%MOM_CSp) + if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) + !if (debug .and. is_root_pe()) write(glb%stdout,*)'Here 2' + +end subroutine ocean_model_end + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + +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 + + integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + +! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain. +! We want to return the MOM data on the mpp (compute) domain +! Get MOM domain extents + call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec) + call mpp_get_data_domain (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed) + + g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1 + + + select case(name) + case('area') + 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) +!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 + case('t_pme') + 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 + case('t_calving') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('btfHeat') + array2D(isc:,jsc:) = 0 + case('tlat') + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + case('tlon') + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + case('ulat') + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + case('ulon') + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + case('vlat') + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + case('vlon') + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + case('geoLatBu') + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + case('geoLonBu') + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + case('cos_rot') + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + 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,'get_ocean_data_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 + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + + select case(name) + case('c_p') + value = OS%C_p + case default + call MOM_error(FATAL,'get_ocean_data_data1D: unknown argument name='//name) + end select + + +end subroutine ocean_model_data1D_get + +!####################################################################### +! +! +! +! Obtain the ocean grid. +! +! + subroutine get_ocean_grid(OS, Gridp) + type(ocean_state_type) :: OS + type(ocean_grid_type) , pointer :: Gridp + + Gridp => OS%grid + return + + end subroutine get_ocean_grid +! NAME="get_ocean_grid" + +end module ocn_comp_nuopc