From dabfaa94a5b1bdcbc40bb23fc1122b6cb7ba3dbc Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 14 Aug 2023 16:19:48 -0400 Subject: [PATCH 1/3] modify cmeps for correct signs from ATM (#97) * account for taux,y sign change from atm * remove custom merge related solely to need to change sign * change sign for faxa_sen to match ATM export * use evap from atm directly --- mediator/esmFldsExchange_nems_mod.F90 | 14 +++++++++++--- mediator/med.F90 | 6 +++--- mediator/med_phases_prep_atm_mod.F90 | 5 ++--- mediator/med_phases_prep_ocn_mod.F90 | 28 ++------------------------- 4 files changed, 18 insertions(+), 35 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index bbdf41568..74a866d5f 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -394,7 +394,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) 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 (custom merge calculation in med_phases_prep_ocn) + ! to ocn: merge surface stress allocate(oflds(2)) allocate(aflds(2)) allocate(iflds(2)) @@ -415,6 +415,10 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) 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') end if end if end do @@ -437,7 +441,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end if - ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) + ! 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') @@ -447,10 +451,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_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', & + mrg_from=compatm, mrg_fld='Faxa_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if - ! to ocn: evaporation water flux (custom merge in med_phases_prep_ocn) + ! 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') @@ -460,6 +466,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_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', & + 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 diff --git a/mediator/med.F90 b/mediator/med.F90 index 56fcb7621..c8da4dbb9 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -661,7 +661,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init - use med_methods_mod , only : mediator_checkfornans + use med_methods_mod , only : mediator_checkfornans ! input/output variables type(ESMF_GridComp) :: gcomp @@ -921,7 +921,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent .and. isSet) then - read(cvalue, *) mediator_checkfornans + read(cvalue, *) mediator_checkfornans else mediator_checkfornans = .false. endif @@ -1942,7 +1942,7 @@ subroutine DataInitialize(gcomp, rc) ! Initialize ocean albedos (this is needed for cesm and hafs) !---------------------------------------------------------- - if (trim(coupling_mode(1:5)) /= 'nems_') then + if (trim(coupling_mode(1:5)) == 'cesm_') then if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then call med_phases_ocnalb_run(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 98728a8a6..3ce87e874 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -115,7 +115,6 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'hafs' .or. & trim(coupling_mode) == 'nems_frac_aoflux' .or. & trim(coupling_mode) == 'nems_frac_aoflux_sbs') then if (is_local%wrap%aoflux_grid == 'ogrid') then @@ -134,8 +133,7 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- fldList => med_fldList_GetfldListTo(compatm) if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'hafs') then + trim(coupling_mode) == 'nems_frac_aoflux') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & @@ -147,6 +145,7 @@ subroutine med_phases_prep_atm(gcomp, 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), & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 27e1d55ef..33c12e6e6 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -119,8 +119,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! auto merges to ocn if ( trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_orig_data' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'hafs') then + trim(coupling_mode) == 'nems_frac_aoflux') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -131,6 +130,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, 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), & @@ -668,30 +668,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) lsize = size(ofrac) allocate(customwgt(lsize)) - if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_evap' , wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_sen', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_sen', wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux', wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux', wgtB=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy', wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & From c24fb5999efafffaa393b886e21780ab7fd3aa08 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 25 Aug 2023 14:32:31 -0400 Subject: [PATCH 2/3] implement ocean albedo calculation (#92) * flux_albav moved to _init * use_nextswcday for using clock instead of scalar field * min_albedo for setting min albedo used max(min_albedo,....) * giving a min_albedo value sets logical use_min_albedo, otherwise false and min_albedo=0 * set mean albdif and albdir via config. If not present, defaults to current values --- .github/workflows/srt.yml | 11 +- cime_config/config_component.xml | 42 +++++- cime_config/namelist_definition_drv.xml | 2 +- mediator/esmFldsExchange_cesm_mod.F90 | 4 +- mediator/esmFldsExchange_nems_mod.F90 | 20 ++- mediator/med.F90 | 13 +- mediator/med_internalstate_mod.F90 | 1 - mediator/med_io_mod.F90 | 6 +- mediator/med_map_mod.F90 | 22 +-- mediator/med_methods_mod.F90 | 7 +- mediator/med_phases_history_mod.F90 | 2 +- mediator/med_phases_ocnalb_mod.F90 | 169 +++++++++++++++++------- mediator/med_phases_prep_ocn_mod.F90 | 92 +------------ 13 files changed, 219 insertions(+), 172 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 39526be99..34252cb63 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 - PARALLELIO_VERSION: pio2_5_10 + ESMF_VERSION: v8.5.0 + PARALLELIO_VERSION: pio2_6_0 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -153,6 +153,7 @@ jobs: mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/cesm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib @@ -175,6 +176,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index f986cfad2..a329be743 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -784,6 +784,34 @@ If TRUE, the component libraries are always built with OpenMP capability. + + char + + + build_def + env_build.xml + If set will compile and submit with this gpu type enabled + + + + char + + + build_def + env_build.xml + If set will compile and submit with this gpu offload method enabled + + + + char + + + build_def + env_build.xml + If set will attach this script to the MPI run command, mapping + different MPI ranks to different GPUs within the same compute node + + logical TRUE,FALSE @@ -1798,12 +1826,22 @@ pes or cores per node for accounting purposes + + integer + 0 + + 1 + + mach_pes_last + env_mach_pes.xml + Number of CPU cores per GPU node used for simulation + + integer 0 - 1 - 1 + 1 mach_pes env_mach_pes.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d9001cfb7..dec6868f1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -938,7 +938,7 @@ default: ogrid - xgrid + ogrid diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 13811aec9..a2c4fe435 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2158,7 +2158,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if @@ -2182,7 +2182,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 74a866d5f..30066c59e 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -38,6 +38,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addmap_from => med_fldList_addmap_from use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux + use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb + use esmFlds , only : addmap_ocnalb => med_fldList_addmap_ocnalb ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -167,9 +169,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) deallocate(flds) end if - ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed + ! Advertise the ocean albedos. These are not sent to the ATM in UFS. if (phase == 'advertise') then - call addfld_from(compice, 'mean_sw_pen_to_ocn') + call addfld_ocnalb('So_avsdr') + call addfld_ocnalb('So_avsdf') + call addfld_ocnalb('So_anidr') + call addfld_ocnalb('So_anidf') end if !===================================================================== @@ -329,6 +334,17 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end if + ! 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') + 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 diff --git a/mediator/med.F90 b/mediator/med.F90 index c8da4dbb9..3efc94a6e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1804,7 +1804,8 @@ subroutine DataInitialize(gcomp, rc) call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'nems') then - call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1939,14 +1940,12 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------- - ! Initialize ocean albedos (this is needed for cesm and hafs) + ! Initialize ocean albedos !---------------------------------------------------------- - if (trim(coupling_mode(1:5)) == 'cesm_') then - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then - call med_phases_ocnalb_run(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then + call med_phases_ocnalb_run(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index c5497293f..66e2eb1db 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -262,7 +262,6 @@ subroutine med_internalstate_init(gcomp, rc) end do end if is_local%wrap%num_icesheets = num_icesheets - call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 82e0b04d0..265a5ddda 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,7 +75,7 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -1738,8 +1738,8 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(minIndexPTile, maxIndexPTile) else - if(maintask) write(logunit,*) trim(subname),' ERROR: '//trim(name1)//' is not present, aborting ' - call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_INFO) + if(maintask) write(logunit,'(a)') trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ' + call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE end if ! end if rcode check diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 18752dc2f..54bcbb154 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -111,7 +111,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Mesh) :: mesh_dst type(med_fldlist_type), pointer :: FldListFr type(med_fldlist_entry_type), pointer :: fldptr - character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + character(len=*), parameter :: subname=' (med_map_mod: RouteHandles_init) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -259,7 +259,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' created field_NormOne for '& - //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(mapindex)) + //trim(compname(n1))//'->'//trim(compname(n2))//' with mapping '& + //trim(mapnames(mapindex)) end if end if end do ! end of loop over map_indiex mappers @@ -304,7 +305,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_routehandles_initfrom_fieldbundle) ' !--------------------------------------------- rc = ESMF_SUCCESS @@ -653,7 +654,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -678,7 +679,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH1d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -750,7 +751,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' + character(len=*), parameter :: subname=' (med_map_mod:med_packed_field_create) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -818,6 +819,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) else + !if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & @@ -953,7 +955,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field), pointer :: fieldlist_dst(:) real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1165,7 +1167,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1278,7 +1280,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' + character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1381,7 +1383,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 54fe20ec1..649c9c511 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -1354,7 +1354,10 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) call med_methods_Field_GetFldPtr(lfield, fldptr1=dataptro1, fldptr2=dataptro2, rank=lranko, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lranki == 1 .and. lranko == 1) then + if (lranki == 0 .and. lranko == 0) then + ! do nothing + call ESMF_LogWrite(trim(subname)//": Both ranki and ranko are 0", ESMF_LOGMSG_INFO) + elseif (lranki == 1 .and. lranko == 1) then if (.not.med_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) @@ -1397,7 +1400,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5f150a4b7..7d59a7fea 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -25,7 +25,7 @@ module med_phases_history_mod use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t - + implicit none private diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index a5ef002c7..31bd211f0 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -6,13 +6,11 @@ module med_phases_ocnalb_mod use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar - use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn + use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn, maintask use perf_mod , only : t_startf, t_stopf -#ifdef CESMCOUPLED use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL use shr_log_mod , only : shr_log_unit -#endif implicit none private @@ -26,11 +24,10 @@ module med_phases_ocnalb_mod !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- -#ifdef CESMCOUPLED + private med_phases_ocnalb_init private med_phases_ocnalb_orbital_update private med_phases_ocnalb_orbital_init -#endif !-------------------------------------------------------------------------- ! Private data @@ -47,25 +44,30 @@ module med_phases_ocnalb_mod logical :: created ! has memory been allocated here end type ocnalb_type - ! Conversion from degrees to radians character(*),parameter :: u_FILE_u = & __FILE__ -#ifdef CESMCOUPLED character(len=CL) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year integer :: orb_iyear_align ! attribute - associated with model year real(R8) :: orb_obliq ! attribute - obliquity in degrees real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity -#endif + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + ! used, reused in module + logical :: flux_albav ! use average dif and dir albedos + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir + real(R8) :: albdif ! 60 deg reference albedo, diffuse + real(R8) :: albdir ! 60 deg reference albedo, direct !=============================================================================== contains !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) !----------------------------------------------------------------------- @@ -74,11 +76,12 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! All input field bundles are ASSUMED to be on the ocean grid !----------------------------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : operator(==) + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet + use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : operator(==) ! Arguments type(ESMF_GridComp) :: gcomp @@ -97,7 +100,11 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) type(InternalState) :: is_local real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 + character(len=CS) :: cvalue + logical :: use_min_ocnalb + logical :: isPresent, isSet integer :: fieldCount + character(CL) :: msg type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- @@ -186,13 +193,65 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call med_phases_ocnalb_orbital_init(gcomp, logunit, iam==0, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine if reference albedos are used + flux_albav = .false. + call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flux_albav + end if + ! Set reference albedo values + call NUOPC_CompAttributeGet(gcomp, name="albdif", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) albdif + else + albdif = 0.06_r8 + end if + call NUOPC_CompAttributeGet(gcomp, name="albdir", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) albdir + else + albdir = 0.07_r8 + end if + ! Determine if direct albedo should have a minimum value + call NUOPC_CompAttributeGet(gcomp, name="ocean_albedo_limit", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) min_albedo + use_min_albedo = .true. + else + min_albedo = 0.0_R8 + use_min_ocnalb = .false. + endif + ! Allow setting of albedo timestep using the clock instead of the atm's next timestep + use_nextswcday = .true. + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent ) then + use_nextswcday = .false. + endif + + if (flux_albav) then + write(msg,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + else + if (use_min_albedo) then + write(msg,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + end if + write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_init -#endif + !=============================================================================== subroutine med_phases_ocnalb_run(gcomp, rc) @@ -201,8 +260,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Compute ocean albedos (on the ocean grid) !----------------------------------------------------------------------- + use NUOPC_Mediator, only : NUOPC_MediatorGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_TimeInterval use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_ClockIsCreated, ESMF_ClockGetNextTime use ESMF , only : ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO @@ -211,11 +272,11 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet use med_constants_mod , only : shr_const_pi + use med_phases_history_mod, only : med_phases_history_write_med ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc -#ifdef CESMCOUPLED ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -224,12 +285,13 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: update_alb type(InternalState) :: is_local type(ESMF_Clock) :: clock + type(ESMF_Clock) :: dclock type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep character(CL) :: cvalue character(CS) :: starttype ! config start type character(CL) :: runtype ! initial, continue, hybrid, branch - logical :: flux_albav ! flux avg option real(R8) :: nextsw_cday ! calendar day of next atm shortwave real(R8), pointer :: ofrac(:) real(R8), pointer :: ofrad(:) @@ -246,21 +308,13 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8) :: obliqr ! Earth orbit real(R8) :: delta ! Solar declination angle in radians real(R8) :: eccf ! Earth orbit eccentricity factor - real(R8), parameter :: albdif = 0.06_r8 ! 60 deg reference albedo, diffuse - real(R8), parameter :: albdir = 0.07_r8 ! 60 deg reference albedo, direct real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- -#endif - rc = ESMF_SUCCESS - -#ifndef CESMCOUPLED - RETURN ! the following code is not executed unless the model is CESM - -#else + rc = ESMF_SUCCESS ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -275,8 +329,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else ocnalb%created = .false. @@ -331,6 +384,26 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else + ! obtain nextsw_cday from atm if it is in the import state + if (use_nextswcday) then + call State_GetScalar(& + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + scalar_value=nextsw_cday, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + first_call = .false. + + else + ! Note that med_methods_State_GetScalar includes a broadcast to all other pets + if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -338,27 +411,14 @@ subroutine med_phases_ocnalb_run(gcomp, rc) scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & scalar_value=nextsw_cday, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - first_call = .false. - - else - - ! Note that med_methods_State_GetScalar includes a broadcast to all other pets - call State_GetScalar(& - state=is_local%wrap%NstateImp(compatm), & - flds_scalar_name=is_local%wrap%flds_scalar_name, & - flds_scalar_num=is_local%wrap%flds_scalar_num, & - scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & - scalar_value=nextsw_cday, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flux_albav - ! Get orbital values call med_phases_ocnalb_orbital_update(clock, logunit, iam==0, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -393,6 +453,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + if (use_min_albedo) then + ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) + end if ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif ocnalb%avsdf(n) = albdif @@ -430,18 +493,25 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ofrad(:) = ofrac(:) endif + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_med(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) -#endif - end subroutine med_phases_ocnalb_run !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) !---------------------------------------------------------- @@ -601,7 +671,6 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob endif end subroutine med_phases_ocnalb_orbital_update -#endif !=============================================================================== diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 33c12e6e6..52faa2175 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -31,8 +31,7 @@ module med_phases_prep_ocn_mod public :: med_phases_prep_ocn_accum ! called from run sequence public :: med_phases_prep_ocn_avg ! called from run sequence - private :: med_phases_prep_ocn_custom_cesm - private :: med_phases_prep_ocn_custom_nems + private :: med_phases_prep_ocn_custom character(*), parameter :: u_FILE_u = & __FILE__ @@ -217,13 +216,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_ocn_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:5)) == 'nems_') then - call med_phases_prep_ocn_custom_nems(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call med_phases_prep_ocn_custom(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ocean accumulator call FB_accum(is_local%wrap%FBExpAccumOcn, is_local%wrap%FBExp(compocn), rc=rc) @@ -315,7 +309,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) end subroutine med_phases_prep_ocn_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) + subroutine med_phases_prep_ocn_custom(gcomp, rc) !--------------------------------------- ! custom calculations for cesm @@ -372,7 +366,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom)' !--------------------------------------- rc = ESMF_SUCCESS @@ -620,80 +614,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) end if call t_stopf('MED:'//subname) - end subroutine med_phases_prep_ocn_custom_cesm - - !----------------------------------------------------------------------------- - subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) - - ! ---------------------------------------------- - ! Custom calculation for nems_orig or nems_frac - ! ---------------------------------------------- - - use ESMF , only : ESMF_GridComp - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - real(R8), pointer :: customwgt(:) - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - integer :: lsize - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, maintask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! get ice and open ocean fractions on the ocn mesh - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - lsize = size(ofrac) - allocate(customwgt(lsize)) - - ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] - customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(customwgt) - - if (dbug_flag > 20) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_prep_ocn_custom_nems + end subroutine med_phases_prep_ocn_custom end module med_phases_prep_ocn_mod From a5dea5f178fc98a4ab39c58aa43c37da6ad25d08 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 5 Oct 2023 10:12:11 -0400 Subject: [PATCH 3/3] refactor nems esmFldsExchange (#99) * clean up ufs fields exchange by consolidating logical blocks * remove extraneous trim on fldname variables * remove conditionals on mediator fields --- mediator/esmFldsExchange_nems_mod.F90 | 607 ++++++++++++-------------- mediator/med.F90 | 3 +- mediator/med_fraction_mod.F90 | 14 +- mediator/med_phases_prep_atm_mod.F90 | 33 +- mediator/med_phases_prep_ocn_mod.F90 | 32 +- 5 files changed, 294 insertions(+), 395 deletions(-) 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