diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 30066c59e..a11d62b53 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -49,6 +49,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local integer :: n, maptype + logical :: med_aoflux_to_ocn character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname @@ -75,6 +76,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) write(msgString,'(A,i6,A)') trim(subname)//': maptype is ',maptype,', '//mapnames(maptype) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then + med_aoflux_to_ocn = .true. + else + med_aoflux_to_ocn = .false. + end if + !===================================================================== ! scalar information !===================================================================== @@ -83,8 +90,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps - call addfld_to(n, trim(cvalue)) - call addfld_from(n, trim(cvalue)) + call addfld_to(n , trim(cvalue)) + call addfld_from(n , trim(cvalue)) end do end if @@ -98,78 +105,45 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (is_local%wrap%comp_present(compocn)) call addfld_from(compocn, 'So_omask') if (is_local%wrap%comp_present(complnd)) call addfld_from(complnd, 'Sl_lfrin') else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_omask', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_omask', rc=rc)) then call addmap_from(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') end if end if - if ( trim(coupling_mode) == 'nems_orig_data') then - ! atm fields required for atm/ocn flux calculation - allocate(flds(10)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & - 'Sa_shum', 'Sa_u10m', 'Sa_v10m', 'Sa_t2m ', 'Sa_q2m '/) + ! fields required for atm/ocn flux calculation + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then + ! from atm: states for fluxes + allocate(flds(13)) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_pslv', & + 'Sa_shum', 'Sa_ptem', 'Sa_dens', 'Sa_u10m', 'Sa_v10m', 'Sa_t2m ', & + 'Sa_q2m '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) )then - call addfld_from(compatm, trim(fldname)) - end if + call addfld_from(compatm , fldname) else - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') - end if - end if - end do - deallocate(flds) - - ! fields returned by the atm/ocn flux computation which are otherwise unadvertised - allocate(flds(8)) - flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ','So_ssq ', & - 'So_u10 ', 'So_duu10n', 'Faox_lat '/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld_aoflux(trim(fldname)) - end if - end do - deallocate(flds) - end if - - if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - allocate(flds(12)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', & - 'Sa_pslv ', 'Sa_shum ', 'Sa_ptem ', 'Sa_dens ', 'Sa_u10m ', & - 'Sa_v10m ', 'Faxa_lwdn'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) )then - call addfld_from(compatm, trim(fldname)) + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compocn, maptype, 'one', 'unset') end if - else - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') - end if end if end do deallocate(flds) - ! fields returned by the atm/ocn flux computation which are otherwise unadvertised - allocate(flds(13)) - flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & - 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & - 'Faox_evap', 'Faox_taux','Faox_tauy'/) + ! from med: fields returned by the atm/ocn flux computation, otherwise unadvertised + allocate(flds(8)) + flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ','So_ssq ', 'So_u10 ', & + 'So_duu10n', 'Faox_lat '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - call addfld_aoflux(trim(fldname)) + call addfld_aoflux(fldname) end if end do deallocate(flds) end if - ! Advertise the ocean albedos. These are not sent to the ATM in UFS. + ! from med: ocean albedos (not sent to the ATM in UFS). if (phase == 'advertise') then call addfld_ocnalb('So_avsdr') call addfld_ocnalb('So_avsdf') @@ -184,16 +158,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compice, 'Si_ifrac') - call addfld_to(compatm, 'Si_ifrac') + call addfld_from(compice , 'Si_ifrac') + call addfld_to(compatm , 'Si_ifrac') end if ! ofrac used by atm if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compatm, 'Sa_ofrac') + call addfld_from(compatm , 'Sa_ofrac') end if ! lfrac used by atm if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfld_to(compatm, 'Sl_lfrac') + call addfld_to(compatm , 'Sl_lfrac') end if end if @@ -207,39 +181,40 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - mean snow volume per unit area ! - surface temperatures allocate(flds(9)) - flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', 'Faii_sen ', 'Faii_lwup', & - 'Faii_evap', 'Si_vice ', 'Si_vsno ', 'Si_t '/) + flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', 'Faii_sen ', 'Faii_lwup', 'Faii_evap', & + 'Si_vice ', 'Si_vsno ', 'Si_t '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compatm, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compatm , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compatm) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compatm, maptype, 'ifrac', 'unset') + call addmrg_to(compatm, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) + ! to atm: unmerged sea ice albedo, 4 bands allocate(flds(4)) flds = (/'Si_avsdr', 'Si_avsdf', 'Si_anidr', 'Si_anidf'/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compatm, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compatm , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compatm) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compatm, maptype, 'ifrac', 'unset') + call addmrg_to(compatm, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -248,8 +223,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compocn, 'So_t') - call addfld_to(compatm, 'So_t') + call addfld_from(compocn , 'So_t') + call addfld_to(compatm , 'So_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_t', rc=rc) .and. & @@ -262,8 +237,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from lnd if (phase == 'advertise') then if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(complnd, 'Sl_t') - call addfld_to(compatm, 'Sl_t') + call addfld_from(complnd , 'Sl_t') + call addfld_to(compatm , 'Sl_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_t', rc=rc) .and. & @@ -278,35 +253,31 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - surface latent heat flux, ! - surface sensible heat flux ! - surface upward longwave heat flux - ! - evaporation water flux from water, not in the list do we need to send it to atm? - if (trim(coupling_mode) == 'nems_frac_aoflux') then - if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - allocate(flds(5)) - flds = (/ 'lat ', 'sen ', 'lwup', 'taux', 'tauy' /) - if (phase == 'advertise') then - do n = 1,size(flds) - call addfld_aoflux('Faox_'//trim(flds(n))) - call addfld_to(compatm, 'Faox_'//trim(flds(n))) - end do - else - do n = 1,size(flds) - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(flds(n)), rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') - end if - call addmrg_to(compatm, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') - end if - end do + allocate(flds(5)) + flds = (/ 'Faox_lat ', 'Faox_sen ', 'Faox_lwup', 'Faox_taux', 'Faox_tauy' /) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux(fldname) + call addfld_to(compatm , fldname) + end if + else + if (fldchk(is_local%wrap%FBMed_aoflux_o, fldname, rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux(fldname, compatm, maptype, 'ofrac', 'unset') + end if + call addmrg_to(compatm, fldname, mrg_from=compmed, mrg_fld=fldname, mrg_type='copy') end if - deallocate(flds) end if - end if + end do + deallocate(flds) ! to atm: surface roughness length from wav if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compwav, 'Sw_z0') - call addfld_to(compatm, 'Sw_z0') + call addfld_from(compwav , 'Sw_z0') + call addfld_to(compatm , 'Sw_z0') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sw_z0', rc=rc) .and. & @@ -323,8 +294,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sea level pressure from atm if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Sa_pslv') - call addfld_to(compocn, 'Sa_pslv') + call addfld_from(compatm , 'Sa_pslv') + call addfld_to(compocn , 'Sa_pslv') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Sa_pslv', rc=rc) .and. & @@ -337,14 +308,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: swpen thru ice w/o bands if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, 'Fioi_swpen') + call addfld_from(compice , 'Fioi_swpen') end if else if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then call addmap_from(compice, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') end if end if - ! to ocn: from sw from atm and sw net from ice (custom merge in med_phases_prep_ocn) ! - downward direct near-infrared ("n" or "i") incident solar radiation ! - downward diffuse near-infrared ("n" or "i") incident solar radiation @@ -359,8 +329,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, trim(aflds(n))) - call addfld_to(compocn, trim(oflds(n))) + call addfld_from(compatm , trim(aflds(n))) + call addfld_to(compocn , trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & @@ -373,8 +343,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, trim(iflds(n))) - call addfld_to(compocn, trim(oflds(n))) + call addfld_from(compice , trim(iflds(n))) + call addfld_to(compocn , trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & @@ -394,190 +364,153 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compocn, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compocn , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') - call addmrg_to(compocn, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') + if ( fldchk(is_local%wrap%FBexp(compocn) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compocn, maptype, 'one', 'unset') + call addmrg_to(compocn, fldname, & + mrg_from=compatm, mrg_fld=fldname, mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if end do - deallocate(flds) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - ! to ocn: merge surface stress - allocate(oflds(2)) - allocate(aflds(2)) - allocate(iflds(2)) - oflds = (/'Foxx_taux', 'Foxx_tauy'/) - aflds = (/'Faxa_taux', 'Faxa_tauy'/) - iflds = (/'Fioi_taux', 'Fioi_tauy'/) - do n = 1,size(oflds) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm) & - .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, trim(iflds(n))) - call addfld_from(compatm, trim(aflds(n))) - call addfld_to(compocn, trim(oflds(n))) + !to ocn: surface stress from mediator or atm and ice stress via auto merge + flds = (/'taux', 'tauy'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_'//fldname) + call addfld_from(compatm , 'Faxa_'//fldname) + call addfld_from(compice , 'Fioi_'//fldname) + call addfld_to(compocn , 'Foxx_'//fldname) + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//fldname, rc=rc)) then + call addmap_from(compice, 'Fioi_'//fldname, compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compmed, mrg_fld='Faox_'//fldname, mrg_type='merge', mrg_fracname='ofrac') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compice, mrg_fld='Fioi_'//fldname, mrg_type='merge', mrg_fracname='ifrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then - call addmap_from(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmap_from(compatm, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, trim(oflds(n)), & - mrg_from=compice, mrg_fld=trim(iflds(n)), mrg_type='merge', mrg_fracname='ifrac') - call addmrg_to(compocn, trim(oflds(n)), & - mrg_from=compatm, mrg_fld=trim(aflds(n)), mrg_type='merge', mrg_fracname='ofrac') + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_'//fldname, rc=rc)) then + call addmap_from(compice, 'Fioi_'//fldname, compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compatm, 'Faxa_'//fldname, compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compice, mrg_fld='Fioi_'//fldname, mrg_type='merge', mrg_fracname='ifrac') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compatm, mrg_fld='Faxa_'//fldname, mrg_type='merge', mrg_fracname='ofrac') end if end if + end if end do - deallocate(oflds) - deallocate(aflds) - deallocate(iflds) + deallocate(flds) - ! to ocn: net long wave via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Faxa_lwnet') - call addfld_to(compocn, 'Faxa_lwnet') + ! to ocn: net long wave via auto merge + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_lwup') + call addfld_from(compatm , 'Faxa_lwnet') + call addfld_from(compatm , 'Faxa_lwdn') + call addfld_to(compocn , 'Foxx_lwnet') + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc)) then + call addmap_from(compatm, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') + call addmrg_to(compocn, 'Foxx_lwnet', & + mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') + call addmrg_to(compocn, 'Foxx_lwnet', & + mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_lwnet', rc=rc) .and. & + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then call addmap_from(compatm, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, 'Faxa_lwnet', & + call addmrg_to(compocn, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if + end if - ! to ocn: sensible heat flux - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Faxa_sen') - call addfld_to(compocn, 'Faxa_sen') + ! to ocn: sensible heat flux + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_sen') + call addfld_from(compatm , 'Faxa_sen') + call addfld_to(compocn , 'Foxx_sen') + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then + call addmrg_to(compocn, 'Foxx_sen', & + mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_sen', rc=rc) .and. & + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_sen', rc=rc)) then call addmap_from(compatm, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, 'Faxa_sen', & + call addmrg_to(compocn, 'Foxx_sen', & mrg_from=compatm, mrg_fld='Faxa_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if + end if - ! to ocn: evaporation water flux - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Faxa_evap') - call addfld_to(compocn, 'Faxa_evap') + ! to ocn: evaporation water flux + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_evap') + call addfld_from(compatm , 'Faxa_evap') + call addfld_to(compocn , 'Foxx_evap') + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then + call addmrg_to(compocn, 'Foxx_evap', & + mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_evap', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap' , rc=rc)) then call addmap_from(compatm, 'Faxa_evap', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, 'Faxa_evap', & + call addmrg_to(compocn, 'Foxx_evap', & mrg_from=compatm, mrg_fld='Faxa_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if - else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then - ! nems_orig_data - ! to ocn: surface stress from mediator and ice stress via auto merge - allocate(flds(2)) - flds = (/'taux', 'tauy'/) - do n = 1,size(flds) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_'//trim(flds(n))) - call addfld_from(compice , 'Fioi_'//trim(flds(n))) - call addfld_to(compocn , 'Foxx_'//trim(flds(n))) - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(flds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(flds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(flds(n)), rc=rc)) then - call addmap_from(compice, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Foxx_'//trim(flds(n)), & - mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') - call addmrg_to(compocn, 'Foxx_'//trim(flds(n)), & - mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') - end if - end if - end do - deallocate(flds) - - ! to ocn: long wave net via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_lwup') - call addfld_from(compatm, 'Faxa_lwdn') - call addfld_to(compocn, 'Foxx_lwnet') - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmap_from(compatm, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') - call addmrg_to(compocn, 'Foxx_lwnet', & - mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg_to(compocn, 'Foxx_lwnet', & - mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - - ! to ocn: sensible heat flux from mediator via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_sen') - call addfld_to(compocn, 'Faox_sen') - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_sen', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then - call addmrg_to(compocn, 'Faox_sen', & - mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') - end if - end if - - ! to ocn: evaporation water flux from mediator via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_evap') - call addfld_to(compocn, 'Faox_evap') - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_evap', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then - call addmrg_to(compocn, 'Faox_evap', & - mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') - end if - end if end if - ! to ocn: water flux due to melting ice from ice - ! to ocn: heat flux from melting ice from ice - ! to ocn: salt flux from ice + ! to ocn: unmerged fluxes from ice + ! - water flux due to melting ice from ice + ! - heat flux from melting ice from ice + ! - salt flux from ice allocate(flds(3)) flds = (/'Fioi_meltw', 'Fioi_melth', 'Fioi_salt '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compocn, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compocn , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, trim(fldname), & - mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') + if ( fldchk(is_local%wrap%FBexp(compocn) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, fldname, & + mrg_from=compice, mrg_fld=fldname, mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if end do @@ -590,14 +523,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compwav, trim(fldname)) - call addfld_to(compocn, trim(fldname)) + call addfld_from(compwav , fldname) + call addfld_to(compocn , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then - call addmap_from(compwav, trim(fldname), compocn, mapbilnr_nstod, 'one', 'unset') - call addmrg_to(compocn, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compocn) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), fldname, rc=rc)) then + call addmap_from(compwav, fldname, compocn, mapbilnr_nstod, 'one', 'unset') + call addmrg_to(compocn, fldname, mrg_from=compwav, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -607,14 +540,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! FIELDS TO ICE (compice) !===================================================================== - ! to ice - fluxes from atm - ! to ice: downward longwave heat flux from atm - ! to ice: downward direct near-infrared incident solar radiation from atm - ! to ice: downward direct visible incident solar radiation from atm - ! to ice: downward diffuse near-infrared incident solar radiation from atm - ! to ice: downward Diffuse visible incident solar radiation from atm - ! to ice: rain from atm - ! to ice: snow from atm + ! to ice: fluxes from atm + ! - downward longwave heat flux from atm + ! - downward direct near-infrared incident solar radiation from atm + ! - downward direct visible incident solar radiation from atm + ! - downward diffuse near-infrared incident solar radiation from atm + ! - downward Diffuse visible incident solar radiation from atm + ! - rain from atm + ! - snow from atm allocate(flds(7)) flds = (/'Faxa_lwdn ', 'Faxa_swndr', 'Faxa_swvdr', 'Faxa_swndf', 'Faxa_swvdf', & @@ -623,69 +556,67 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compice, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compice , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to ice - state from atm - ! to ice: height at the lowest model level from atm - ! to ice: pressure at the lowest model level from atm - ! to ice: temperature at the lowest model level from atm - ! to ice: zonal wind at the lowest model level from atm - ! to ice: meridional wind at the lowest model level from atm - ! to ice: specific humidity at the lowest model level from atm + ! to ice: states from atm + ! - height at the lowest model level from atm + ! - pressure at the lowest model level from atm + ! - temperature at the lowest model level from atm + ! - zonal wind at the lowest model level from atm + ! - meridional wind at the lowest model level from atm + ! - specific humidity at the lowest model level from atm allocate(flds(6)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & - 'Sa_shum'/) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum'/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compice, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compice , fldname) endif else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to ice - states and fluxes from ocn - ! to ice: sea surface temperature from ocn - ! to ice: sea surface salinity from ocn - ! to ice: zonal sea water velocity from ocn - ! to ice: meridional sea water velocity from ocn - ! to ice: zonal sea surface slope from ocn - ! to ice: meridional sea surface slope from ocn - ! to ice: ocean melt and freeze potential from ocn + ! to ice: states and fluxes from ocn + ! - sea surface temperature from ocn + ! - sea surface salinity from ocn + ! - zonal sea water velocity from ocn + ! - meridional sea water velocity from ocn + ! - zonal sea surface slope from ocn + ! - meridional sea surface slope from ocn + ! - ocean melt and freeze potential from ocn allocate(flds(7)) - flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', & - 'So_dhdy', 'Fioo_q '/) + flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', 'So_dhdy', 'Fioo_q '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compice)) then - call addfld_from(compocn, trim(fldname)) - call addfld_to(compice, trim(fldname)) + call addfld_from(compocn , fldname) + call addfld_to(compice , fldname) endif else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then - call addmap_from(compocn, trim(fldname), compice, mapfcopy , 'unset', 'unset') - call addmrg_to(compice, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), fldname, rc=rc)) then + call addmap_from(compocn, fldname, compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, fldname, mrg_from=compocn, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -693,8 +624,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compwav, 'Sw_elevation_spectrum') - call addfld_to(compice, 'Sw_elevation_spectrum') + call addfld_from(compwav , 'Sw_elevation_spectrum') + call addfld_to(compice , 'Sw_elevation_spectrum') end if else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & @@ -709,63 +640,69 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! FIELDS TO WAV (compwav) !===================================================================== - ! to wav - 10m winds and bottom temperature from atm + ! to wav: states from atm + ! - 10m meridonal and zonal winds + ! - bottom temperature from atm allocate(flds(3)) flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compwav, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compwav , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compwav, mapbilnr_nstod, 'one', 'unset') - call addmrg_to(compwav, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compwav, mapbilnr_nstod, 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to wav: sea ice fraction, thickness and floe diameter + ! to wav: states from ice + ! - sea ice fraction + ! - sea ice thickness + ! - sea ice floe diameter allocate(flds(3)) flds = (/'Si_ifrac ', 'Si_floediam', 'Si_thick '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compwav, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compwav , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset') - call addmrg_to(compwav, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compwav, mapbilnr_nstod , 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to wav: zonal sea water velocity from ocn - ! to wav: meridional sea water velocity from ocn - ! to wav: surface temperature from ocn - allocate(flds(3)) - flds = (/'So_u', 'So_v', 'So_t'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compocn, trim(fldname)) - call addfld_to(compwav, trim(fldname)) - end if - else - if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then - call addmap_from(compocn, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset') - call addmrg_to(compwav, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + ! to wav: states from ocn + ! - zonal sea water velocity from ocn + ! - meridional sea water velocity from ocn + ! - surface temperature from ocn + allocate(flds(3)) + flds = (/'So_u', 'So_v', 'So_t'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then + call addfld_from(compocn , fldname) + call addfld_to(compwav , fldname) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), fldname, rc=rc)) then + call addmap_from(compocn, fldname, compwav, mapbilnr_nstod , 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compocn, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -796,14 +733,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(complnd, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(complnd , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), complnd, maptype, 'one', 'unset') - call addmrg_to(complnd, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(complnd) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, complnd, maptype, 'one', 'unset') + call addmrg_to(complnd, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do diff --git a/mediator/med.F90 b/mediator/med.F90 index 3efc94a6e..9bb936f60 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -934,7 +934,6 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif - if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -1775,7 +1774,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! NOTE: this section must be done BEFORE the second call to esmFldsExchange - ! Create field bundles for mediator ocean albedo computation + ! Create field bundles for mediator atm/ocean flux computation fieldCount = med_fldList_GetNumFlds(med_fldList_getaofluxfldList()) if ( fieldCount > 0 ) then if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2fd83972a..7fe0315b6 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -365,11 +365,8 @@ subroutine med_fraction_init(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(compocn,compatm,:), maptype, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Set 'aofrac' in FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + ! Set 'aofrac' in FBfrac(compatm) if available + if ( fldbun_fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) @@ -788,11 +785,8 @@ subroutine med_fraction_set(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compatm,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) if available + if ( fldbun_fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 3ce87e874..01d1a52d0 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -132,30 +132,15 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- merge all fields to atm !--------------------------------------- fldList => med_fldList_GetfldListTo(compatm) - if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compatm), & - is_local%wrap%FBExp(compatm), & - is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBImp(:,compatm), & - fldList, & - FBMed1=is_local%wrap%FBMed_ocnalb_a, & - FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'hafs' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compatm), & - is_local%wrap%FBExp(compatm), & - is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBImp(:,compatm), & - fldList, & - rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compatm), & + is_local%wrap%FBExp(compatm), & + is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBImp(:,compatm), & + fldList, & + FBMed1=is_local%wrap%FBMed_ocnalb_a, & + FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBExp(compatm),string=trim(subname)//' FBexp(compatm) ', rc=rc) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 52faa2175..d76f3e81a 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -116,30 +116,14 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldList => med_fldList_GetfldListTo(compocn) ! auto merges to ocn - if ( trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_orig_data' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compocn), & - is_local%wrap%FBExp(compocn), & - is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBImp(:,compocn), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'hafs' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compocn), & - is_local%wrap%FBExp(compocn), & - is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBImp(:,compocn), & - fldList, & - rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compocn), & + is_local%wrap%FBExp(compocn), & + is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBImp(:,compocn), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! compute enthaly associated with rain, snow, condensation and liquid river runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so