diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 9ed1b78d4..ec245df8a 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -33,7 +33,7 @@ subroutine med_phases_post_atm(gcomp, rc) use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav + use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav, coupling_mode use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -58,6 +58,11 @@ subroutine med_phases_post_atm(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'access') then + call med_phases_post_atm_custom_access(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! map atm to ocn if (is_local%wrap%med_coupling_active(compatm,compocn)) then call t_startf('MED:'//trim(subname)//' map_atm2ocn') @@ -126,4 +131,65 @@ subroutine med_phases_post_atm(gcomp, rc) end subroutine med_phases_post_atm + subroutine med_phases_post_atm_custom_access(gcomp, rc) + 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 : compocn, compatm, compice, coupling_mode + use med_internalstate_mod , only : InternalState, maintask, logunit + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet, ESMF_FieldCreate + use ESMF , only : ESMF_FieldGet, ESMF_Field, ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use med_map_mod , only : med_map_field + use med_internalstate_mod , only : mapconsf + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + real(R8), pointer :: ice_frac_cat_ptr(:, :), ice_flux_cat_ptr(:, :) + type(ESMF_Field) :: ice_frac_cat, ice_flux_cat + integer :: lsize1, lsize2, i, j, n + character(len=*), parameter :: subname='(med_phases_post_atm_custom_access)' + character(len=CS) :: fld_names(4) + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compice, compatm), fieldName='ia_aicen', field=ice_frac_cat, rc=rc) + call ESMF_FieldGet(ice_frac_cat, farrayptr=ice_frac_cat_ptr) + + lsize1 = size(ice_frac_cat_ptr, dim=1) + lsize2 = size(ice_frac_cat_ptr, dim=2) + + fld_names = [character(len=CS) :: & + 'topmelt', & + 'botmelt', & + 'sublim', & + 'pen_rad'] + + do n = 1,size(fld_names) + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm, compatm), fieldName=trim(fld_names(n)), field=ice_flux_cat, rc=rc) + call ESMF_FieldGet(ice_flux_cat, farrayptr=ice_flux_cat_ptr) + + do j = 1,lsize2 + do i = 1,lsize1 + if (ice_frac_cat_ptr(i, j) > 0.0) then + ice_flux_cat_ptr(i, j) = ice_flux_cat_ptr(i, j) / ice_frac_cat_ptr(i, j) + end if + end do + end do + + end do + + end subroutine med_phases_post_atm_custom_access + end module med_phases_post_atm_mod