diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index c275c0eb..84eb6f7e 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -12,6 +12,9 @@ module med_phases_post_atm_mod character(*), parameter :: u_FILE_u = & __FILE__ + character(len=9), parameter :: fields_to_spread_runoff(1) = & + ['Faoa_rofi'] + !----------------------------------------------------------------------------- contains @@ -35,6 +38,7 @@ subroutine med_phases_post_atm(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav, coupling_mode use perf_mod , only : t_startf, t_stopf + use med_phases_post_rof_mod, only: med_phases_post_rof_spread_rofi_field_bundle ! input/output variables type(ESMF_GridComp) :: gcomp @@ -125,6 +129,16 @@ subroutine med_phases_post_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (trim(coupling_mode) == 'access-esm') then + ! in access-esm, runoff comes from the atmosphere component, so spreading of iceberg melt here + call med_phases_post_rof_spread_rofi_field_bundle( & + gcomp, fields_to_spread_runoff, & + is_local%wrap%FBImp(compatm,compatm), & + is_local%wrap%FBImp(compatm,compocn), & + compatm, compocn, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 7eff535d..b55ccab8 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -32,7 +32,7 @@ module med_phases_post_rof_mod implicit none private - public :: med_phases_post_rof_init + public :: med_phases_post_rof_init, med_phases_post_rof_spread_rofi_field_bundle public :: med_phases_post_rof private :: med_phases_post_rof_create_rof_field_bundle private :: med_phases_post_rof_remove_negative_runoff @@ -49,7 +49,6 @@ module med_phases_post_rof_mod logical :: remove_negative_runoff_lnd logical :: remove_negative_runoff_glc logical :: spread_rofi_nh, spread_rofi_sh - character(len=CL) :: rof2ocn_ice_spread character(len=9), parameter :: fields_to_remove_negative_runoff_lnd(2) = & ['Forr_rofl', & @@ -107,21 +106,9 @@ subroutine med_phases_post_rof_init(gcomp, rc) remove_negative_runoff_glc = .false. end if - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_spread', value=rof2ocn_ice_spread, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - spread_rofi_nh = .true. - spread_rofi_sh = .true. - else - spread_rofi_nh = .false. - spread_rofi_sh = .false. - end if - if (maintask) then write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_lnd = ', remove_negative_runoff_lnd write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_glc = ', remove_negative_runoff_glc - write(logunit,'(a,l7)') trim(subname)//' spread_rofi = ', spread_rofi_nh - if (spread_rofi_nh) write(logunit,'(a)') trim(subname)//' rof2ocn_ice_spread = '//trim(rof2ocn_ice_spread) end if @@ -144,7 +131,6 @@ subroutine med_phases_post_rof(gcomp, rc) real(r8), pointer :: data_copy(:) integer :: n logical :: exists - logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -155,13 +141,6 @@ subroutine med_phases_post_rof(gcomp, rc) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) end if - ! unclear why this can't be in med_phases_post_rof_init, possibly pio not initialised - if ((spread_rofi_nh .or. spread_rofi_sh) .and. first_time) then - call med_phases_post_rof_init_rof_spread_rofi(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_time=.false. - endif - nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -195,23 +174,6 @@ subroutine med_phases_post_rof(gcomp, rc) end do end if - if (spread_rofi_nh .or. spread_rofi_sh) then - do n = 1, size(fields_to_spread_runoff) - call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_spread_runoff(n)), isPresent=exists, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) then - call shr_log_error(string=trim(subname)//" Error checking field: "//trim(fields_to_spread_runoff(n)), line=__LINE__,file=u_FILE_u, rc=rc) - return - end if - if (exists) then - call med_phases_post_rof_spread_rofi(gcomp, fields_to_spread_runoff(n), rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_log_error(string=trim(subname)//" Runoff field to spread: "//trim(fields_to_spread_runoff(n))//" does not exist", line=__LINE__,file=u_FILE_u, rc=rc) - return - end if - end do - end if - ! map rof to lnd if (is_local%wrap%med_coupling_active(comprof,complnd)) then call t_startf('MED:'//trim(subname)//' map_rof2lnd') @@ -252,6 +214,12 @@ subroutine med_phases_post_rof(gcomp, rc) call t_stopf('MED:'//trim(subname)//' map_rof2ice') end if + call med_phases_post_rof_spread_rofi_field_bundle( & + gcomp, fields_to_spread_runoff, & + is_local%wrap%FBImp(comprof,comprof), & + is_local%wrap%FBImp(comprof,compocn), & + comprof, compocn, rc) + ! Write rof inst, avg or aux if requested in mediator attributes call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -459,13 +427,16 @@ subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) end subroutine med_phases_post_rof_remove_negative_runoff - subroutine med_phases_post_rof_init_rof_spread_rofi(gcomp, rc) + subroutine med_phases_post_rof_init_rof_spread_rofi(gcomp, fields_to_spread_runoff, rofi_spread, dst_comp, rc) !--------------------------------------------------------------- use med_io_mod , only : med_io_read use shr_reprosum_mod , only : shr_reprosum_calc ! input/output variables type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: fields_to_spread_runoff(:) + character(len=CL) :: rofi_spread + integer, intent(in) :: dst_comp ! the component mesh the field is being spread on integer, intent(out) :: rc @@ -483,8 +454,6 @@ subroutine med_phases_post_rof_init_rof_spread_rofi(gcomp, rc) character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_init_rof_spread_rofi)' !--------------------------------------- - ! to do - make component configurable (could be comprof or compatm) - rc = ESMF_SUCCESS call t_startf('MED:'//subname) @@ -508,7 +477,7 @@ subroutine med_phases_post_rof_init_rof_spread_rofi(gcomp, rc) ! Create module fields on rof mesh ! ------------------------------- - call fldbun_getmesh(is_local%wrap%FBImp(comprof,comprof), mesh_l, rc) + call fldbun_getmesh(is_local%wrap%FBImp(dst_comp,dst_comp), mesh_l, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return FBrof_pattern = ESMF_FieldBundleCreate(name='FBrof_pattern', rc=rc) @@ -530,11 +499,11 @@ subroutine med_phases_post_rof_init_rof_spread_rofi(gcomp, rc) if (dbug_flag > dbug_threshold) then call ESMF_LogWrite(trim(subname)//": trying to read rof2ocn_spread from file", ESMF_LOGMSG_INFO) endif - call med_io_read(rof2ocn_ice_spread, vm, FBrof_pattern, pre='pattern', ungridded_nc=.true., rc=rc) + call med_io_read(rofi_spread, vm, FBrof_pattern, pre='pattern', ungridded_nc=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - areas => is_local%wrap%mesh_info(comprof)%areas - lats => is_local%wrap%mesh_info(comprof)%lats + areas => is_local%wrap%mesh_info(dst_comp)%areas + lats => is_local%wrap%mesh_info(dst_comp)%lats allocate(rof2ocn_a_weight(size(areas),2)) @@ -607,7 +576,10 @@ subroutine med_phases_post_rof_init_rof_spread_rofi(gcomp, rc) end subroutine med_phases_post_rof_init_rof_spread_rofi - subroutine med_phases_post_rof_spread_rofi(gcomp, field_name, rc) + subroutine med_phases_post_rof_spread_rofi(& + gcomp, field_name, & + field_bundle_src, field_bundle_dst, src_comp, dst_comp, rc& + ) !--------------------------------------------------------------- ! For one runoff field, spread runoff according to the pattern prescribed in spread_rofi_weights. use shr_reprosum_mod , only : shr_reprosum_calc @@ -615,6 +587,10 @@ subroutine med_phases_post_rof_spread_rofi(gcomp, field_name, rc) ! input/output variables type(ESMF_GridComp) :: gcomp character(len=*), intent(in) :: field_name ! name of runoff flux field to process + type(ESMF_FieldBundle) :: field_bundle_src + type(ESMF_FieldBundle) :: field_bundle_dst + integer, intent(in) :: src_comp ! the component mesh the field being spread is from + integer, intent(in) :: dst_comp ! the component mesh the field is being spread on integer, intent(out) :: rc ! local variables @@ -622,10 +598,11 @@ subroutine med_phases_post_rof_spread_rofi(gcomp, field_name, rc) type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime - real(r8), pointer :: runoff_flux(:) ! temporary 1d pointer + real(r8), pointer :: runoff_flux_src(:) ! temporary 1d pointer + real(r8), pointer :: runoff_flux_dst(:) ! temporary 1d pointer real(r8), pointer :: rof2ocn_spread(:,:) real(r8), allocatable:: rof2ocn_a_weight(:,:) - real(r8), pointer :: areas(:), lats(:) + real(r8), pointer :: src_areas(:), dst_areas(:), src_lats(:), dst_lats(:) real(r8) :: global_sum(2) !Antarctic,Greenland (frozen) runoff integer :: n, mm, comm @@ -652,26 +629,32 @@ subroutine med_phases_post_rof_spread_rofi(gcomp, field_name, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - areas => is_local%wrap%mesh_info(comprof)%areas - lats => is_local%wrap%mesh_info(comprof)%lats + src_areas => is_local%wrap%mesh_info(src_comp)%areas + src_lats => is_local%wrap%mesh_info(src_comp)%lats - call fldbun_getdata1d(FBrof_r, trim(field_name), runoff_flux, rc=rc) + dst_areas => is_local%wrap%mesh_info(dst_comp)%areas + dst_lats => is_local%wrap%mesh_info(dst_comp)%lats + + call fldbun_getdata1d(field_bundle_src, trim(field_name), runoff_flux_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getdata1d(field_bundle_dst, trim(field_name), runoff_flux_dst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(rof2ocn_a_weight(size(runoff_flux),2)) + allocate(rof2ocn_a_weight(size(runoff_flux_src),2)) rof2ocn_a_weight = 0.0_r8 if (spread_rofi_sh) then - do n = 1, size(runoff_flux) - if (lats(n) < 0.0_r8) then - rof2ocn_a_weight(n,1) = areas(n) * runoff_flux(n) + do n = 1, size(runoff_flux_src) + if (src_lats(n) < 0.0_r8) then + rof2ocn_a_weight(n,1) = src_areas(n) * runoff_flux_src(n) end if end do end if if (spread_rofi_nh) then - do n = 1, size(runoff_flux) - if (lats(n) >= 0.0_r8) then - rof2ocn_a_weight(n,2) = areas(n) * runoff_flux(n) + do n = 1, size(runoff_flux_src) + if (src_lats(n) >= 0.0_r8) then + rof2ocn_a_weight(n,2) = src_areas(n) * runoff_flux_src(n) end if end do end if @@ -683,7 +666,7 @@ subroutine med_phases_post_rof_spread_rofi(gcomp, field_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! do the global sum (in each hemisphere) of this field - call shr_reprosum_calc(rof2ocn_a_weight, global_sum, size(runoff_flux), size(runoff_flux), 2, & + call shr_reprosum_calc(rof2ocn_a_weight, global_sum, size(runoff_flux_src), size(runoff_flux_src), 2, & commid=comm) if (maintask .and. dbug_flag > dbug_threshold) then @@ -698,42 +681,44 @@ subroutine med_phases_post_rof_spread_rofi(gcomp, field_name, rc) ! spread runoff by the saved pattern for the model month if (spread_rofi_sh) then - do n = 1, size(runoff_flux) - if (lats(n) < 0.0_r8) then - runoff_flux(n) = rof2ocn_spread(n,mm) * global_sum(1) + do n = 1, size(runoff_flux_dst) + if (dst_lats(n) < 0.0_r8) then + runoff_flux_dst(n) = rof2ocn_spread(n,mm) * global_sum(1) end if end do end if if (spread_rofi_nh) then - do n = 1, size(runoff_flux) - if (lats(n) >= 0.0_r8) then - runoff_flux(n) = rof2ocn_spread(n,mm) * global_sum(2) + do n = 1, size(runoff_flux_dst) + if (dst_lats(n) >= 0.0_r8) then + runoff_flux_dst(n) = rof2ocn_spread(n,mm) * global_sum(2) end if end do end if - if (dbug_flag > dbug_threshold) then + deallocate(rof2ocn_a_weight) + if (dbug_flag > dbug_threshold) then ! calculate the new global sum (after correction), difference should be equal to 0 + allocate(rof2ocn_a_weight(size(runoff_flux_dst),2)) rof2ocn_a_weight = 0.0_r8 if (spread_rofi_sh) then - do n = 1, size(runoff_flux) - if (lats(n) < 0.0_r8) then - rof2ocn_a_weight(n,1) = areas(n) * runoff_flux(n) + do n = 1, size(runoff_flux_dst) + if (dst_lats(n) < 0.0_r8) then + rof2ocn_a_weight(n,1) = dst_areas(n) * runoff_flux_dst(n) end if end do end if if (spread_rofi_nh) then - do n = 1, size(runoff_flux) - if (lats(n) >= 0.0_r8) then - rof2ocn_a_weight(n,2) = areas(n) * runoff_flux(n) + do n = 1, size(runoff_flux_dst) + if (dst_lats(n) >= 0.0_r8) then + rof2ocn_a_weight(n,2) = dst_areas(n) * runoff_flux_dst(n) end if end do end if - call shr_reprosum_calc(rof2ocn_a_weight, global_sum, size(runoff_flux), size(runoff_flux), 2, & + call shr_reprosum_calc(rof2ocn_a_weight, global_sum, size(runoff_flux_dst), size(runoff_flux_dst), 2, & commid=comm) if (maintask) then write(logunit,'(a)') subname//' After correction: '//trim(field_name) @@ -749,4 +734,74 @@ subroutine med_phases_post_rof_spread_rofi(gcomp, field_name, rc) end subroutine med_phases_post_rof_spread_rofi + subroutine med_phases_post_rof_spread_rofi_field_bundle(& + gcomp, fields_to_spread_runoff,& + field_bundle_src, field_bundle_dst, src_comp, dst_comp, rc& + ) + + !--------------------------------------------------------------- + ! For a list of runoff fields, spread runoff according to the patterns prescribed in spread_rofi_weights. + use shr_reprosum_mod , only : shr_reprosum_calc + + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: fields_to_spread_runoff(:) + type(ESMF_FieldBundle) :: field_bundle_src, field_bundle_dst + integer, intent(in) :: src_comp ! the component mesh the field being spread is from + integer, intent(in) :: dst_comp ! the component mesh the field is being spread on + integer, intent(out) :: rc + + ! local variables + character(len=CL) :: rofi_spread + integer :: n + logical :: isPresent, isSet + logical :: spreading_initialized = .false. + + character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_spread_rofi_field_bundle)' + !--------------------------------------- + + ! unclear why this can't be in med_phases_post_rof_init, possibly pio not initialised + if (.not. spreading_initialized) then + call NUOPC_CompAttributeGet(gcomp, name='rofi_spread', value=rofi_spread, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + spread_rofi_nh = .true. + spread_rofi_sh = .true. + call med_phases_post_rof_init_rof_spread_rofi(gcomp, fields_to_spread_runoff, rofi_spread, dst_comp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + spread_rofi_nh = .false. + spread_rofi_sh = .false. + end if + + spreading_initialized = .true. + if (maintask) then + write(logunit,'(a,l7)') trim(subname)//' spread_rofi_Greenland = ', spread_rofi_nh + write(logunit,'(a,l7)') trim(subname)//' spread_rofi_Antarctic = ', spread_rofi_sh + if (spread_rofi_nh .or. spread_rofi_sh) write(logunit,'(a)') trim(subname)//' rofi_spread = '//trim(rofi_spread) + end if + endif + + if (spread_rofi_nh .or. spread_rofi_sh) then + do n = 1, size(fields_to_spread_runoff) + call ESMF_FieldBundleGet(field_bundle_src, fieldName=trim(fields_to_spread_runoff(n)), isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) then + call shr_log_error(string=trim(subname)//" Error getting field: "//trim(fields_to_spread_runoff(n)), line=__LINE__,file=u_FILE_u, rc=rc) + return + end if + if (isPresent) then + call med_phases_post_rof_spread_rofi(& + gcomp, fields_to_spread_runoff(n),& + field_bundle_src, field_bundle_dst, src_comp, dst_comp, rc& + ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_log_error(string=trim(subname)//" Runoff field to spread: "//trim(fields_to_spread_runoff(n))//" does not exist", line=__LINE__,file=u_FILE_u, rc=rc) + return + end if + end do + end if + + end subroutine med_phases_post_rof_spread_rofi_field_bundle + end module med_phases_post_rof_mod