diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index e0a4cfb36..e68a57624 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -88,10 +88,12 @@ def gen_runseq(case, coupling_times): if (cpl_seq_option == 'RASM'): runseq.add_action("MED med_phases_prep_ocn_map" , med_to_ocn) if cpl_add_aoflux: - runseq.add_action("MED med_phases_aofluxes_run" , run_ocn and run_atm and (med_to_ocn or med_to_atm)) + runseq.add_action("MED med_phases_aofluxes_run" , run_ocn and run_atm and (med_to_ocn or med_to_atm)) runseq.add_action("MED med_phases_prep_ocn_merge" , med_to_ocn) runseq.add_action("MED med_phases_prep_ocn_accum_fast" , med_to_ocn) runseq.add_action("MED med_phases_ocnalb_run" , (run_ocn and run_atm and (med_to_ocn or med_to_atm)) and not xcompset) + runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode) + runseq.add_action("MED med_phases_prep_lnd" , med_to_lnd) runseq.add_action("MED -> LND :remapMethod=redist" , med_to_lnd) runseq.add_action("MED med_phases_prep_ice" , med_to_ice) @@ -108,18 +110,21 @@ def gen_runseq(case, coupling_times): runseq.add_action("ROF" , run_rof and not rof_outer_loop) runseq.add_action("WAV" , run_wav) runseq.add_action("OCN" , run_ocn and not ocn_outer_loop) + if coupling_mode == 'hafs': runseq.add_action("OCN -> MED :remapMethod=redist:ignoreUnmatchedIndices=true" , run_ocn and not ocn_outer_loop) else: runseq.add_action("OCN -> MED :remapMethod=redist" , run_ocn and not ocn_outer_loop) + if (cpl_seq_option == 'TIGHT'): runseq.add_action("MED med_phases_prep_ocn_map" , med_to_ocn) if cpl_add_aoflux: - runseq.add_action("MED med_phases_aofluxes_run" , run_ocn and run_atm) + runseq.add_action("MED med_phases_aofluxes_run" , run_ocn and run_atm) runseq.add_action("MED med_phases_prep_ocn_merge" , med_to_ocn) runseq.add_action("MED med_phases_prep_ocn_accum_fast" , med_to_ocn) runseq.add_action("MED med_phases_ocnalb_run" , (run_ocn and run_atm) and not xcompset) - runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode and not ocn_outer_loop) + runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode) + runseq.add_action("LND -> MED :remapMethod=redist" , run_lnd) runseq.add_action("ICE -> MED :remapMethod=redist" , run_ice) runseq.add_action("MED med_phases_diag_ice_ice2med" , run_ice and diag_mode) diff --git a/mediator/med.F90 b/mediator/med.F90 index d65d935f1..cfb71f5cf 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -73,7 +73,7 @@ subroutine SetServices(gcomp, rc) use ESMF , only: ESMF_SUCCESS, ESMF_GridCompSetEntryPoint use ESMF , only: ESMF_METHOD_INITIALIZE, ESMF_METHOD_RUN use ESMF , only: ESMF_GridComp, ESMF_MethodRemove - use NUOPC , only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize, NUOPC_NOOP + use NUOPC , only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize, NUOPC_NoOP use NUOPC_Mediator , only: mediator_routine_SS => SetServices use NUOPC_Mediator , only: mediator_routine_Run => routine_Run use NUOPC_Mediator , only: mediator_label_DataInitialize => label_DataInitialize @@ -190,6 +190,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_history_write", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! setup mediator restart phase @@ -201,6 +204,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_restart_write", specRoutine=med_phases_restart_write, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_restart_write", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! setup mediator profile phase @@ -212,6 +218,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_profile", specRoutine=med_phases_profile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_profile", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for atm @@ -234,6 +243,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ocn_map", specRoutine=med_phases_prep_ocn_map, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_prep_ocn_map", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_ocn_merge"/), userRoutine=mediator_routine_Run, rc=rc) @@ -241,6 +253,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ocn_merge", specRoutine=med_phases_prep_ocn_merge, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_prep_ocn_merge", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_ocn_accum_fast"/), userRoutine=mediator_routine_Run, rc=rc) @@ -248,6 +263,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ocn_accum_fast", specRoutine=med_phases_prep_ocn_accum_fast, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_prep_ocn_accum_fast", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_ocn_accum_avg"/), userRoutine=mediator_routine_Run, rc=rc) @@ -295,6 +313,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_prep_rof_accum", specRoutine=med_phases_prep_rof_accum, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_prep_rof_accum", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for wav @@ -324,6 +345,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_prep_glc_accum", specRoutine=med_phases_prep_glc_accum, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_prep_glc_accum", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocean albedo computation @@ -335,6 +359,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_ocnalb_run", specRoutine=med_phases_ocnalb_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_ocnalb_run", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocn/atm flux computation @@ -346,6 +373,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_aofluxes_run", specRoutine=med_phases_aofluxes_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_aofluxes_run", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for updating fractions @@ -357,6 +387,9 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_fraction_set", specRoutine=med_fraction_set, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_fraction_set", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routines for budget diagnostics @@ -367,54 +400,81 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_atm", specRoutine=med_phases_diag_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_atm", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_lnd"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_lnd", specRoutine=med_phases_diag_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_lnd", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_rof"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_rof", specRoutine=med_phases_diag_rof, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_rof", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_ocn"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_ocn", specRoutine=med_phases_diag_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_ocn", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_glc"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_glc", specRoutine=med_phases_diag_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_glc", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_ice_ice2med"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_ice_ice2med", specRoutine=med_phases_diag_ice_ice2med, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_ice_ice2med", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_ice_med2ice"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_ice_med2ice", specRoutine=med_phases_diag_ice_med2ice, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_ice_med2ice", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_accum"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaselabel="med_phases_diag_accum", specRoutine=med_phases_diag_accum, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_accum", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_diag_print"/), userRoutine=mediator_routine_Run, rc=rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & specPhaseLabel="med_phases_diag_print", specRoutine=med_phases_diag_print, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_diag_print", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! attach specializing method(s) @@ -2382,15 +2442,15 @@ subroutine med_grid_write(grid, fileName, rc) use ESMF, only : ESMF_SUCCESS, ESMF_GRIDITEM_MASK, ESMF_GRIDITEM_AREA ! input/output variables - type(ESMF_Grid), intent(in) :: grid - character(len=*) :: fileName - integer, intent(out) :: rc + type(ESMF_Grid) , intent(in) :: grid + character(len=*), intent(in) :: fileName + integer , intent(out) :: rc ! local variables - type(ESMF_Array) :: array + type(ESMF_Array) :: array type(ESMF_ArrayBundle) :: arrayBundle - integer :: tileCount - logical :: isPresent + integer :: tileCount + logical :: isPresent character(len=*), parameter :: subname=' (module_MED_map:med_grid_write) ' !------------------------------------------------------------------------------- diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index cae818903..faeea6e50 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -22,16 +22,16 @@ module med_diag_mod use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time use ESMF , only : ESMF_VM, ESMF_VMReduce, ESMF_REDUCE_SUM use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet - use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmIsRinging - use ESMF , only : ESMF_FieldBundle, ESMF_AlarmRingerOff + use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use shr_const_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice use shr_const_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, logunit, mastertask use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : chkerr => med_utils_ChkErr + use perf_mod , only : t_startf, t_stopf implicit none private @@ -39,6 +39,7 @@ module med_diag_mod public :: med_diag_init public :: med_diag_zero public :: med_phases_diag_accum + public :: med_phases_diag_print public :: med_phases_diag_atm public :: med_phases_diag_lnd public :: med_phases_diag_rof @@ -46,7 +47,6 @@ module med_diag_mod public :: med_phases_diag_ocn public :: med_phases_diag_ice_ice2med public :: med_phases_diag_ice_med2ice - public :: med_phases_diag_print private :: med_diag_sum_master private :: med_diag_print_atm @@ -56,6 +56,7 @@ module med_diag_mod type, public :: budget_diag_type character(CS) :: name end type budget_diag_type + type, public :: budget_diag_indices type(budget_diag_type), pointer :: comps(:) => null() type(budget_diag_type), pointer :: fields(:) => null() @@ -92,8 +93,8 @@ module med_diag_mod ! C for component ! --------------------------------- - ! "r" is receive from the component to the mediator - ! "s" is send from the mediator to the component + ! "r" is receive by the mediator from the component + ! "s" is send from the mediator to the component integer :: c_atm_send ! model index: atm integer :: c_atm_recv ! model index: atm @@ -205,6 +206,8 @@ module med_diag_mod real(r8), parameter :: HFLXtoWFLX = & ! water flux implied by latent heat of fusion & - (shr_const_ocn_ref_sal-shr_const_ice_ref_sal) / & & (shr_const_ocn_ref_sal*shr_const_latice) + + ! WFLX (kg/m^2s) = -SFLX (kg/m^2s) / ocn_ref_sal (psu) (34.7g/kg) / 1.e-3 kg/g real(r8), parameter :: SFLXtoWFLX = & ! water flux implied by salt flux (kg/m^2s) -1._r8/(shr_const_ocn_ref_sal*1.e-3_r8) @@ -380,6 +383,7 @@ subroutine med_diag_init(gcomp, rc) alarmname='alarm_stop', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + contains integer function get_diag_attribute(gcomp, name, rc) type(ESMF_GridComp) , intent(inout) :: gcomp @@ -408,7 +412,6 @@ end function get_diag_attribute end subroutine med_diag_init !=============================================================================== - subroutine med_diag_zero( gcomp, mode, rc) ! ------------------------------------------------------------------ @@ -428,6 +431,7 @@ subroutine med_diag_zero( gcomp, mode, rc) character(*), parameter :: subName = '(med_diag_zero) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) if (present(mode)) then if (trim(mode) == 'inst') then @@ -495,10 +499,10 @@ subroutine med_diag_zero( gcomp, mode, rc) endif enddo end if + call t_stopf('MED:'//subname) end subroutine med_diag_zero !=============================================================================== - subroutine med_phases_diag_accum(gcomp, rc) ! ------------------------------------------------------------------ @@ -514,15 +518,16 @@ subroutine med_phases_diag_accum(gcomp, rc) character(*), parameter :: subName = '(med_diag_accum) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS do ip = period_inst+1,size(budget_diags%periods) budget_local(:,:,ip) = budget_local(:,:,ip) + budget_local(:,:,period_inst) enddo budget_counter(:,:,:) = budget_counter(:,:,:) + 1.0_r8 + call t_stopf('MED:'//subname) end subroutine med_phases_diag_accum !=============================================================================== - subroutine med_diag_sum_master(gcomp, rc) ! ------------------------------------------------------------------ @@ -542,6 +547,7 @@ subroutine med_diag_sum_master(gcomp, rc) character(*), parameter :: subName = '(med_diag_sum_master) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -560,10 +566,11 @@ subroutine med_diag_sum_master(gcomp, rc) budget_global = reshape(budget_global_1d,(/f_size,c_size,p_size/)) budget_local(:,:,:) = 0.0_r8 + call t_stopf('MED:'//subname) + end subroutine med_diag_sum_master !=============================================================================== - subroutine med_phases_diag_atm(gcomp, rc) ! ------------------------------------------------------------------ @@ -585,9 +592,11 @@ subroutine med_phases_diag_atm(gcomp, rc) real(r8), pointer :: ofrac(:) => null() real(r8), pointer :: areas(:) => null() real(r8), pointer :: lats(:) => null() + type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_atm) ' !------------------------------------------------------------------------------- + call t_startf('MED:'//subname) rc = ESMF_SUCCESS nullify(is_local%wrap) @@ -595,22 +604,30 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get fractions on atm mesh - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', fldptr1=lfrac, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrac', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'ifrac', field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', fldptr1=ifrac, rc=rc) + call ESMF_FieldGet(lfield, farrayptr=ifrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', fldptr1=ofrac, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'ofrac', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=ofrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return areas => is_local%wrap%mesh_info(compatm)%areas lats => is_local%wrap%mesh_info(compatm)%lats allocate(afrac(size(areas))) afrac = 1.0_R8 + !------------------------------- - ! from atm to mediator + ! from atm to mediator (_recv suffix is what the mediator is receiving) !------------------------------- ip = period_inst + do n = 1,size(afrac) nf = f_area budget_local(nf,c_atm_recv ,ip) = budget_local(nf,c_atm_recv ,ip) - areas(n)*afrac(n) @@ -623,32 +640,35 @@ subroutine med_phases_diag_atm(gcomp, rc) end if end do - call diag_atm(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', f_heat_swnet, & + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', f_heat_swnet, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', f_heat_lwdn, & + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn', f_heat_lwdn, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', f_watr_rain, & + ! Note that passing f_watr_rain twice will just add up contributions from Faxa_rainc and Faxa_rainl + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', f_watr_rain, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', f_watr_rain, & + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', f_watr_rain, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', f_watr_snow, & + ! Note that passing f_watr_rain twice will just add up contributions from Faxa_snowc and Faxa_snowl + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', f_watr_snow, & + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm_wiso(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', & + call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', & f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm_wiso(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', & + call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', & f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! heat implied by snow flux + + ! heat implied by snow flux from atm to mediator budget_local(f_heat_latf,c_atm_recv ,ip) = -budget_local(f_watr_snow,c_atm_recv ,ip)*shr_const_latice budget_local(f_heat_latf,c_lnd_arecv,ip) = -budget_local(f_watr_snow,c_lnd_arecv,ip)*shr_const_latice budget_local(f_heat_latf,c_ocn_arecv,ip) = -budget_local(f_watr_snow,c_ocn_arecv,ip)*shr_const_latice @@ -672,29 +692,29 @@ subroutine med_phases_diag_atm(gcomp, rc) end if end do - call diag_atm(is_local%wrap%FBExp(compatm), 'Faxx_lwup', f_heat_lwup, & + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lwup', f_heat_lwup, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBExp(compatm), 'Faxx_lat', f_heat_latvap, & + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lat', f_heat_latvap, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! water isotopes - call diag_atm_wiso(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap_wiso', & + call diag_atm_wiso_send(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap_wiso', & f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - !----------- + call t_stopf('MED:'//subname) + contains - !----------- - subroutine diag_atm(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -709,27 +729,69 @@ subroutine diag_atm(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, bu integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr1=data , rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1,size(data) - budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*afrac(n)*data(n) - budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(n) - budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(n) + budget(nf,c_atm_recv,ip) = budget(nf,c_atm_recv,ip) - areas(n)*data(n)*afrac(n) + budget(nf,c_lnd_arecv,ip) = budget(nf,c_lnd_arecv,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_arecv,ip) = budget(nf,c_ocn_arecv,ip) + areas(n)*data(n)*ofrac(n) if (lats(n) > 0.0_r8) then - budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*ifrac(n)*data(n) + budget(nf,c_inh_arecv,ip) = budget(nf,c_inh_arecv,ip) + areas(n)*data(n)*ifrac(n) else - budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*ifrac(n)*data(n) + budget(nf,c_ish_arecv,ip) = budget(nf,c_ish_arecv,ip) + areas(n)*data(n)*ifrac(n) end if end do end if - end subroutine diag_atm + end subroutine diag_atm_recv - subroutine diag_atm_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & + subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + real(r8) :: term + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( FB_fldchk(FB, trim(fldname), rc=rc)) then + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data) + budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) + budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if + end subroutine diag_atm_send + + subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & afrac, lfrac, ofrac, ifrac, budget, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB @@ -747,11 +809,14 @@ subroutine diag_atm_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr2=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1,size(data, dim=2) @@ -783,15 +848,73 @@ subroutine diag_atm_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & end if end do end if - end subroutine diag_atm_wiso + end subroutine diag_atm_wiso_recv + + subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & + afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( FB_fldchk(FB, trim(fldname), rc=rc)) then + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data, dim=2) + budget(nf_16O,c_atm_send,ip) = budget(nf_16O,c_atm_send,ip) - areas(n)*afrac(n)*data(1,n) + budget(nf_16O,c_lnd_asend,ip) = budget(nf_16O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(1,n) + budget(nf_16O,c_ocn_asend,ip) = budget(nf_16O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(1,n) + if (lats(n) > 0.0_r8) then + budget(nf_16O,c_inh_asend,ip) = budget(nf_16O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(1,n) + else + budget(nf_16O,c_ish_asend,ip) = budget(nf_16O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(1,n) + end if + + budget(nf_18O,c_atm_send,ip) = budget(nf_18O,c_atm_send,ip) - areas(n)*afrac(n)*data(2,n) + budget(nf_18O,c_lnd_asend,ip) = budget(nf_18O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(2,n) + budget(nf_18O,c_ocn_asend,ip) = budget(nf_18O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(2,n) + if (lats(n) > 0.0_r8) then + budget(nf_18O,c_inh_asend,ip) = budget(nf_18O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(2,n) + else + budget(nf_18O,c_ish_asend,ip) = budget(nf_18O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(2,n) + end if + + budget(nf_HDO,c_atm_send,ip) = budget(nf_HDO,c_atm_send,ip) - areas(n)*afrac(n)*data(3,n) + budget(nf_HDO,c_lnd_asend,ip) = budget(nf_HDO,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(3,n) + budget(nf_HDO,c_ocn_asend,ip) = budget(nf_HDO,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(3,n) + if (lats(n) > 0.0_r8) then + budget(nf_HDO,c_inh_asend,ip) = budget(nf_HDO,c_inh_asend,ip) + areas(n)*ifrac(n)*data(3,n) + else + budget(nf_HDO,c_ish_asend,ip) = budget(nf_HDO,c_ish_asend,ip) + areas(n)*ifrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_atm_wiso_send end subroutine med_phases_diag_atm !=============================================================================== - subroutine med_phases_diag_lnd( gcomp, rc) - ! ------------------------------------------------------------------ + ! ------------------------------------------------------------------ ! Compute global lnd input/output flux diagnostics ! ------------------------------------------------------------------ @@ -806,9 +929,11 @@ subroutine med_phases_diag_lnd( gcomp, rc) real(r8), pointer :: lfrac(:) => null() integer :: n,ip, ic real(r8), pointer :: areas(:) => null() + type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_lnd) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS nullify(is_local%wrap) @@ -816,7 +941,9 @@ subroutine med_phases_diag_lnd( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get fractions on lnd mesh - call FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrac', lfrac, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=lfrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return areas => is_local%wrap%mesh_info(complnd)%areas @@ -887,10 +1014,10 @@ subroutine med_phases_diag_lnd( gcomp, rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - !----------- - contains - !----------- + call t_stopf('MED:'//subname) + + contains subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB @@ -904,12 +1031,15 @@ subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr1=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data) @@ -937,12 +1067,15 @@ subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr2=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data, dim=2) @@ -962,7 +1095,6 @@ end subroutine diag_lnd_wiso end subroutine med_phases_diag_lnd !=============================================================================== - subroutine med_phases_diag_rof( gcomp, rc) ! ------------------------------------------------------------------ @@ -982,6 +1114,7 @@ subroutine med_phases_diag_rof( gcomp, rc) character(*), parameter :: subName = '(med_phases_diag_rof) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS nullify(is_local%wrap) @@ -1031,10 +1164,10 @@ subroutine med_phases_diag_rof( gcomp, rc) f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, budget_local, rc=rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice - !----------- - contains - !----------- + call t_stopf('MED:'//subname) + + contains subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB @@ -1048,12 +1181,15 @@ subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr1=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data) @@ -1081,12 +1217,15 @@ subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr2=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data, dim=2) @@ -1106,7 +1245,6 @@ end subroutine diag_rof_wiso end subroutine med_phases_diag_rof !=============================================================================== - subroutine med_phases_diag_glc( gcomp, rc) ! ------------------------------------------------------------------ @@ -1126,6 +1264,7 @@ subroutine med_phases_diag_glc( gcomp, rc) character(*), parameter :: subName = '(med_phases_diag_glc) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS nullify(is_local%wrap) @@ -1147,10 +1286,9 @@ subroutine med_phases_diag_glc( gcomp, rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice - !----------- - contains - !----------- + call t_stopf('MED:'//subname) + contains subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB @@ -1163,11 +1301,14 @@ subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr1=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data) @@ -1183,7 +1324,6 @@ end subroutine diag_glc end subroutine med_phases_diag_glc !=============================================================================== - subroutine med_phases_diag_ocn( gcomp, rc) ! ------------------------------------------------------------------ @@ -1205,18 +1345,24 @@ subroutine med_phases_diag_ocn( gcomp, rc) real(r8), pointer :: sfrac(:) => null() ! sum of ifrac and ofrac real(r8), pointer :: areas(:) => null() real(r8), pointer :: data(:) => null() + type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ocn) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac', fldptr1=ifrac, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), 'ifrac', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=ifrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac', fldptr1=ofrac, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), 'ofrac', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=ofrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(sfrac(size(ofrac))) sfrac(:) = ifrac(:) + ofrac(:) @@ -1234,7 +1380,9 @@ subroutine med_phases_diag_ocn( gcomp, rc) end do if ( FB_fldchk(is_local%wrap%FBImp(compocn,compocn), 'Fioo_q', rc=rc)) then - call FB_getFldPtr(is_local%wrap%FBImp(compocn,compocn), 'Fioo_q', fldptr1=data, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'Fioo_q', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(ifrac) wgt_o = areas(n) * ofrac(n) @@ -1272,7 +1420,8 @@ subroutine med_phases_diag_ocn( gcomp, rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_bergw', f_watr_melt , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_melth', f_heat_melt , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_bergh', f_heat_melt , ic, areas, sfrac, budget_local, rc=rc) - call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_salt' , f_watr_salt , ic, areas, sfrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Fioi_salt' , f_watr_salt , ic, areas, sfrac, budget_local, & + scale=SFLXtoWFLX, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_swnet', f_heat_swnet , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_lwdn' , f_heat_lwdn , ic, areas, sfrac, budget_local, rc=rc) call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_rain' , f_watr_rain , ic, areas, sfrac, budget_local, rc=rc) @@ -1293,11 +1442,12 @@ subroutine med_phases_diag_ocn( gcomp, rc) budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice - !----------- + + call t_stopf('MED:'//subname) + contains - !----------- - subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, rc) + subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -1306,18 +1456,26 @@ subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, rc) real(r8) , intent(in) :: areas(:) real(r8) , intent(in) :: frac(:) real(r8) , intent(inout) :: budget(:,:,:) + real(r8), optional , intent(in) :: scale integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr1=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data) - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n) + if (present(scale)) then + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n)*scale + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n) + end if end do end if end subroutine diag_ocn @@ -1337,12 +1495,14 @@ subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, b ! local variables integer :: n, ip + type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS - if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr2=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data, dim=2) @@ -1356,7 +1516,6 @@ end subroutine diag_ocn_wiso end subroutine med_phases_diag_ocn !=============================================================================== - subroutine med_phases_diag_ice_ice2med( gcomp, rc) ! ------------------------------------------------------------------ @@ -1376,18 +1535,24 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) real(r8), pointer :: ifrac(:) => null() real(r8), pointer :: areas(:) => null() real(r8), pointer :: lats(:) => null() + type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_ice2med) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', fldptr1=ifrac, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compice), 'ifrac', field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ofrac', fldptr1=ofrac, rc=rc) + call ESMF_FieldGet(lfield, farrayptr=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compice), 'ofrac', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=ofrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return areas => is_local%wrap%mesh_info(compice)%areas @@ -1404,34 +1569,35 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) budget_local(f_area ,ic,ip) = budget_local(f_area ,ic,ip) + areas(n)*ifrac(n) end do - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Fioi_melth', f_heat_melt, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_melth', f_heat_melt, & areas, lats, ifrac, budget_local, minus=.true., rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Fioi_meltw', f_watr_melt, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_meltw', f_watr_melt, & areas, lats, ifrac, budget_local, minus=.true., rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Fioi_salt', f_watr_salt, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_salt', f_watr_salt, & areas, lats, ifrac, budget_local, minus=.true., scale=SFLXtoWFLX, rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', f_heat_swnet, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', f_heat_swnet, & areas, lats, ifrac, budget_local, minus=.true., rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', f_heat_swnet, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', f_heat_swnet, & areas, lats, ifrac, budget_local, rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', f_heat_lwup, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', f_heat_lwup, & areas, lats, ifrac, budget_local, rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Faii_lat', f_heat_latvap, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_lat', f_heat_latvap, & areas, lats, ifrac, budget_local, rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Faii_sen', f_heat_sen, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_sen', f_heat_sen, & areas, lats, ifrac, budget_local, rc=rc) - call diag_ice(is_local%wrap%FBImp(compice,compice), 'Faii_evap', f_watr_evap, & + call diag_ice_recv(is_local%wrap%FBImp(compice,compice), 'Faii_evap', f_watr_evap, & areas, lats, ifrac, budget_local, rc=rc) - call diag_ice_wiso(is_local%wrap%FBImp(compice,compice), 'Fioi_meltw_wiso', & + call diag_ice_recv_wiso(is_local%wrap%FBImp(compice,compice), 'Fioi_meltw_wiso', & f_watr_melt_16O, f_watr_melt_18O, f_watr_melt_HDO, areas, lats, ifrac, budget_local, rc=rc) - call diag_ice_wiso(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', & + call diag_ice_recv_wiso(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', & f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, areas, lats, ifrac, budget_local, rc=rc) - !----------- + + call t_stopf('MED:'//subname) + contains - !----------- - subroutine diag_ice(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, rc) + subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -1445,11 +1611,14 @@ subroutine diag_ice(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, r integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_Field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr1=data , rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1,size(data) @@ -1473,9 +1642,9 @@ subroutine diag_ice(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, r end if end do end if - end subroutine diag_ice + end subroutine diag_ice_recv - subroutine diag_ice_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) + subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -1488,15 +1657,17 @@ subroutine diag_ice_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac real(r8) , intent(inout) :: budget(:,:,:) logical, optional , intent(in) :: minus integer , intent(out) :: rc - ! local variables integer :: n, ip + type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr2=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data, dim=2) @@ -1516,13 +1687,11 @@ subroutine diag_ice_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac end if end do end if - end subroutine diag_ice_wiso - + end subroutine diag_ice_recv_wiso end subroutine med_phases_diag_ice_ice2med !=============================================================================== - subroutine med_phases_diag_ice_med2ice( gcomp, rc) ! ------------------------------------------------------------------ @@ -1544,18 +1713,24 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) real(r8), pointer :: data(:) => null() real(r8), pointer :: areas(:) => null() real(r8), pointer :: lats(:) => null() + type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_med2ice) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) rc = ESMF_SUCCESS nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', fldptr1=ifrac, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ofrac', fldptr1=ofrac, rc=rc) + call ESMF_FieldGet(lfield, farrayptr=ofrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return areas => is_local%wrap%mesh_info(compice)%areas @@ -1572,18 +1747,15 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) budget_local(f_area ,ic,ip) = budget_local(f_area ,ic,ip) + areas(n)*ifrac(n) end do - call diag_ice(is_local%wrap%FBExp(compice), 'Faxa_lwdn', f_heat_lwdn, areas, lats, ifrac, budget_local, rc=rc) - call diag_ice(is_local%wrap%FBExp(compice), 'Faxa_rain', f_watr_rain, areas, lats, ifrac, budget_local, rc=rc) - call diag_ice(is_local%wrap%FBExp(compice), 'Faxa_snow', f_watr_snow, areas, lats, ifrac, budget_local, rc=rc) - call diag_ice(is_local%wrap%FBExp(compice), 'Fixx_rofi', f_watr_ioff, areas, lats, ifrac, budget_local, rc=rc) - - call diag_ice_wiso(is_local%wrap%FBExp(compice), 'Faxa_rain_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, ifrac, budget_local, rc=rc) - call diag_ice_wiso(is_local%wrap%FBExp(compice), 'Faxa_snow_wiso', & - f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, areas, lats, ifrac, budget_local, rc=rc) + call diag_ice_send(is_local%wrap%FBExp(compice), 'Faxa_lwdn', f_heat_lwdn, areas, lats, ifrac, budget_local, rc=rc) + call diag_ice_send(is_local%wrap%FBExp(compice), 'Faxa_rain', f_watr_rain, areas, lats, ifrac, budget_local, rc=rc) + call diag_ice_send(is_local%wrap%FBExp(compice), 'Faxa_snow', f_watr_snow, areas, lats, ifrac, budget_local, rc=rc) + call diag_ice_send(is_local%wrap%FBExp(compice), 'Fixx_rofi', f_watr_ioff, areas, lats, ifrac, budget_local, rc=rc) if ( FB_fldchk(is_local%wrap%FBExp(compice), 'Fioo_q', rc=rc)) then - call FB_getFldPtr(is_local%wrap%FBExp(compice), 'Fioo_q', fldptr1=data, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compice), 'Fioo_q', field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(data) wgt_o = areas(n) * ofrac(n) @@ -1607,11 +1779,16 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX - !----------- + call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_rain_wiso', & + f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, ifrac, budget_local, rc=rc) + call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_snow_wiso', & + f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, areas, lats, ifrac, budget_local, rc=rc) + + call t_stopf('MED:'//subname) + contains - !----------- - subroutine diag_ice(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, rc) + subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -1620,42 +1797,31 @@ subroutine diag_ice(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, r real(r8) , intent(in) :: lats(:) real(r8) , intent(in) :: ifrac(:) real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - real(r8), optional , intent(in) :: scale integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_Field) :: lfield real(r8), pointer :: data(:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS + ip = period_inst if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr1=data , rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst do n = 1,size(data) if (lats(n) > 0.0_r8) then - ic = c_inh_recv + ic = c_inh_send else - ic = c_ish_recv + ic = c_ish_send endif - if (present(minus)) then - if (present(scale)) then - budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n)*scale - else - budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n) - end if - else - if (present(scale)) then - budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n)*scale - else - budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n) - end if - end if + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*ifrac(n)*data(n) end do end if - end subroutine diag_ice + end subroutine diag_ice_send - subroutine diag_ice_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) + subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -1666,42 +1832,36 @@ subroutine diag_ice_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac real(r8) , intent(in) :: lats(:) real(r8) , intent(in) :: ifrac(:) real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus integer , intent(out) :: rc ! local variables integer :: n, ip + type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) => null() ! ------------------------------------------------------------------ rc = ESMF_SUCCESS - if ( FB_fldchk(FB, trim(fldname), rc=rc)) then - call FB_GetFldPtr(FB, trim(fldname), fldptr2=data, rc=rc) + call ESMF_FieldBundleGet(FB, trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayptr=data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ip = period_inst do n = 1, size(data, dim=2) if (lats(n) > 0.0_r8) then - ic = c_inh_recv + ic = c_inh_send else - ic = c_ish_recv + ic = c_ish_send endif - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*ifrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end if + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) end do end if - end subroutine diag_ice_wiso + end subroutine diag_ice_send_wiso end subroutine med_phases_diag_ice_med2ice !=============================================================================== - subroutine med_phases_diag_print(gcomp, rc) ! ------------------------------------------------------------------ @@ -1756,10 +1916,12 @@ subroutine med_phases_diag_print(gcomp, rc) write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr) endif #endif - if(firstcall) then + + if (firstcall) then firstcall = .false. return endif + sumdone = .false. do ip = 1,size(budget_diags%periods) @@ -1838,6 +2000,7 @@ subroutine med_phases_diag_print(gcomp, rc) deallocate(datagpr) endif ! output_level > 0 and mastertask end if ! if mastertask + !------------------------------------------------------------------------------- ! Zero budget data !------------------------------------------------------------------------------- @@ -1848,7 +2011,6 @@ subroutine med_phases_diag_print(gcomp, rc) end subroutine med_phases_diag_print !=============================================================================== - subroutine med_diag_print_atm(data, ip, cdate, curr_tod) ! --------------------------------------------------------- @@ -1997,7 +2159,6 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) end subroutine med_diag_print_atm !=============================================================================== - subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) ! --------------------------------------------------------- @@ -2160,7 +2321,6 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) end subroutine med_diag_print_lnd_ice_ocn !=============================================================================== - subroutine med_diag_print_summary(data, ip, cdate, curr_tod) ! --------------------------------------------------------- @@ -2198,6 +2358,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) character(*), parameter:: subName = '(med_diag_print_summary) ' ! ------------------------------------------------------------------ + call t_startf('MED:'//subname) ! write out areas write(logunit,*) ' ' @@ -2352,10 +2513,10 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) end do end if + call t_stopf('MED:'//subname) end subroutine med_diag_print_summary !=============================================================================== - subroutine add_to_budget_diag(entries, index, name) ! input/output variablesn diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 85e9a720d..69e1947f4 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -246,9 +246,6 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if mapname = trim(mapnames(mapindex)) - if (mastertask) then - write(6,*)'DEBUG: mapindex, mapname= ',mapindex,trim(mapname) - end if if (trim(coupling_mode) == 'cesm') then dstMaskValue = ispval_mask diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index d8290aa37..63cdf85f7 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -5,6 +5,7 @@ module med_phases_prep_lnd_mod !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : operator(/=) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet @@ -57,6 +58,8 @@ module med_phases_prep_lnd_mod ! the number of elevation classes (excluding bare land) = ungriddedCount - 1 integer :: ungriddedCount ! this equals the number of elevation classes + 1 (for bare land) + logical :: cism_evolve = .false. + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -76,6 +79,8 @@ subroutine med_phases_prep_lnd(gcomp, rc) integer :: n1,ncnt real(r8) :: nextsw_cday logical :: first_call = .true. + logical :: isPresent + character(CL) :: cvalue character(len=*), parameter :: subname='(med_phases_prep_lnd)' !--------------------------------------- @@ -91,6 +96,20 @@ subroutine med_phases_prep_lnd(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! determine if coupling to CISM is 2-way + if (first_call) then + call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read (cvalue,*) cism_evolve + if (mastertask) then + write(logunit,'(a,l7)') trim(subname)//' cism_evolve = ',cism_evolve + end if + end if + end if + ! Count the number of fields outside of scalar data, if zero, then return ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the ! fieldCount is 0 and not 1 here @@ -104,8 +123,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! map to create FBimp(:,complnd) !--------------------------------------- + call t_startf('MED:'//trim(subname)//' map') do n1 = 1,ncomps - if (is_local%wrap%med_coupling_active(n1,complnd)) then + ! Skip glc here and handle it below + if (is_local%wrap%med_coupling_active(n1,complnd) .and. n1 /= compglc) then call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(n1,n1), & FBDst=is_local%wrap%FBImp(n1,complnd), & @@ -116,6 +137,44 @@ subroutine med_phases_prep_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do + call t_stopf('MED:'//trim(subname)//' map') + + ! The following is only done if glc->lnd coupling is active + if (is_local%wrap%comp_present(compglc) .and. (is_local%wrap%med_coupling_active(compglc,complnd))) then + call t_startf('MED:'//trim(subname)//' glc2lnd init') + if (first_call) then + call map_glc2lnd_init(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//trim(subname)//' glc2lnd init') + + ! The will following will map and merge Sg_frac and Sg_topo (and in the future Flgg_hflx) + if (cism_evolve) then + call t_startf('MED:'//trim(subname)//' glc2lnd ') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compglc,compglc), & + FBDst=is_local%wrap%FBImp(compglc,complnd), & + FBFracSrc=is_local%wrap%FBFrac(compglc), & + field_normOne=is_local%wrap%field_normOne(compglc,complnd,:), & + packed_data=is_local%wrap%packed_data(compglc,complnd,:), & + routehandles=is_local%wrap%RH(compglc,complnd,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call map_glc2lnd(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' glc2lnd') + else if (first_call) then + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compglc,compglc), & + FBDst=is_local%wrap%FBImp(compglc,complnd), & + FBFracSrc=is_local%wrap%FBFrac(compglc), & + field_normOne=is_local%wrap%field_normOne(compglc,complnd,:), & + packed_data=is_local%wrap%packed_data(compglc,complnd,:), & + routehandles=is_local%wrap%RH(compglc,complnd,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call map_glc2lnd(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if !--------------------------------------- ! auto merges to create FBExp(complnd) @@ -123,6 +182,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! The following will merge all fields in fldsSrc ! (for glc these are Sg_icemask and Sg_icemask_coupled_fluxes) + call t_startf('MED:'//trim(subname)//' merge') call med_merge_auto(complnd, & is_local%wrap%med_coupling_active(:,complnd), & is_local%wrap%FBExp(complnd), & @@ -130,21 +190,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) is_local%wrap%FBImp(:,complnd), & fldListTo(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------- - ! custom calculations - !--------------------------------------- - - ! The following is only done if glc->lnd coupling is active - if (is_local%wrap%comp_present(compglc) .and. (is_local%wrap%med_coupling_active(compglc,complnd))) then - if (first_call) then - call map_glc2lnd_init(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! The will following will map and merge Sg_frac and Sg_topo (and in the future Flgg_hflx) - call map_glc2lnd(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call t_stopf('MED:'//trim(subname)//' merge') !--------------------------------------- ! update scalar data @@ -152,6 +198,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) call ESMF_StateGet(is_local%wrap%NStateImp(compatm), trim(is_local%wrap%flds_scalar_name), itemType, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (itemType /= ESMF_STATEITEM_NOTFOUND) then + call t_startf('MED:'//trim(subname)//' nextsw_cday') ! send nextsw_cday to land - first obtain it from atm import call State_GetScalar(& scalar_value=nextsw_cday, & @@ -167,6 +214,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' nextsw_cday') end if ! diagnose @@ -177,6 +225,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) end if end if + ! Reset first call logical first_call = .false. if (dbug_flag > 5) then