From 661993f723f85ca4e2e845b822214bb27d6da376 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Feb 2024 19:54:48 -0700 Subject: [PATCH 01/69] Initial add of code to handle dust emissions, as per the document https://docs.google.com/document/d/18nZ3LJF5W-YF9iBhqed6s_NWeKOvSSL2-k0Lye1nnLg/, HAS NOT BEEN TESTED --- cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 204 +++++++++++++++++++ cime_config/namelist_definition_drv_flds.xml | 27 +++ 2 files changed, 231 insertions(+) create mode 100644 cesm/nuopc_cap_share/shr_dust_emis_mod.F90 diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 new file mode 100644 index 000000000..0e8ce424a --- /dev/null +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -0,0 +1,204 @@ +module shr_dust_emis_mod + + !======================================================================== + ! Module for handling dust emissions. + ! This module is shared by land and atmosphere models for the computation of + ! dust emissions. + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_VMBroadCast + use shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : CS => SHR_KIND_CS + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : shr_log_getLogUnit, errMsg => shr_log_errMsg + use nuopc_shr_methods, only : chkerr + + implicit none + private + + ! public member functions + public :: shr_dust_emis_readnl ! Read namelist + public :: shr_dust_emis_init ! Initialization of dust emissions data (needed?) + public :: is_dust_emis_zender ! If Zender_2003 dust emission method is being used + public :: is_dust_emis_leung ! If Leungr_2023 dust emission method is being used + public :: is_zender_soil_erod_from_lnd ! If Zender_2003 is being used and soil eroditability is in land + public :: is_zender_soil_erod_from_atm ! If Zender_2003 is being used and soil eroditability is in atmosphere + + ! public data members: + private :: check_if_initialized ! Check if dust emission has been initialized + + ! PRIVATE DATA: + character(len=CS) :: dust_emis_method = 'Zender_2003' ! Dust emisison method to use: Zender_2003 or Leung_2023 + character(len=CS) :: zender_soil_erod_source = 'none' ! if calculed in lnd or atm (only when Zender_2003 is used) + logical :: dust_emis_initialized=.false. ! If dust emissions have been initiatlized yet or not + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +CONTAINS +!=============================================================================== + + subroutine shr_dust_emis_readnl(NLFilename) + + !======================================================================== + ! reads dust_emis_inparm namelist to determine how dust emissions will + ! be handled between the land and atmosphere models + !======================================================================== + + character(len=*), intent(in) :: NLFilename ! Namelist filename + + !----- local ----- + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + type(ESMF_VM) :: vm + integer :: localPet + integer :: mpicom + integer :: s_logunit + integer :: rc + character(*),parameter :: F00 = "('(shr_dust_emis_read) ',8a)" + character(*),parameter :: subName = '(shr_dust_emis_read) ' + !----------------------------------------------------------------------------- + + namelist /dust_emis_inparm/ dust_emis_method, zender_soil_erod_source + + !----------------------------------------------------------------------------- + ! Read namelist, check if namelist file exists first + !----------------------------------------------------------------------------- + call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) + + rc = ESMF_SUCCESS + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 )then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_log_getLogUnit(s_logunit) + if (localPet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(s_logunit,F00) 'Read in dust_emis_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'dust_emis_inparm', ierr) + if (ierr == 0) then + ! Note that ierr /= 0, no namelist is present. + read(unitn, dust_emis_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( subName//'ERROR:: problem on read of dust_emis_inparm ' & + // 'namelist in shr_dust_emis_readnl') + end if + endif + close( unitn ) + end if + end if + call ESMF_LogWrite(subname//' bcast dust_emis_method', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, dust_emis_method, CS, 0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_LogWrite(subname//' bcast zender_soil_erod_source', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, zender_soil_erod_source, CS, 0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! Some error checking + if (trim(dust_emis_method) == 'Leung_2023') then + if ( trim(zender_soil_erod_source) /= 'none' )then + call shr_sys_abort(subName//"ERROR: zender_soil_erod_source should NOT be set, when dust_emis_method=Leung_2023 " & + //errMsg(u_FILE_u, __LINE__)) + end if + else if (trim(dust_emis_method) == 'Zender_2003') then + if ( (trim(zender_soil_erod_source) /= 'lnd') .and. (trim(zender_soil_erod_source) /= 'atm') )then + write(s_logunit,*) 'zender_soil_erod_source is NOT valid = ', trim(zender_soil_erod_source) + call shr_sys_abort(subName//"ERROR: zender_soil_erod_source can only be lnd or atm" & + //errMsg(u_FILE_u, __LINE__)) + end if + else + write(s_logunit,*) 'dust_emis_method not recognized = ', trim(dust_emis_method) + call shr_sys_abort(subName//"ERROR: dust_emis_method namelist item is not valid " & + //errMsg(u_FILE_u, __LINE__)) + end if + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + dust_emis_initialized = .true. + + end subroutine shr_dust_emis_readnl + +!==================================================================================== + + logical function is_dust_emis_zender() + ! is_dust_emis_zender – Logical function, true if the Zender 2003 scheme is being used + call check_if_initiatlized() + if (trim(dust_emis_method) == 'Zender_2003') then + is_dust_emis_zender = .true. + else + is_dust_emis_zender = .false. + end if + end function is_dust_emis_zender + +!=============================================================================== + + logical function is_dust_emis_leung() + ! is_dust_emis_leung – Logical function, true if the Leung 2023 scheme is being used + call check_if_initiatlized() + if (trim(dust_emis_method) == 'Leung_2023') then + is_dust_emis_leung = .true. + else + is_dust_emis_leung = .false. + end if + end function is_dust_emis_leung + +!=============================================================================== + + logical function is_zender_soil_erod_from_land() + ! is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CTSM + call check_if_initiatlized() + if is_dust_emis_zender() )then + if (trim(zender_soil_erod_source) == 'lnd') then + is_zender_soil_erod_from_land = .true. + else + is_zender_soil_erod_from_land = .false. + end if + else + is_zender_soil_erod_from_land = .false. + end if + end function is_zender_soil_erod_from_land + +!=============================================================================== + + logical function is_zender_soil_erod_from_atm() + !is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CAM + call check_if_initiatlized() + if is_dust_emis_zender() )then + if (trim(zender_soil_erod_source) == 'atm') then + is_zender_soil_erod_from_land = .true. + else + is_zender_soil_erod_from_land = .false. + end if + else + is_zender_soil_erod_from_land = .false. + end if + end function is_zender_soil_erod_from_atm + +!=============================================================================== + + subroutine check_if_initiatlized() + if ( dust_emis_initialized )then + return + else + call shr_sys_abort( 'ERROR: dust emission namelist has NOT been read in yet,' & + ' shr_dust_emis_mod is NOT initialized '//errMsg(u_FILE_u, __LINE__ ) + end if + end subroutine check_if_initiatlized + +!=============================================================================== + +end module shr_dust_emis_mod diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 03b6b7c6d..4d4ab1ec3 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -141,6 +141,33 @@ + + + + + + char*80 + dust_emissions + dust_emis_inparm + Zender_2003,Leung_2023 + + Which dust emission method is going to be used. Either the Zender 2003 scheme or the Leung 2023 + scheme. + + + + + char*80 + dust_emissions + dust_emis_inparm + none,lnd,atm + + Option only applying for the Zender_2003 method for whether the soil erodibility file is handled + in the active LAND model or in the ATM model. + (only used when dust_emis_method is Zender_2003) + + + From 758491ed6681dd6054b1ff877027e6da381e86f8 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 12 Mar 2024 14:11:16 -0400 Subject: [PATCH 02/69] fix dummy arguments w/o values (#114) --- ufs/glc_elevclass_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ufs/glc_elevclass_mod.F90 b/ufs/glc_elevclass_mod.F90 index 6524f064f..626bb3ee0 100644 --- a/ufs/glc_elevclass_mod.F90 +++ b/ufs/glc_elevclass_mod.F90 @@ -37,6 +37,7 @@ subroutine glc_get_elevation_classes_without_bareland(glc_topo, glc_elevclass, l real(r8), intent(in) :: glc_topo(:) ! topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_without_bareland !----------------------------------------------------------------------- @@ -45,6 +46,7 @@ subroutine glc_get_elevation_classes_with_bareland(glc_ice_covered, glc_topo, gl real(r8), intent(in) :: glc_topo(:) ! ice topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_with_bareland !----------------------------------------------------------------------- @@ -57,11 +59,12 @@ end function glc_mean_elevation_virtual !----------------------------------------------------------------------- subroutine glc_get_fractional_icecov(nec, glc_topo, glc_icefrac, glc_icefrac_ec, logunit) - integer , intent(in) :: nec ! number of elevation classes + integer , intent(in) :: nec ! number of elevation classes real(r8), intent(in) :: glc_topo(:) ! topographic height real(r8), intent(in) :: glc_icefrac(:) real(r8), intent(out) :: glc_icefrac_ec(:,:) integer , intent(in) :: logunit + glc_icefrac_ec = 0.0_r8 end subroutine glc_get_fractional_icecov end module glc_elevclass_mod From 4e19850cb083bc474b7cde5dc2f8506ec74cc442 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 3 Apr 2024 15:32:37 -0400 Subject: [PATCH 03/69] Sync w/ ESCOMP, add cpl_scalars for CSG and regional ATM domains (#115) * add cpl_scalar for tiled grids, other minor fixes * add new cpl_scalar for mediator history files for tiled gridded domains * remove unnecessary trims, fix minor typos and indentation * set ntile=0 when ntile scalar doesn't exist * modify dstmask for lnd->atm in UFS Co-authored-by: uturuncoglu --- cesm/driver/esm.F90 | 49 +++++++++---- mediator/med.F90 | 40 ++++++++--- mediator/med_fraction_mod.F90 | 6 +- mediator/med_internalstate_mod.F90 | 8 ++- mediator/med_io_mod.F90 | 41 ++++++----- mediator/med_map_mod.F90 | 106 +++++++++++++++------------- mediator/med_phases_history_mod.F90 | 48 +++++-------- mediator/med_phases_restart_mod.F90 | 4 ++ 8 files changed, 170 insertions(+), 132 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 759a4e986..a8342f54c 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1224,13 +1224,17 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) real (r8), allocatable :: lats(:) ! temporary real (r8), allocatable :: lons(:) ! temporary real (r8), allocatable :: pos_lons(:) ! temporary + real (r8), allocatable :: pos_lats(:) ! temporary + real (r8), allocatable :: cols(:) ! temporary real (r8), allocatable :: glob_grid(:,:) ! temporary real (r8) :: pos_scol_lon ! temporary + real (r8) :: pos_scol_lat ! temporary real (r8) :: scol_data(1) integer :: iscol_data(1) integer :: petcount character(len=CL) :: cvalue character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' + logical :: unstructured = .false. !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1324,7 +1328,15 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid frac') ! Read in domain file for single column - allocate(lats(nj)) + ! Check for unstructured data ni>1 and nj==1 + if (ni.gt.1 .and. nj == 1) unstructured=.true. + + if (unstructured) then + allocate(lats(ni)) + allocate(pos_lats(ni)) + else + allocate(lats(nj)) + end if allocate(lons(ni)) allocate(pos_lons(ni)) allocate(glob_grid(ni,nj)) @@ -1334,28 +1346,37 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) count3=(/ni,nj,1/) status = nf90_get_var(ncid, varid_xc, glob_grid, start3, count3) if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var xc') - do i = 1,ni - lons(i) = glob_grid(i,1) - end do + lons(1:ni) = glob_grid(1:ni,1) status = nf90_get_var(ncid, varid_yc, glob_grid, start3, count3) if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var yc') - do j = 1,nj - lats(j) = glob_grid(1,j) - end do - + if (unstructured) then + lats(1:ni) = glob_grid(1:ni,1) + else + lats(1:nj) = glob_grid(1,1:nj) + end if ! find nearest neighbor indices of scol_lon and scol_lat in single_column_lnd_domain file ! convert lons array and scol_lon to 0,360 and find index of value closest to 0 ! and obtain single-column longitude/latitude indices to retrieve - pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) - pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) - start(1) = (MINLOC(abs(pos_lons - pos_scol_lon), dim=1)) - start(2) = (MINLOC(abs(lats -scol_lat ), dim=1)) - + if (unstructured) then + allocate(cols(ni)) + pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) + pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) + pos_lats(:) = lats(:) + 90._r8 + pos_scol_lat = scol_lat + 90._r8 + cols=abs(pos_lons - pos_scol_lon)+abs(pos_lats - pos_scol_lat) + start(1) = MINLOC(cols, dim=1) + start(2) = 1 + deallocate(cols) + else + pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) + pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) + start(1) = (MINLOC(abs(pos_lons - pos_scol_lon), dim=1)) + start(2) = (MINLOC(abs(lats -scol_lat ), dim=1)) + end if deallocate(lats) deallocate(lons) deallocate(pos_lons) deallocate(glob_grid) - ! read in value of nearest neighbor lon and RESET scol_lon and scol_lat ! also get area of gridcell, mask and frac status = nf90_get_var(ncid, varid_xc, scol_lon, start) diff --git a/mediator/med.F90 b/mediator/med.F90 index 4a8d3d90b..dc0f68cf2 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc) #ifdef CDEPS_INLINE !------------------ - ! phase routine for cdeps inline capabilty + ! phase routine for cdeps inline capability !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -832,10 +832,10 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:3)) == 'ufs') then + else if (coupling_mode(1:3) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:4)) == 'hafs') then + else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else @@ -867,13 +867,22 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) is_local%wrap%flds_scalar_index_ny + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNTile", value=cvalue, & + isPresent=isPresent, isSet=isSet,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) is_local%wrap%flds_scalar_index_ntile + else + is_local%wrap%flds_scalar_index_ntile = 0 + end if + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) is_local%wrap%flds_scalar_index_nextsw_cday else - is_local%wrap%flds_scalar_index_nextsw_cday = spval + is_local%wrap%flds_scalar_index_nextsw_cday = 0 end if call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxPrecipFactor", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -962,7 +971,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif if (maintask) then write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp) - endif + endif end if end do @@ -1067,7 +1076,7 @@ subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! Recieve Grids + ! Receive Grids !------------------ do n1 = 1,ncomps @@ -1644,7 +1653,7 @@ subroutine DataInitialize(gcomp, rc) logical :: read_restart logical :: allDone = .false. logical,save :: first_call = .true. - real(r8) :: real_nx, real_ny + real(r8) :: real_nx, real_ny, real_ntile character(len=CX) :: msgString character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- @@ -1832,7 +1841,7 @@ subroutine DataInitialize(gcomp, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:3)) == 'ufs') then + else if (coupling_mode(1:3) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (coupling_mode(1:4) == 'hafs') then @@ -2128,11 +2137,22 @@ subroutine DataInitialize(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (is_local%wrap%flds_scalar_index_ntile > 0) then + call State_GetScalar(scalar_value=real_ntile, & + scalar_id=is_local%wrap%flds_scalar_index_ntile, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%ntile(n1) = nint(real_ntile) + else + is_local%wrap%ntile(n1) = 0 + end if is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) + write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then - write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) + write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2f7d43041..b0cd53a61 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -293,7 +293,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ice and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -345,7 +345,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ocn and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -756,7 +756,7 @@ subroutine med_fraction_set(gcomp, rc) call t_startf('MED:'//trim(subname)//' fbfrac(compatm)') ! Determine maptype - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index b06f20c1c..e45331f76 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -121,7 +121,7 @@ module med_internalstate_mod ! Present/allowed coupling/active coupling logical flags logical, pointer :: comp_present(:) ! comp present flag logical, pointer :: med_coupling_active(:,:) ! computes the active coupling - logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill + logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill logical, pointer :: med_data_force_first(:) ! force to use stream data for first coupling timestep integer :: num_icesheets ! obtained from attribute logical :: ocn2glc_coupling = .false. ! obtained from attribute @@ -133,12 +133,15 @@ module med_internalstate_mod ! Global nx,ny dimensions of input arrays (needed for mediator history output) integer, pointer :: nx(:), ny(:) + ! Number of nx*ny domains (needed for cubed-sphere and regional domains) + integer, pointer :: ntile(:) ! Import/Export Scalars character(len=CL) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 integer :: flds_scalar_index_nx = 0 integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_ntile = 0 integer :: flds_scalar_index_nextsw_cday = 0 integer :: flds_scalar_index_precip_factor = 0 real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn @@ -312,6 +315,7 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%med_data_force_first(ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) + allocate(is_local%wrap%ntile(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) @@ -601,7 +605,7 @@ subroutine med_internalstate_defaultmasks(gcomp, rc) if (is_local%wrap%comp_present(compocn)) defaultMasks(compocn,:) = 0 if (is_local%wrap%comp_present(compice)) defaultMasks(compice,:) = 0 if (is_local%wrap%comp_present(compwav)) defaultMasks(compwav,:) = 0 - if ( trim(coupling_mode(1:3)) == 'ufs') then + if ( coupling_mode(1:3) == 'ufs') then if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1 endif if ( trim(coupling_mode) == 'hafs') then diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 265a5ddda..f4abadaf6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -698,7 +698,7 @@ end function med_io_sec2hms !=============================================================================== subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, tilesize, rc) + fillval, pre, flds, tavg, use_float, ntile, rc) !--------------- ! Write FB to netcdf file @@ -728,7 +728,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles + integer, optional , intent(in) :: ntile ! number of nx * ny tiles integer , intent(out):: rc ! local variables @@ -754,7 +754,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & character(CS) :: coordvarnames(2) ! coordinate variable names character(CS) :: coordnames(2) ! coordinate long names character(CS) :: coordunits(2) ! coordinate units - integer :: lnx,lny + integer :: lnx,lny,lntile logical :: luse_float real(r8) :: lfillvalue integer, pointer :: minIndexPTile(:,:) @@ -770,8 +770,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & integer :: rank integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields - logical :: atmtiles - integer :: ntiles = 1 + logical :: tiles character(CL), allocatable :: fieldNameList(:) character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- @@ -785,9 +784,9 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & luse_float = .false. if (present(use_float)) luse_float = use_float - atmtiles = .false. - if (present(tilesize)) then - if (tilesize > 0) atmtiles = .true. + tiles = .false. + if (present(ntile)) then + if (ntile > 0) tiles = .true. end if ! Error check @@ -870,14 +869,14 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! all the global grid values in the distgrid - e.g. CTSM ng = maxval(maxIndexPTile) - if (atmtiles) then - lnx = tilesize - lny = tilesize - ntiles = ng/(lnx*lny) - write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles + if (tiles) then + lnx = nx + lny = ny + lntile = ng/(lnx*lny) + write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (ntiles /= 6) then - call ESMF_LogWrite(trim(subname)//' ERROR: only cubed sphere atm tiles valid ', ESMF_LOGMSG_INFO) + if (lntile /= ntile) then + call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif else @@ -900,10 +899,10 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then - if (atmtiles) then + if (tiles) then rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) @@ -1020,8 +1019,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (atmtiles) then - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntiles/), dof, iodesc) + if (tiles) then + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc) else call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) @@ -1579,8 +1578,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) allocate(fldptr1_tmp(lsize)) do n = 1,ungriddedUBound(1) - ! Creat a name for the 1d field on the mediator history or restart file based on the - ! ungridded dimension index of the field bundle 2d fiedl + ! Create a name for the 1d field on the mediator history or restart file based on the + ! ungridded dimension index of the field bundle 2d field write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f77d4242e..3d888bcfa 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -408,11 +408,15 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask endif end if - if (trim(coupling_mode(1:3)) == 'ufs') then + if (coupling_mode(1:3) == 'ufs') then if (n1 == compatm .and. n2 == complnd) then srcMaskValue = ispval_mask dstMaskValue = ispval_mask end if + if (n1 == complnd .and. n2 == compatm) then + srcMaskValue = ispval_mask + dstMaskValue = ispval_mask + end if end if if (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then @@ -424,7 +428,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) polemethod=ESMF_POLEMETHOD_ALLAVG - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode(1:3)) == 'ufs') then + if (trim(coupling_mode) == 'cesm' .or. coupling_mode(1:3) == 'ufs') then if (n1 == compwav .or. n2 == compwav) then polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif @@ -949,7 +953,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle logical, optional , intent(in) :: use_data ! skip mapping and use data instead integer, optional , intent(out) :: rc @@ -1008,7 +1012,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ allocate(field_namelist_dat(fieldcount_dat)) call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if (present(use_data)) skip_mapping = use_data end if end if @@ -1072,7 +1076,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ call t_stopf('MED:'//trim(subname)//' copy from src') ! ----------------------------------- - ! Fill destination field with background data provided by CDEPS inline + ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- if (fieldcount_dat > 0) then @@ -1085,52 +1089,52 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ ! Get the indices into the packed data structure np = packed_data(mapindex)%fldindex(nf) if (np > 0) then - ! Get size of ungridded dimension and name of the field - call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." - - ! Check if field has match in data fields - isFound = .false. - do nfd = 1, fieldcount_dat - ! Debug output for checked fields to find match - if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) - - if (trim(field_name) == trim(field_namelist_dat(nfd))) then - ! Debug output about match - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" - - ! Get pointer from data field - call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - ! Fill destination field with background data coming from stream - dataptr2d_packed(np,:) = dataptr(:) - - if (dbug_flag > 1) then - call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - ! Exit from loop since match is already found - isFound = .true. - exit - end if - end do ! loop for stream fields - - ! Could not find match in the list of stream fields - if (.not. isFound) then - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" - - ! Fill destination field with very large background data - dataptr2d_packed(np,:) = fillValue - end if + ! Get size of ungridded dimension and name of the field + call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." + + ! Check if field has match in data fields + isFound = .false. + do nfd = 1, fieldcount_dat + ! Debug output for checked fields to find match + if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + ! Debug output about match + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" + + ! Get pointer from data field + call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill destination field with background data coming from stream + dataptr2d_packed(np,:) = dataptr(:) + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Exit from loop since match is already found + isFound = .true. + exit + end if + end do ! loop for stream fields + + ! Could not find match in the list of stream fields + if (.not. isFound) then + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" + + ! Fill destination field with very large background data + dataptr2d_packed(np,:) = fillValue + end if end if end do ! loop for destination fields diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7d59a7fea..52b20c035 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -322,24 +322,28 @@ subroutine med_phases_history_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created @@ -672,13 +676,13 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -694,16 +698,6 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. instfile%is_clockset) then @@ -775,22 +769,23 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) + nt=1, pre='Med_frac_'//trim(compname(compid)), ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -830,13 +825,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -854,16 +849,6 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. avgfile%is_clockset) then @@ -982,9 +967,10 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if (is_local%wrap%comp_present(compid)) then nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_import, czero, rc=rc) @@ -993,7 +979,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index a225ff97c..1bbbb0fbf 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -346,6 +346,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) + if (is_local%wrap%ntile(n) > 0) then + nx = is_local%wrap%ntile(n)*is_local%wrap%ny(n)*is_local%wrap%nx(n) + ny = 1 + end if ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & From e22c4eafd595964d88a1077961a809a60b794431 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 9 Apr 2024 16:12:42 -0600 Subject: [PATCH 04/69] Get to compile with nag compiler on izumi --- cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 46 ++++++++++------------ 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 index 0e8ce424a..51bcdf0ab 100644 --- a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -13,17 +13,15 @@ module shr_dust_emis_mod use shr_kind_mod , only : CS => SHR_KIND_CS use shr_nl_mod , only : shr_nl_find_group_name use shr_log_mod , only : shr_log_getLogUnit, errMsg => shr_log_errMsg - use nuopc_shr_methods, only : chkerr implicit none private ! public member functions public :: shr_dust_emis_readnl ! Read namelist - public :: shr_dust_emis_init ! Initialization of dust emissions data (needed?) public :: is_dust_emis_zender ! If Zender_2003 dust emission method is being used public :: is_dust_emis_leung ! If Leungr_2023 dust emission method is being used - public :: is_zender_soil_erod_from_lnd ! If Zender_2003 is being used and soil eroditability is in land + public :: is_zender_soil_erod_from_land ! If Zender_2003 is being used and soil eroditability is in land public :: is_zender_soil_erod_from_atm ! If Zender_2003 is being used and soil eroditability is in atmosphere ! public data members: @@ -51,15 +49,13 @@ subroutine shr_dust_emis_readnl(NLFilename) character(len=*), intent(in) :: NLFilename ! Namelist filename !----- local ----- - integer :: i ! Indices integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not - type(ESMF_VM) :: vm - integer :: localPet - integer :: mpicom - integer :: s_logunit - integer :: rc + type(ESMF_VM) :: vm ! Virtual machine + integer :: localPet ! Local processor + integer :: s_logunit ! Output log unit + integer :: rc ! Error code character(*),parameter :: F00 = "('(shr_dust_emis_read) ',8a)" character(*),parameter :: subName = '(shr_dust_emis_read) ' !----------------------------------------------------------------------------- @@ -148,7 +144,7 @@ end function is_dust_emis_zender logical function is_dust_emis_leung() ! is_dust_emis_leung – Logical function, true if the Leung 2023 scheme is being used - call check_if_initiatlized() + call check_if_initialized() if (trim(dust_emis_method) == 'Leung_2023') then is_dust_emis_leung = .true. else @@ -161,43 +157,43 @@ end function is_dust_emis_leung logical function is_zender_soil_erod_from_land() ! is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CTSM call check_if_initiatlized() - if is_dust_emis_zender() )then + if ( is_dust_emis_zender() )then if (trim(zender_soil_erod_source) == 'lnd') then is_zender_soil_erod_from_land = .true. else is_zender_soil_erod_from_land = .false. end if - else + else is_zender_soil_erod_from_land = .false. - end if + end if end function is_zender_soil_erod_from_land !=============================================================================== logical function is_zender_soil_erod_from_atm() - !is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CAM + !is_zender_soil_erod_from_atm – Logical function, true if the Zender method is being used and soil erodibility is in CAM call check_if_initiatlized() - if is_dust_emis_zender() )then - if (trim(zender_soil_erod_source) == 'atm') then - is_zender_soil_erod_from_land = .true. + if ( is_dust_emis_zender() )then + if ( trim(zender_soil_erod_source) == 'atm') then + is_zender_soil_erod_from_atm = .true. else - is_zender_soil_erod_from_land = .false. + is_zender_soil_erod_from_atm = .false. end if - else - is_zender_soil_erod_from_land = .false. - end if + else + is_zender_soil_erod_from_atm = .false. + end if end function is_zender_soil_erod_from_atm !=============================================================================== - subroutine check_if_initiatlized() + subroutine check_if_initialized() if ( dust_emis_initialized )then return else - call shr_sys_abort( 'ERROR: dust emission namelist has NOT been read in yet,' & - ' shr_dust_emis_mod is NOT initialized '//errMsg(u_FILE_u, __LINE__ ) + call shr_sys_abort( 'ERROR: dust emission namelist has NOT been read in yet,' // & + ' shr_dust_emis_mod is NOT initialized '//errMsg(u_FILE_u, __LINE__) ) end if - end subroutine check_if_initiatlized + end subroutine check_if_initialized !=============================================================================== From 05f05ce2660da13d1de49ba4d90a65cb3936ef97 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 11 Apr 2024 10:57:25 -0600 Subject: [PATCH 05/69] fix aoflux routine for ufs --- mediator/med_phases_aofluxes_mod.F90 | 31 ++++++++++++++++------------ 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 33bc0abaa..a95bd08bc 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1075,9 +1075,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & add_gusts=add_gusts, & - duu10n=aoflux_out%duu10n, & + duu10n=aoflux_out%duu10n, & ugust_out = aoflux_out%ugust_out, & - u10res = aoflux_out%u10res, & + u10res = aoflux_out%u10res, & ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval=0.0_r8) @@ -1102,7 +1102,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ocn_surface_flux_scheme=ocn_surface_flux_scheme, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & - duu10n=aoflux_out%duu10n, & + duu10n=aoflux_out%duu10n, & missval=0.0_r8) #ifdef UFS_AOFLUX end if @@ -1111,7 +1111,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #endif do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0) then + if (aoflux_in%mask(n) /= 0) then aoflux_out%u10(n) = aoflux_out%u10res(n) aoflux_out%u10_withGust(n) = sqrt(aoflux_out%duu10n(n)) end if @@ -1601,8 +1601,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (coupling_mode == 'cesm') then + call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if ! extra fields for ufs.frac.aoflux @@ -1714,13 +1716,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_tauy', aoflux_out%tauy, xgrid=xgrid, rc=rc) @@ -1750,8 +1745,18 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else allocate(aoflux_out%ugust_out(lsize)); aoflux_out%ugust_out(:) = 0._R8 + allocate(aoflux_out%u10_withGust(lsize)); aoflux_out%u10_withGust(:) = 0._R8 + end if + + if (coupling_mode == 'cesm') then + call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux_out%u10res(lsize)); aoflux_out%u10res(:) = 0._R8 end if end subroutine set_aoflux_out_pointers From 1213981882cd33e89f624692a2a7eb18ae2eca41 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Apr 2024 02:44:12 -0600 Subject: [PATCH 06/69] changes for adding multi-level docn input to cdeps --- cime_config/namelist_definition_drv.xml | 13 ------ mediator/esmFldsExchange_cesm_mod.F90 | 2 +- mediator/med_phases_post_ocn_mod.F90 | 1 + mediator/med_phases_prep_glc_mod.F90 | 60 +++++++++++++++---------- 4 files changed, 38 insertions(+), 38 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 698efb2c9..03dfcbe54 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -620,19 +620,6 @@ - - char - flds - ALLCOMP_attributes - - if the ocean component sends fields at multiple ocean levels to the - land-ice component, these are the colon deliminted level indices - - - 1:10:19:26:30:33:35 - - - char control diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b68e4d13f..47d0ae1a7 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3206,7 +3206,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- ! to glc: from ocn !----------------------------- - if (is_local%wrap%ocn2glc_coupling) then + if (ocn2glc_coupling) then if (phase == 'advertise') then call addfld_from(compocn, 'So_t_depth') call addfld_from(compocn, 'So_s_depth') diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index bfc234507..b253de664 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -83,6 +83,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! Accumulate ocn input for glc if there is ocn->glc coupling if (is_local%wrap%ocn2glc_coupling) then + call ESMF_LogWrite(subname//' DEBUG: calling med_phases_prep_glc_accum_ocn', ESMF_LOGMSG_INFO) call med_phases_prep_glc_accum_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 1fecf1a86..542cac761 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -37,6 +37,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_utils_mod , only : chkerr => med_utils_ChkErr use med_time_mod , only : med_time_alarmInit use glc_elevclass_mod , only : glc_get_num_elevation_classes @@ -44,6 +45,8 @@ module med_phases_prep_glc_mod use glc_elevclass_mod , only : glc_get_fractional_icecov use perf_mod , only : t_startf, t_stopf + use shr_sys_mod, only : shr_sys_abort + implicit none private @@ -106,7 +109,7 @@ module med_phases_prep_glc_mod integer , public :: ocnAccum2glc_cnt character(len=14) :: fldnames_fr_ocn(2) = (/'So_t_depth','So_s_depth'/) ! TODO: what else needs to be added here type(ESMF_DynamicMask) :: dynamicOcnMask - integer, parameter :: num_ocndepths = 7 + integer, parameter :: num_ocndepths = 30 type(ESMF_Clock) :: prepglc_clock character(*), parameter :: u_FILE_u = & @@ -319,7 +322,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) end if ! ------------------------------- - ! If ocn->glc couplng is active + ! If ocn->glc coupling is active ! ------------------------------- if (is_local%wrap%ocn2glc_coupling) then @@ -355,8 +358,8 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! Create a dynamic mask object ! The dynamic mask object further holds a pointer to the routine that will be called in order to ! handle dynamically masked elements - in this case its DynOcnMaskProc (see below) - call ESMF_DynamicMaskSetR8R8R8(dynamicOcnMask, dynamicSrcMaskValue=czero, & - dynamicMaskRoutine=DynOcnMaskProc, rc=rc) + call ESMF_DynamicMaskSetR8R8R8(dynamicOcnMask, dynamicMaskRoutine=DynOcnMaskProc, & + dynamicSrcMaskValue=1.e30_r8, handleAllElements=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -618,21 +621,24 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (do_avg) then ! Always average import from accumulated land import data do n = 1, size(fldnames_fr_lnd) - call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lndAccum2glc_cnt > 0) then - ! If accumulation count is greater than 0, do the averaging - data2d(:,:) = data2d(:,:) / real(lndAccum2glc_cnt) - else - ! If accumulation count is 0, then simply set the averaged field bundle values from the land - ! to the import field bundle values - call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_import, rc) + if (fldchk(FBlndAccum2glc_l, fldnames_fr_lnd(n), rc=rc)) then + call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - data2d(:,:) = data2d_import(:,:) + if (lndAccum2glc_cnt > 0) then + ! If accumulation count is greater than 0, do the averaging + data2d(:,:) = data2d(:,:) / real(lndAccum2glc_cnt) + else + ! If accumulation count is 0, then simply set the averaged field bundle values from the land + ! to the import field bundle values + call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_import, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + data2d(:,:) = data2d_import(:,:) + end if end if end do if (is_local%wrap%ocn2glc_coupling) then + call ESMF_LogWrite(subname//' DEBUG: averaging FBocnAccum2glc_o', ESMF_LOGMSG_INFO) ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d, rc) @@ -662,6 +668,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc(ns)), fldnames_fr_ocn(n), field=lfield_dst, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Do mapping of ocn to glc with dynamic masking + write(6,'(a)')' DEBUG: mapping FBocnAccum2glc_o with dynamic masking for '//trim(fldnames_fr_ocn(n)) call ESMF_FieldRegrid(lfield_src, lfield_dst, & routehandle=is_local%wrap%RH(compocn,compglc(ns),mapbilnr), dynamicMask=dynamicOcnMask, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return @@ -1244,7 +1251,7 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa integer , intent(out) :: rc ! local variables - integer :: i, j + integer :: no, ni real(ESMF_KIND_R8) :: renorm !--------------------------------------------------------------- @@ -1253,21 +1260,26 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa ! Below - ONLY if you do NOT have the source masked out then do ! the regridding (which is done explicitly here) + write(6,*)'DEBUG: dynamicSrcMaskValue = ',dynamicSrcMaskValue if (associated(dynamicMaskList)) then - do i=1, size(dynamicMaskList) - dynamicMaskList(i)%dstElement = czero ! set to zero + do no = 1, size(dynamicMaskList) + dynamicMaskList(no)%dstElement = czero ! set to zero renorm = 0.d0 ! reset - do j = 1, size(dynamicMaskList(i)%factor) - if (dynamicSrcMaskValue /= dynamicMaskList(i)%srcElement(j)) then - dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement + & - (dynamicMaskList(i)%factor(j) * dynamicMaskList(i)%srcElement(j)) - renorm = renorm + dynamicMaskList(i)%factor(j) + do ni = 1, size(dynamicMaskList(no)%factor) + + write(6,'(a,2(i10,2x),3(d13.5,2x))')'DEBUG: ',no,ni,& + dynamicMaskList(no)%srcElement(ni), dynamicMaskList(no)%dstElement, dynamicMaskList(no)%factor(ni) + + if (dynamicSrcMaskValue /= dynamicMaskList(no)%srcElement(ni)) then + dynamicMaskList(no)%dstElement = dynamicMaskList(no)%dstElement + & + (dynamicMaskList(no)%factor(ni) * dynamicMaskList(no)%srcElement(ni)) + renorm = renorm + dynamicMaskList(no)%factor(ni) endif enddo if (renorm > 0.d0) then - dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement / renorm + dynamicMaskList(no)%dstElement = dynamicMaskList(no)%dstElement / renorm else if (present(dynamicSrcMaskValue)) then - dynamicMaskList(i)%dstElement = dynamicSrcMaskValue + dynamicMaskList(no)%dstElement = dynamicSrcMaskValue else rc = ESMF_RC_ARG_BAD ! error detected return From 2289571bb7504538f3109596722b84ab177816d1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Apr 2024 09:36:27 -0600 Subject: [PATCH 07/69] implemented correct mapping of multi-level ocean to glc --- mediator/med_internalstate_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 23 ++++++++++++----------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index e45331f76..fb35645db 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -477,7 +477,7 @@ subroutine med_internalstate_coupling(gcomp, rc) isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - ! are multiple ocean depths for temperature and salinity sent from the ocn to glc? + ! multiple ocean depths for temperature and salinity sent from the ocn to glc read(cvalue,*) is_local%wrap%ocn2glc_coupling else is_local%wrap%ocn2glc_coupling = .false. diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 542cac761..4a1df0eea 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -20,7 +20,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_KIND_R8 use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 - use ESMF , only : ESMF_FieldRegrid + use ESMF , only : ESMF_FieldRegrid, ESMF_REGION_EMPTY use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc use med_internalstate_mod , only : InternalState, maintask, logunit use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created @@ -523,6 +523,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) logical :: isPresent, isSet logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' + integer :: k,cnt !--------------------------------------- call t_startf('MED:'//subname) @@ -638,7 +639,6 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end do if (is_local%wrap%ocn2glc_coupling) then - call ESMF_LogWrite(subname//' DEBUG: averaging FBocnAccum2glc_o', ESMF_LOGMSG_INFO) ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d, rc) @@ -668,10 +668,14 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc(ns)), fldnames_fr_ocn(n), field=lfield_dst, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Do mapping of ocn to glc with dynamic masking - write(6,'(a)')' DEBUG: mapping FBocnAccum2glc_o with dynamic masking for '//trim(fldnames_fr_ocn(n)) call ESMF_FieldRegrid(lfield_src, lfield_dst, & - routehandle=is_local%wrap%RH(compocn,compglc(ns),mapbilnr), dynamicMask=dynamicOcnMask, rc=rc) + routehandle=is_local%wrap%RH(compocn,compglc(ns),mapbilnr), dynamicMask=dynamicOcnMask, & + zeroregion=ESMF_REGION_EMPTY, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata2d(is_local%wrap%FBExp(compglc(ns)), fldnames_fr_ocn(n), data2d, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! reset values of 0 to spval + where (data2d == 0._r8) data2d = shr_const_spval end do end do ocnAccum2glc_cnt = 0 @@ -1251,7 +1255,7 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa integer , intent(out) :: rc ! local variables - integer :: no, ni + integer :: no, ni, i, j real(ESMF_KIND_R8) :: renorm !--------------------------------------------------------------- @@ -1260,17 +1264,14 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa ! Below - ONLY if you do NOT have the source masked out then do ! the regridding (which is done explicitly here) - write(6,*)'DEBUG: dynamicSrcMaskValue = ',dynamicSrcMaskValue if (associated(dynamicMaskList)) then do no = 1, size(dynamicMaskList) dynamicMaskList(no)%dstElement = czero ! set to zero renorm = 0.d0 ! reset do ni = 1, size(dynamicMaskList(no)%factor) - - write(6,'(a,2(i10,2x),3(d13.5,2x))')'DEBUG: ',no,ni,& - dynamicMaskList(no)%srcElement(ni), dynamicMaskList(no)%dstElement, dynamicMaskList(no)%factor(ni) - - if (dynamicSrcMaskValue /= dynamicMaskList(no)%srcElement(ni)) then + ! Need to multiply by .90 to handle averaging of input fields before remapping is called + if ( dynamicMaskList(no)%srcElement(ni) > 0.d0 .and. & + dynamicMaskList(no)%srcElement(ni) < dynamicSrcMaskValue*.90) then dynamicMaskList(no)%dstElement = dynamicMaskList(no)%dstElement + & (dynamicMaskList(no)%factor(ni) * dynamicMaskList(no)%srcElement(ni)) renorm = renorm + dynamicMaskList(no)%factor(ni) From 22dd0745efd2b959f02c76ffb55afa994a4d3005 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 26 Apr 2024 16:30:30 -0600 Subject: [PATCH 08/69] Remove ESMF in favor of shr_mpi_mod, it is simpler this way, this also allows me to do unit-testing easier --- cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 35 ++++++---------------- 1 file changed, 9 insertions(+), 26 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 index 0e8ce424a..768e2a3e3 100644 --- a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -6,14 +6,10 @@ module shr_dust_emis_mod ! dust emissions. !======================================================================== - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_VMBroadCast use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : CS => SHR_KIND_CS use shr_nl_mod , only : shr_nl_find_group_name use shr_log_mod , only : shr_log_getLogUnit, errMsg => shr_log_errMsg - use nuopc_shr_methods, only : chkerr implicit none private @@ -41,25 +37,24 @@ module shr_dust_emis_mod CONTAINS !=============================================================================== - subroutine shr_dust_emis_readnl(NLFilename) + subroutine shr_dust_emis_readnl(mpicom, NLFilename) !======================================================================== ! reads dust_emis_inparm namelist to determine how dust emissions will ! be handled between the land and atmosphere models !======================================================================== + use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_commrank character(len=*), intent(in) :: NLFilename ! Namelist filename + integer , intent(in) :: mpicom ! MPI communicator for broadcasting all all tasks !----- local ----- integer :: i ! Indices integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not - type(ESMF_VM) :: vm - integer :: localPet - integer :: mpicom + integer :: localPet ! Local processor rank integer :: s_logunit - integer :: rc character(*),parameter :: F00 = "('(shr_dust_emis_read) ',8a)" character(*),parameter :: subName = '(shr_dust_emis_read) ' !----------------------------------------------------------------------------- @@ -69,20 +64,13 @@ subroutine shr_dust_emis_readnl(NLFilename) !----------------------------------------------------------------------------- ! Read namelist, check if namelist file exists first !----------------------------------------------------------------------------- - call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) - - rc = ESMF_SUCCESS !--- Open and read namelist --- if ( len_trim(NLFilename) == 0 )then call shr_sys_abort( subName//'ERROR: nlfilename not set' ) end if - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_mpi_commrank( mpicom, localPet ) call shr_log_getLogUnit(s_logunit) if (localPet==0) then @@ -102,12 +90,8 @@ subroutine shr_dust_emis_readnl(NLFilename) close( unitn ) end if end if - call ESMF_LogWrite(subname//' bcast dust_emis_method', ESMF_LOGMSG_INFO) - call ESMF_VMBroadcast(vm, dust_emis_method, CS, 0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_LogWrite(subname//' bcast zender_soil_erod_source', ESMF_LOGMSG_INFO) - call ESMF_VMBroadcast(vm, zender_soil_erod_source, CS, 0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_mpi_bcast(dust_emis_method, mpicom) + call shr_mpi_bcast(zender_soil_erod_source, mpicom) ! Some error checking if (trim(dust_emis_method) == 'Leung_2023') then @@ -127,7 +111,6 @@ subroutine shr_dust_emis_readnl(NLFilename) //errMsg(u_FILE_u, __LINE__)) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) dust_emis_initialized = .true. end subroutine shr_dust_emis_readnl @@ -161,7 +144,7 @@ end function is_dust_emis_leung logical function is_zender_soil_erod_from_land() ! is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CTSM call check_if_initiatlized() - if is_dust_emis_zender() )then + if ( is_dust_emis_zender() )then if (trim(zender_soil_erod_source) == 'lnd') then is_zender_soil_erod_from_land = .true. else @@ -177,7 +160,7 @@ end function is_zender_soil_erod_from_land logical function is_zender_soil_erod_from_atm() !is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CAM call check_if_initiatlized() - if is_dust_emis_zender() )then + if ( is_dust_emis_zender() )then if (trim(zender_soil_erod_source) == 'atm') then is_zender_soil_erod_from_land = .true. else From 492faf0014ad9d91c22bb92e2570e558a76093fe Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 29 Apr 2024 18:58:12 -0600 Subject: [PATCH 09/69] Add somethings needed for unit-testing and fix things identified there --- cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 30 +++++++++++++++++----- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 index b1a91b71a..b14148a90 100644 --- a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -19,10 +19,14 @@ module shr_dust_emis_mod public :: is_dust_emis_zender ! If Zender_2003 dust emission method is being used public :: is_dust_emis_leung ! If Leungr_2023 dust emission method is being used public :: is_zender_soil_erod_from_land ! If Zender_2003 is being used and soil eroditability is in land - public :: is_zender_soil_erod_from_atm ! If Zender_2003 is being used and soil eroditability is in atmosphere + public :: is_zender_soil_erod_from_atm ! If Zender/_2003 is being used and soil eroditability is in atmosphere - ! public data members: - private :: check_if_initialized ! Check if dust emission has been initialized + ! The following is only public for the sake of unit testing; it should not be called + ! directly outside this module + public :: dust_emis_set_options ! Set the namelist options directory not through the namelist + + ! private data members: (only public for unit testing) + public :: check_if_initialized ! Check if dust emission has been initialized ! PRIVATE DATA: character(len=CS) :: dust_emis_method = 'Zender_2003' ! Dust emisison method to use: Zender_2003 or Leung_2023 @@ -117,7 +121,7 @@ end subroutine shr_dust_emis_readnl logical function is_dust_emis_zender() ! is_dust_emis_zender – Logical function, true if the Zender 2003 scheme is being used - call check_if_initiatlized() + call check_if_initialized() if (trim(dust_emis_method) == 'Zender_2003') then is_dust_emis_zender = .true. else @@ -141,7 +145,7 @@ end function is_dust_emis_leung logical function is_zender_soil_erod_from_land() ! is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CTSM - call check_if_initiatlized() + call check_if_initialized() if ( is_dust_emis_zender() )then if (trim(zender_soil_erod_source) == 'lnd') then is_zender_soil_erod_from_land = .true. @@ -157,7 +161,7 @@ end function is_zender_soil_erod_from_land logical function is_zender_soil_erod_from_atm() !is_zender_soil_erod_from_atm – Logical function, true if the Zender method is being used and soil erodibility is in CAM - call check_if_initiatlized() + call check_if_initialized() if ( is_dust_emis_zender() )then if ( trim(zender_soil_erod_source) == 'atm') then is_zender_soil_erod_from_atm = .true. @@ -172,14 +176,26 @@ end function is_zender_soil_erod_from_atm !=============================================================================== subroutine check_if_initialized() + integer :: s_logunit ! Output log unit + if ( dust_emis_initialized )then return else + call shr_log_getLogUnit(s_logunit) + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) call shr_sys_abort( 'ERROR: dust emission namelist has NOT been read in yet,' // & - ' shr_dust_emis_mod is NOT initialized '//errMsg(u_FILE_u, __LINE__) ) + ' shr_dust_emis_mod is NOT initialized ' ) end if end subroutine check_if_initialized + subroutine dust_emis_set_options( dust_emis_method_in, zender_soil_erod_source_in) + character(len=CS), intent(IN) :: dust_emis_method_in ! Dust emisison method to use: Zender_2003 or Leung_2023 + character(len=CS), intent(IN) :: zender_soil_erod_source_in ! if calculed in lnd or atm (only when Zender_2003 is used) + + dust_emis_method = dust_emis_method_in + zender_soil_erod_source = zender_soil_erod_source_in + end subroutine dust_emis_set_options + !=============================================================================== end module shr_dust_emis_mod From 408be0208ac85018e7b2269f65506647646294d2 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 30 Apr 2024 09:00:34 -0400 Subject: [PATCH 10/69] CAM%DEV changed to CAM70 --- cime_config/buildnml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index ff2553be7..09a0b618e 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -106,7 +106,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["COMP_OCN"] = case.get_value("COMP_OCN") config["COMP_ROF"] = case.get_value("COMP_ROF") config["COMP_WAV"] = case.get_value("COMP_WAV") - config["CAMDEV"] = "True" if "CAM%DEV" in case.get_value("COMPSET") else "False" + config["CAMDEV"] = "True" if "CAM70" in case.get_value("COMPSET") else "False" if ( ( @@ -146,10 +146,10 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if config["COMP_OCN"] == "docn" and "aqua" in case.get_value("DOCN_MODE"): nmlgen.set_value("aqua_planet", value=".true.") - # make sure that variable add_gusts is only set to true if compset includes cam_dev + # make sure that variable add_gusts is only set to true if compset includes cam7 physics add_gusts = literal_to_python_value(nmlgen.get_value("add_gusts"), type_="logical") if add_gusts: - expect("CAM%DEV" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM%DEV in compset {}".format(case.get_value("COMPSET"))) + expect("CAM70" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM70 in compset {}".format(case.get_value("COMPSET"))) # -------------------------------- # Overwrite: set component coupling frequencies From 8d3cd2627b9ea7072ec12472612f5c32c94691fc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Apr 2024 09:18:40 -0600 Subject: [PATCH 11/69] check_if_initiatlized to is_NOT_initialized Change check_if_initiatlized to logical function to help with unit testing. --- cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 index b14148a90..376f5dbc3 100644 --- a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -26,7 +26,7 @@ module shr_dust_emis_mod public :: dust_emis_set_options ! Set the namelist options directory not through the namelist ! private data members: (only public for unit testing) - public :: check_if_initialized ! Check if dust emission has been initialized + public :: is_NOT_initialized ! Check if dust emission has NOT been initialized ! PRIVATE DATA: character(len=CS) :: dust_emis_method = 'Zender_2003' ! Dust emisison method to use: Zender_2003 or Leung_2023 @@ -121,7 +121,7 @@ end subroutine shr_dust_emis_readnl logical function is_dust_emis_zender() ! is_dust_emis_zender – Logical function, true if the Zender 2003 scheme is being used - call check_if_initialized() + if ( is_NOT_initialized() ) return if (trim(dust_emis_method) == 'Zender_2003') then is_dust_emis_zender = .true. else @@ -133,7 +133,7 @@ end function is_dust_emis_zender logical function is_dust_emis_leung() ! is_dust_emis_leung – Logical function, true if the Leung 2023 scheme is being used - call check_if_initialized() + if ( is_NOT_initialized() ) return if (trim(dust_emis_method) == 'Leung_2023') then is_dust_emis_leung = .true. else @@ -145,7 +145,7 @@ end function is_dust_emis_leung logical function is_zender_soil_erod_from_land() ! is_zender_soil_erod_from_land – Logical function, true if the Zender method is being used and soil erodibility is in CTSM - call check_if_initialized() + if ( is_NOT_initialized() ) return if ( is_dust_emis_zender() )then if (trim(zender_soil_erod_source) == 'lnd') then is_zender_soil_erod_from_land = .true. @@ -161,7 +161,7 @@ end function is_zender_soil_erod_from_land logical function is_zender_soil_erod_from_atm() !is_zender_soil_erod_from_atm – Logical function, true if the Zender method is being used and soil erodibility is in CAM - call check_if_initialized() + if ( is_NOT_initialized() ) return if ( is_dust_emis_zender() )then if ( trim(zender_soil_erod_source) == 'atm') then is_zender_soil_erod_from_atm = .true. @@ -175,18 +175,23 @@ end function is_zender_soil_erod_from_atm !=============================================================================== - subroutine check_if_initialized() + logical function is_NOT_initialized() + ! Check if this is NOT initialized and return true if so (false if initialized) + ! Will abort with an error when using in the model + ! For unit testing will return the logical state integer :: s_logunit ! Output log unit if ( dust_emis_initialized )then + is_NOT_initialized = .false. return else + is_NOT_initialized = .true. call shr_log_getLogUnit(s_logunit) write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) call shr_sys_abort( 'ERROR: dust emission namelist has NOT been read in yet,' // & ' shr_dust_emis_mod is NOT initialized ' ) end if - end subroutine check_if_initialized + end function is_NOT_initialized subroutine dust_emis_set_options( dust_emis_method_in, zender_soil_erod_source_in) character(len=CS), intent(IN) :: dust_emis_method_in ! Dust emisison method to use: Zender_2003 or Leung_2023 From ecb6d45aa00a4960564ea963b00754fb4c3b7d2c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Apr 2024 11:04:02 -0600 Subject: [PATCH 12/69] Fix so unit test will PASS --- cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 index 376f5dbc3..54a914453 100644 --- a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -194,11 +194,12 @@ logical function is_NOT_initialized() end function is_NOT_initialized subroutine dust_emis_set_options( dust_emis_method_in, zender_soil_erod_source_in) - character(len=CS), intent(IN) :: dust_emis_method_in ! Dust emisison method to use: Zender_2003 or Leung_2023 - character(len=CS), intent(IN) :: zender_soil_erod_source_in ! if calculed in lnd or atm (only when Zender_2003 is used) + character(len=*), intent(IN) :: dust_emis_method_in ! Dust emisison method to use: Zender_2003 or Leung_2023 + character(len=*), intent(IN) :: zender_soil_erod_source_in ! if calculed in lnd or atm (only when Zender_2003 is used) dust_emis_method = dust_emis_method_in zender_soil_erod_source = zender_soil_erod_source_in + dust_emis_initialized = .true. end subroutine dust_emis_set_options !=============================================================================== From 0285eeb59605df44bc3abf38a61e8436361e7e8c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 1 May 2024 13:53:44 -0600 Subject: [PATCH 13/69] Spin off the option checker Make the checking of options it's own subroutine to help with unit-testing. --- cesm/nuopc_cap_share/shr_dust_emis_mod.F90 | 69 +++++++++++++--------- 1 file changed, 42 insertions(+), 27 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 index 54a914453..f70024835 100644 --- a/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_dust_emis_mod.F90 @@ -23,14 +23,15 @@ module shr_dust_emis_mod ! The following is only public for the sake of unit testing; it should not be called ! directly outside this module - public :: dust_emis_set_options ! Set the namelist options directory not through the namelist - - ! private data members: (only public for unit testing) + public :: dust_emis_set_options ! Set the namelist options directory not through the namelist public :: is_NOT_initialized ! Check if dust emission has NOT been initialized + ! private data members: + private :: check_options_finish_init ! Check that the options are correct and finish initialization + ! PRIVATE DATA: character(len=CS) :: dust_emis_method = 'Zender_2003' ! Dust emisison method to use: Zender_2003 or Leung_2023 - character(len=CS) :: zender_soil_erod_source = 'none' ! if calculed in lnd or atm (only when Zender_2003 is used) + character(len=CS) :: zender_soil_erod_source = 'none' ! if calculated in lnd or atm (only when Zender_2003 is used) logical :: dust_emis_initialized=.false. ! If dust emissions have been initiatlized yet or not character(len=*), parameter :: u_FILE_u = & @@ -95,28 +96,42 @@ subroutine shr_dust_emis_readnl(mpicom, NLFilename) call shr_mpi_bcast(dust_emis_method, mpicom) call shr_mpi_bcast(zender_soil_erod_source, mpicom) - ! Some error checking - if (trim(dust_emis_method) == 'Leung_2023') then - if ( trim(zender_soil_erod_source) /= 'none' )then - call shr_sys_abort(subName//"ERROR: zender_soil_erod_source should NOT be set, when dust_emis_method=Leung_2023 " & - //errMsg(u_FILE_u, __LINE__)) - end if - else if (trim(dust_emis_method) == 'Zender_2003') then - if ( (trim(zender_soil_erod_source) /= 'lnd') .and. (trim(zender_soil_erod_source) /= 'atm') )then - write(s_logunit,*) 'zender_soil_erod_source is NOT valid = ', trim(zender_soil_erod_source) - call shr_sys_abort(subName//"ERROR: zender_soil_erod_source can only be lnd or atm" & - //errMsg(u_FILE_u, __LINE__)) - end if - else - write(s_logunit,*) 'dust_emis_method not recognized = ', trim(dust_emis_method) - call shr_sys_abort(subName//"ERROR: dust_emis_method namelist item is not valid " & - //errMsg(u_FILE_u, __LINE__)) - end if - - dust_emis_initialized = .true. + call check_options_finish_init() end subroutine shr_dust_emis_readnl +!==================================================================================== + + subroutine check_options_finish_init() + ! Some error checking and mark initialization as finished + integer :: s_logunit ! Output log unit + character(*),parameter :: subName = '(check_options_finish_init) ' + + call shr_log_getLogUnit(s_logunit) + if (trim(dust_emis_method) == 'Leung_2023') then + if ( trim(zender_soil_erod_source) /= 'none' )then + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + call shr_sys_abort(subName//"ERROR: zender_soil_erod_source should NOT be set, when dust_emis_method=Leung_2023" ) + return + end if + else if (trim(dust_emis_method) == 'Zender_2003') then + if ( (trim(zender_soil_erod_source) /= 'lnd') .and. (trim(zender_soil_erod_source) /= 'atm') )then + write(s_logunit,*) 'zender_soil_erod_source is NOT valid = ', trim(zender_soil_erod_source) + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + call shr_sys_abort(subName//"ERROR: zender_soil_erod_source can only be lnd or atm" ) + return + end if + else + write(s_logunit,*) 'dust_emis_method not recognized = ', trim(dust_emis_method) + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + call shr_sys_abort(subName//"ERROR: dust_emis_method namelist item is not valid" ) + return + end if + + dust_emis_initialized = .true. + + end subroutine check_options_finish_init + !==================================================================================== logical function is_dust_emis_zender() @@ -187,7 +202,7 @@ logical function is_NOT_initialized() else is_NOT_initialized = .true. call shr_log_getLogUnit(s_logunit) - write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) + write(s_logunit,*) 'ERROR: '//errMsg(u_FILE_u, __LINE__) call shr_sys_abort( 'ERROR: dust emission namelist has NOT been read in yet,' // & ' shr_dust_emis_mod is NOT initialized ' ) end if @@ -197,9 +212,9 @@ subroutine dust_emis_set_options( dust_emis_method_in, zender_soil_erod_source_i character(len=*), intent(IN) :: dust_emis_method_in ! Dust emisison method to use: Zender_2003 or Leung_2023 character(len=*), intent(IN) :: zender_soil_erod_source_in ! if calculed in lnd or atm (only when Zender_2003 is used) - dust_emis_method = dust_emis_method_in - zender_soil_erod_source = zender_soil_erod_source_in - dust_emis_initialized = .true. + dust_emis_method = dust_emis_method_in + zender_soil_erod_source = zender_soil_erod_source_in + call check_options_finish_init() end subroutine dust_emis_set_options !=============================================================================== From 0577deb05f8997f736680023fcac0021ab1c9829 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 14 May 2024 08:43:03 -0600 Subject: [PATCH 14/69] update esmf build --- .github/workflows/srt.yml | 45 ++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 1044661ba..21af63350 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,7 +26,7 @@ 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.6.0 + ESMF_VERSION: v8.6.1 PARALLELIO_VERSION: pio2_6_2 CIME_MODEL: cesm CIME_DRIVER: nuopc @@ -64,13 +64,13 @@ jobs: run: pip install -r requirements.txt # use the latest cesm main - name: cesm checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ESCOMP/CESM path: cesm # this cmeps commit - name: cmeps checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: cesm/components/cmeps @@ -94,10 +94,11 @@ jobs: git submodule update --init cd ../components/cdeps git checkout main + git submodule update --init - name: Cache ESMF id: cache-esmf - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/ESMF key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF1 @@ -117,13 +118,13 @@ jobs: - name: Cache ParallelIO id: cache-ParallelIO - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/pio key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.parallelio - name: Cache inputdata id: cache-inputdata - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: $HOME/cesm/inputdata key: inputdata @@ -148,18 +149,22 @@ jobs: enable_fortran: True install_prefix: /home/runner/pio - - name: Build ESMF - if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + - name: Install ESMF + uses: esmf-org/install-esmf-action@v1 + env: + ESMF_COMPILER: gfortran + ESMF_BOPT: g + ESMF_COMM: openmpi + ESMF_NETCDF: nc-config + ESMF_PNETCDF: pnetcdf-config + ESMF_INSTALL_PREFIX: ${GITHUB_WORKSPACE}/ESMF + ESMF_PIO: external + ESMF_PIO_INCLUDE: ${GITHUB_WORKSPACE}/pio/include + ESMF_PIO_LIBPATH: ${GITHUB_WORKSPACE}/pio/lib with: - esmf_version: ${{ env.ESMF_VERSION }} - esmf_bopt: g - esmf_comm: openmpi - install_prefix: ~/ESMF - netcdf_c_path: /usr - netcdf_fortran_path: /usr - pnetcdf_path: /usr - parallelio_path: ~/pio + version: ${{ env.ESMF_VERSION }} + esmpy: false + cache: true - name: PREP for scripts regression test @@ -190,6 +195,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 From 359513d939b488d4f22f6c60d6ee0529032489e2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 14 May 2024 08:55:29 -0600 Subject: [PATCH 15/69] fix pio path in github srt --- .github/workflows/srt.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 21af63350..9a2ab750b 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -120,7 +120,7 @@ jobs: id: cache-ParallelIO uses: actions/cache@v4 with: - path: ~/pio + path: ${GITHUB_WORKSPACE}/pio key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.parallelio - name: Cache inputdata id: cache-inputdata @@ -147,7 +147,7 @@ jobs: with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True - install_prefix: /home/runner/pio + install_prefix: ${GITHUB_WORKSPACE}/pio - name: Install ESMF uses: esmf-org/install-esmf-action@v1 @@ -174,8 +174,8 @@ jobs: 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 + export PIO_INCDIR=$GITHUB_WORKSPACE/pio/include + export PIO_LIBDIR=$GITHUB_WORKSPACE/pio/lib export PIO_VERSION_MAJOR=2 export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf" export NETCDF_PATH=/usr From b5165bbb9bb4d3f1a39008b7ab9e2444834029c8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 14 May 2024 09:39:38 -0600 Subject: [PATCH 16/69] working on srt --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 9a2ab750b..01dfd7d50 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -181,7 +181,7 @@ jobs: export NETCDF_PATH=/usr export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH - export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk + export ESMFMKFILE=$GITHUB_WORKSPACE/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake set(NetCDF_Fortran_INCLUDE_DIR /usr/include) set(NetCDF_Fortran_LIBRARY /usr/lib/x86_64-gnu-Linux/libnetcdff.so) From 91213a0c26c58d5f132b1c0e8ae2ad9182362da8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 14 May 2024 13:36:25 -0600 Subject: [PATCH 17/69] more workflow updates --- .github/workflows/extbuild.yml | 14 +++++++------- .github/workflows/srt.yml | 31 +++---------------------------- 2 files changed, 10 insertions(+), 35 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 0614d5acb..a558fa57a 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -20,13 +20,13 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.6.0 + ESMF_VERSION: v8.6.1 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.1 PIO_VERSION: pio2_6_2 - CDEPS_VERSION: cdeps1.0.26 + CDEPS_VERSION: cdeps1.0.35 steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build # it will be used instead - id: load-env @@ -40,13 +40,13 @@ jobs: sudo apt-get install pnetcdf-bin libpnetcdf-dev sudo apt-get install autotools-dev autoconf - id: cache-esmf - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/ESMF key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - name: Cache ParallelIO id: cache-ParallelIO - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/pio key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio @@ -71,13 +71,13 @@ jobs: parallelio_path: $HOME/pio - name: Cache CDEPS id: cache-cdeps - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: $HOME/cdeps key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps - name: checkout CDEPS - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ESCOMP/CDEPS path: cdeps-src diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 01dfd7d50..63121dd7a 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -101,20 +101,7 @@ jobs: uses: actions/cache@v4 with: path: ~/ESMF - key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF1 - # - name: cache pnetcdf - # id: cache-pnetcdf - # uses: actions/cache@v3 - # with: - # path: ~/pnetcdf - # key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - - # - name: Cache netcdf-fortran - # id: cache-netcdf-fortran - # uses: actions/cache@v3 - # with: - # path: ~/netcdf-fortran - # key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran + key: ${{ runner.os }}-${{ env.ESMF_VERSION }} - name: Cache ParallelIO id: cache-ParallelIO @@ -122,25 +109,14 @@ jobs: with: path: ${GITHUB_WORKSPACE}/pio key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.parallelio + - name: Cache inputdata id: cache-inputdata uses: actions/cache@v4 with: path: $HOME/cesm/inputdata key: inputdata - # - name: Build PNetCDF - # if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - # uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 - # with: - # pnetcdf_version: ${{ env.PNETCDF_VERSION }} - # install_prefix: $HOME/pnetcdf - # - name: Build NetCDF Fortran - # if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - # uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 - # with: - # netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} - # install_prefix: $HOME/netcdf-fortran - # netcdf_c_path: /usr + - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 @@ -181,7 +157,6 @@ jobs: export NETCDF_PATH=/usr export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH - export ESMFMKFILE=$GITHUB_WORKSPACE/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake set(NetCDF_Fortran_INCLUDE_DIR /usr/include) set(NetCDF_Fortran_LIBRARY /usr/lib/x86_64-gnu-Linux/libnetcdff.so) From 6a522585e6b525ae8d2b75f6707453090890df57 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 15 May 2024 10:21:56 -0600 Subject: [PATCH 18/69] work on ext build --- .github/workflows/extbuild.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index a558fa57a..c5cce2288 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -89,12 +89,11 @@ jobs: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio src_root: ${GITHUB_WORKSPACE}/cdeps-src - cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ + cmake_flags: " -Wno-dev -DDISABLE_FOX=ON -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" - name: Build CMEPS run: | - export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk export PIO=$HOME/pio mkdir build-cmeps pushd build-cmeps From e0007c0de1133082af91914b8825463de268ea28 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 15 May 2024 10:49:37 -0600 Subject: [PATCH 19/69] case error correction --- .github/workflows/extbuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index c5cce2288..3fbe99ab0 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -89,7 +89,7 @@ jobs: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio src_root: ${GITHUB_WORKSPACE}/cdeps-src - cmake_flags: " -Wno-dev -DDISABLE_FOX=ON -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ + cmake_flags: " -Wno-dev -DDISABLE_FoX=ON -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" - name: Build CMEPS From 85f01535581aab492448df43ab7fab0a46d833aa Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 15 May 2024 11:49:31 -0600 Subject: [PATCH 20/69] try this for cdeps build --- .github/workflows/extbuild.yml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 3fbe99ab0..cb353dd30 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -73,7 +73,7 @@ jobs: id: cache-cdeps uses: actions/cache@v4 with: - path: $HOME/cdeps + path: cdeps-src key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps - name: checkout CDEPS @@ -82,6 +82,10 @@ jobs: repository: ESCOMP/CDEPS path: cdeps-src ref: ${{ env.CDEPS_VERSION }} + - name: get genf90 + run: | + cd cdeps-src + git submodule update --init - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 From e10beac899f940778537f3a52c57f2bc85d7e490 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 15 May 2024 15:11:32 -0600 Subject: [PATCH 21/69] more github workflow work --- .github/workflows/extbuild.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index cb353dd30..7f9b159bc 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -24,7 +24,7 @@ jobs: PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.1 PIO_VERSION: pio2_6_2 - CDEPS_VERSION: cdeps1.0.35 + CDEPS_VERSION: cdeps1.0.36 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build @@ -99,6 +99,7 @@ jobs: - name: Build CMEPS run: | export PIO=$HOME/pio + export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk mkdir build-cmeps pushd build-cmeps cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument -I /home/runner/work/CMEPS/CMEPS/build-cdeps/share" ../ From 522dd60d382d0e2e76012f617a611dc0d0e78fbc Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 15 May 2024 16:41:04 -0600 Subject: [PATCH 22/69] clean up compiler warnings --- mediator/med_phases_prep_glc_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4a1df0eea..8d8685f4f 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -523,7 +523,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) logical :: isPresent, isSet logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' - integer :: k,cnt + !--------------------------------------- call t_startf('MED:'//subname) @@ -1255,7 +1255,7 @@ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskVa integer , intent(out) :: rc ! local variables - integer :: no, ni, i, j + integer :: no, ni real(ESMF_KIND_R8) :: renorm !--------------------------------------------------------------- From 158c82f58940af176db38e21262c6aa668cbd229 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 16 May 2024 09:50:58 -0600 Subject: [PATCH 23/69] remove unused shr_sys_abort --- mediator/med_phases_prep_glc_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 8d8685f4f..fb46bb8a4 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -45,8 +45,6 @@ module med_phases_prep_glc_mod use glc_elevclass_mod , only : glc_get_fractional_icecov use perf_mod , only : t_startf, t_stopf - use shr_sys_mod, only : shr_sys_abort - implicit none private From 978fcaabcce86c7873a25b879a3570c6a473ec30 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 16 May 2024 11:01:06 -0600 Subject: [PATCH 24/69] fix cdeps cache issue --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 7f9b159bc..e1c69cd7b 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -73,8 +73,8 @@ jobs: id: cache-cdeps uses: actions/cache@v4 with: - path: cdeps-src - key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps + path: /homme/runner/work/CMEPS/CMEPS/build-cdeps + key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps1 - name: checkout CDEPS uses: actions/checkout@v4 From 7715f0b7b22eef1c8502f6d361acb023276300e2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 16 May 2024 11:05:19 -0600 Subject: [PATCH 25/69] renames ww3dev to ww3 --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index ff2553be7..13ebe5eb1 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -127,7 +127,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value("RUN_TYPE") == "branch": config["run_type"] = "branch" - config['wav_ice_coupling'] = config['COMP_WAV'] == 'ww3dev' and config['COMP_ICE'] == 'cice' + config['wav_ice_coupling'] = 'ww3' in config['COMP_WAV'] and config['COMP_ICE'] == 'cice' # ---------------------------------------------------- # Initialize namelist defaults From 23a52b29ff0ef49a2081aad6613801fc1b57652e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 17 May 2024 10:31:13 -0600 Subject: [PATCH 26/69] avoid integer overflow by skipping mediator in restart loop --- mediator/med.F90 | 6 ++++-- mediator/med_phases_restart_mod.F90 | 7 ++++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index dc0f68cf2..4fdbb06a6 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -2122,7 +2122,7 @@ subroutine DataInitialize(gcomp, rc) do n1 = 1,ncomps if (maintask) then write(logunit,*) - write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) + write(logunit,'(a,2L2)') trim(subname)//" "//trim(compname(n1)), is_local%wrap%comp_present(n1), ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) end if if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call State_GetScalar(scalar_value=real_nx, & @@ -2150,12 +2150,14 @@ subroutine DataInitialize(gcomp, rc) end if is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) + endif + if (is_local%wrap%comp_present(n1)) then write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) - end if + endif end do if (maintask) write(logunit,*) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 1bbbb0fbf..6bbdb6b75 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -342,13 +342,14 @@ subroutine med_phases_restart_write(gcomp, rc) call med_io_write(io_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,ncomps + do n = 2,ncomps if (is_local%wrap%comp_present(n)) then - nx = is_local%wrap%nx(n) - ny = is_local%wrap%ny(n) if (is_local%wrap%ntile(n) > 0) then nx = is_local%wrap%ntile(n)*is_local%wrap%ny(n)*is_local%wrap%nx(n) ny = 1 + else + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) end if ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then From 2d837b16af326b09ff4018daab4de84f4deff7ec Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 20 May 2024 09:15:18 -0400 Subject: [PATCH 27/69] update data type for use_2m_diagnostics_calculated_by_lake_model from integer to logical (#119) --- ufs/ccpp/data/MED_typedefs.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 772358535..c14616a6a 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -862,7 +862,7 @@ long_name = model 2m diagnostics use the temperature and humidity calculated by the lake model units = flag dimensions = () - type = integer + type = logical [lkm] standard_name = control_for_lake_model_execution_method long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst From 8fa0185b705c787f3ca1ec74df8aa9926e0155dc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 20 May 2024 12:58:34 -0600 Subject: [PATCH 28/69] changes for trigrid --- mediator/esmFldsExchange_cesm_mod.F90 | 127 ++++++++++++++++++++++---- 1 file changed, 109 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 47d0ae1a7..4b9e44374 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -57,6 +57,8 @@ module esmFldsExchange_cesm_mod logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND + logical :: samegrid_al ! true=>atm and lnd are on the same grid + character(*), parameter :: u_FILE_u = & __FILE__ @@ -98,6 +100,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CL) :: cvalue logical :: wav_coupling_to_cice logical :: ocn2glc_coupling + character(len=CL) :: atm_mesh + character(len=CL) :: lnd_mesh + character(len=CS) :: mrg_fracname_lnd character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- @@ -220,6 +225,17 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(atm_mesh) == trim(lnd_mesh)) then + samegrid_al = .true. + else + samegrid_al = .false. + end if + ! write diagnostic output if (maintask) then write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a @@ -1153,8 +1169,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_taux', & - mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then call addmap_from(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1180,8 +1201,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_tauy', & - mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then call addmap_from(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1207,8 +1233,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_lat', & - mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then call addmap_from(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1234,8 +1265,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_sen', & - mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then call addmap_from(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1261,8 +1297,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then call addmap_from(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1288,8 +1329,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_lwup', & - mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then call addmap_from(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1316,8 +1362,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then call addmap_from(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1532,8 +1583,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- - ! CARMA fields (volumetric soil water) + ! atm atm: CARMA fields (volumetric soil water) from land !----------------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(complnd, 'Sl_soilw') @@ -1545,6 +1597,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if + ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- @@ -1559,6 +1612,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') end if end if + !----------------------------------------------------------------------------- ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- @@ -1569,10 +1623,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm, 'Fall_voc', & - mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if end if + !----------------------------------------------------------------------------- ! to atm: fire emissions fluxes from land !----------------------------------------------------------------------------- @@ -1584,8 +1644,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + if (samegrid_al) then + mrg_fracname_lnd='lfrac' + else + mrg_fracname_lnd='lfrin' + end if call addmrg_to(compatm, 'Fall_fire', & - mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) end if end if ! 'wild fire plume height' @@ -1599,6 +1664,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if + !----------------------------------------------------------------------------- ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- @@ -3099,9 +3165,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofsur', & - mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3114,9 +3185,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofi', & - mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3129,9 +3205,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrac', lnd2rof_map) + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofgwl', & - mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3145,8 +3226,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_rofsub', & - mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if @@ -3160,8 +3246,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) + if (samegrid_al) then + mrg_fracname_lnd = 'lfrac' + else + mrg_fracname_lnd = 'lfrin' + endif call addmrg_to(comprof, 'Flrl_irrig', & - mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) end if end if From b3c1aa333cf3bae031e10bf62b25ec2a53eaae3b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 27 May 2024 03:14:40 -0600 Subject: [PATCH 29/69] move glc2ocn with glc2rof --- mediator/esmFldsExchange_cesm_mod.F90 | 96 ++++++++++----------------- mediator/fd_cesm.yaml | 32 ++++----- mediator/med_diag_mod.F90 | 4 +- mediator/med_internalstate_mod.F90 | 6 +- mediator/med_phases_post_glc_mod.F90 | 23 +++---- mediator/med_phases_prep_rof_mod.F90 | 41 ++++++++---- 6 files changed, 96 insertions(+), 106 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 47d0ae1a7..5fd4b5042 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -29,8 +29,6 @@ module esmFldsExchange_cesm_mod ! currently required mapping files character(len=CX) :: glc2ice_rmap ='unset' - character(len=CX) :: glc2ocn_liq_rmap ='unset' - character(len=CX) :: glc2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_fmap ='unset' character(len=CX) :: rof2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_liq_rmap ='unset' @@ -76,7 +74,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq + use med_internalstate_mod , only : map_rof2ocn_ice, map_rof2ocn_liq use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux @@ -152,20 +150,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_map', value=atm2ocn_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap) - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap) call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_fmapname = '// trim(rof2ocn_fmap) - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) @@ -2187,7 +2177,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if !----------------------------- - ! to ocn: liquid runoff from rof and glc components + ! to ocn: liquid runoff from rof components ! to ocn: frozen runoff flux from rof and glc components ! to ocn: waterflux back to ocn due to flooding from rof !----------------------------- @@ -2196,15 +2186,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that Flrr_flood below needs to be added to ! fldlistFr(comprof) in order to be mapped correctly but the ocean ! does not receive it so it is advertised but it will! not be connected - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofl') - end do call addfld_from(comprof, 'Forr_rofl') call addfld_to(compocn, 'Foxx_rofl') call addfld_to(compocn, 'Flrr_flood') - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofi') - end do call addfld_from(comprof, 'Forr_rofi') call addfld_to(compocn, 'Foxx_rofi') else @@ -2223,14 +2207,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if - ! liquid from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofl', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg_to(compocn, 'Foxx_rofl', mrg_from=compglc(ns), mrg_fld='Fogg_rofl', mrg_type='sum') - end if - end do end if if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then ! ice from river to ocean @@ -2242,30 +2218,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if - ! ice from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofi', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg_to(compocn, 'Foxx_rofi', mrg_from=compglc(ns), mrg_fld='Fogg_rofi', mrg_type='sum') - end if - end do end if end if if (flds_wiso) then if (phase == 'advertise') then - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofl_wiso') - end do call addfld_from(comprof, 'Forr_rofl_wiso') - call addfld_to(compocn, 'Foxx_rofl_wiso') - call addfld_to(compocn, 'Flrr_flood_wiso') - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Fogg_rofi_wiso') - end do call addfld_from(comprof, 'Forr_rofi_wiso') + call addfld_to(compocn, 'Foxx_rofl_wiso') call addfld_to(compocn, 'Foxx_rofi_wiso') + call addfld_to(compocn, 'Flrr_flood_wiso') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , rc=rc)) then ! liquid from river and possibly flood from river to ocean @@ -2284,15 +2246,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') end if end if - ! liquid from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofl_wiso' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofl_wiso', compocn, map_glc2ocn_liq, 'one' , glc2ocn_liq_rmap) - call addmrg_to(compocn, 'Foxx_rofl_wiso', & - mrg_from=compglc(ns), mrg_fld='Fogg_rofl_wiso', mrg_type='sum') - end if - end do end if if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi_wiso' , rc=rc)) then ! ice from river to ocean @@ -2304,15 +2257,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if call addmrg_to(compocn, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if - ! ice from glc to ocean - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fogg_rofi_wiso' , rc=rc)) then - ! TODO: this custom map needs to be different for every ice sheet - how will this be handled? - call addmap_from(compglc(ns), 'Fogg_rofi_wiso', compocn, map_glc2ocn_ice, 'one', glc2ocn_ice_rmap) - call addmrg_to(compocn, 'Foxx_rofi_wiso', & - mrg_from=compglc(ns), mrg_fld='Fogg_rofi_wiso', mrg_type='sum') - end if - end do end if end if end if @@ -3090,6 +3034,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! FIELDS TO RIVER (comprof) !===================================================================== + ! --------------------------------------------------------------------- + ! to rof: liquid and ice from glc + ! --------------------------------------------------------------------- + ! Note: we are assuming that the rof mesh has a mask of one everywhere + ! TODO: should the following have fractional mapping? + do ns = 1, is_local%wrap%num_icesheets + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl', comprof, mapconsd, 'one' , 'unset') + ! Custom merge in med_phases_prep_rof + end if + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi', comprof, mapconsd, 'one', 'unset') + ! Custom merge in med_phases_prep_rof + end if + end do + + ! --------------------------------------------------------------------- + ! to rof: liquid and ice from glc + ! --------------------------------------------------------------------- + do ns = 1, is_local%wrap%num_icesheets + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl_wiso' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl_wiso', comprof, mapconsd, 'one' , 'unset') + ! TODO: implement custom merge + end if + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi_wiso' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi_wiso', comprof, mapconsd, 'one', 'unset') + ! TODO: implement custom merge + end if + end do + ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid surface) ! --------------------------------------------------------------------- @@ -3206,7 +3180,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- ! to glc: from ocn !----------------------------- - if (ocn2glc_coupling) then + if (is_local%wrap%ocn2glc_coupling) then if (phase == 'advertise') then call addfld_from(compocn, 'So_t_depth') call addfld_from(compocn, 'So_s_depth') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 88b4a5158..a15bd2fc4 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -585,6 +585,22 @@ # Note that the fields sent from glc->med do NOT have elevation classes, # but the fields from med->lnd are broken into multiple elevation classes # + - standard_name: Fgrg_rofi + canonical_units: kg m-2 s-1 + description: glc import tomed - glacier frozen_runoff_flux_to_ocean + # + - standard_name: Fgrg_rofi_wiso + canonical_units: kg m-2 s-1 + description: glc import to med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO + # + - standard_name: Fgrg_rofl + canonical_units: kg m-2 s-1 + description: glc import to med - glacier liquid runoff flux to ocean + # + - standard_name: Fgrg_rofl_wiso + canonical_units: kg m-2 s-1 + description: glc import to med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO + # - standard_name: Figg_rofi canonical_units: kg m-2 s-1 description: glc import to med - glc frozen runoff_iceberg flux to ice @@ -635,22 +651,6 @@ canonical_units: m description: glc export from med (elevation classes 1->glc_nec) # - - standard_name: Fogg_rofi - canonical_units: kg m-2 s-1 - description: glc export from med - glacier_frozen_runoff_flux_to_ocean - # - - standard_name: Fogg_rofi_wiso - canonical_units: kg m-2 s-1 - description: glc export from med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO - # - - standard_name: Fogg_rofl - canonical_units: kg m-2 s-1 - description: glc export from med - glacier liquid runoff flux to ocean - # - - standard_name: Fogg_rofl_wiso - canonical_units: kg m-2 s-1 - description: glc export from med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO - # #----------------------------------- # section: ice import to med #----------------------------------- diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8ea6651ea..473c23e6e 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -1352,9 +1352,9 @@ subroutine med_phases_diag_glc( gcomp, rc) do ns = 1,is_local%wrap%num_icesheets areas => is_local%wrap%mesh_info(compglc(ns))%areas - call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fogg_rofl', f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofl', f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fogg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Figg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index fb35645db..21b480a4d 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -451,9 +451,6 @@ subroutine med_internalstate_coupling(gcomp, rc) med_coupling_allowed(compice,compocn) = .true. med_coupling_allowed(comprof,compocn) = .true. med_coupling_allowed(compwav,compocn) = .true. - do ns = 1,is_local%wrap%num_icesheets - med_coupling_allowed(compglc(ns),compocn) = .true. - end do ! to ice med_coupling_allowed(compatm,compice) = .true. @@ -466,6 +463,9 @@ subroutine med_internalstate_coupling(gcomp, rc) ! to river med_coupling_allowed(complnd,comprof) = .true. + do ns = 1,is_local%wrap%num_icesheets + med_coupling_allowed(compglc(ns),comprof) = .true. + end do ! to wave med_coupling_allowed(compatm,compwav) = .true. diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index ac32ae8b8..139330d76 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -68,7 +68,7 @@ module med_phases_post_glc_mod logical :: cism_evolve = .false. logical :: glc2lnd_coupling = .false. - logical :: glc2ocn_coupling = .false. + logical :: glc2rof_coupling = .false. logical :: glc2ice_coupling = .false. character(*) , parameter :: u_FILE_u = & @@ -120,8 +120,8 @@ subroutine med_phases_post_glc(gcomp, rc) end do ! determine if there will be any glc to ocn coupling do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then - glc2ocn_coupling = .true. + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + glc2rof_coupling = .true. exit end if end do @@ -134,7 +134,7 @@ subroutine med_phases_post_glc(gcomp, rc) end do if (maintask) then write(logunit,'(a,L1)') trim(subname) // 'glc2lnd_coupling is ',glc2lnd_coupling - write(logunit,'(a,L1)') trim(subname) // 'glc2ocn_coupling is ',glc2ocn_coupling + write(logunit,'(a,L1)') trim(subname) // 'glc2rof_coupling is ',glc2rof_coupling write(logunit,'(a,L1)') trim(subname) // 'glc2ice_coupling is ',glc2ice_coupling end if @@ -152,19 +152,18 @@ subroutine med_phases_post_glc(gcomp, rc) end if !--------------------------------------- - ! glc->ocn mapping - ! merging with rof->ocn fields is done in med_phases_prep_ocn + ! glc->rof mapping !--------------------------------------- - if (glc2ocn_coupling) then + if (glc2rof_coupling) then do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),compocn)) then + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then call med_map_field_packed( & FBSrc=is_local%wrap%FBImp(compglc(ns),compglc(ns)), & - FBDst=is_local%wrap%FBImp(compglc(ns),compocn), & + FBDst=is_local%wrap%FBImp(compglc(ns),comprof), & FBFracSrc=is_local%wrap%FBFrac(compglc(ns)), & - field_normOne=is_local%wrap%field_normOne(compglc(ns),compocn,:), & - packed_data=is_local%wrap%packed_data(compglc(ns),compocn,:), & - routehandles=is_local%wrap%RH(compglc(ns),compocn,:), rc=rc) + field_normOne=is_local%wrap%field_normOne(compglc(ns),comprof,:), & + packed_data=is_local%wrap%packed_data(compglc(ns),comprof,:), & + routehandles=is_local%wrap%RH(compglc(ns),comprof,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 55b2dae82..d2fedcdcf 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,7 +12,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy + use med_internalstate_mod , only : complnd, compglc, comprof, mapconsf, mapfcopy use med_internalstate_mod , only : InternalState, maintask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero @@ -61,6 +61,8 @@ module med_phases_prep_rof_mod type(ESMF_FieldBundle), public :: FBlndAccum2rof_l type(ESMF_FieldBundle), public :: FBlndAccum2rof_r + character(len=9) :: fldnames_fr_glc(2) = (/'Frgg_rofl', 'Frgg_rofi') + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -276,11 +278,11 @@ subroutine med_phases_prep_rof(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n + integer :: n,ns,nf integer :: count logical :: exists - real(r8), pointer :: dataptr(:) - real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr_in(:) + real(r8), pointer :: dataptr_out(:) type(ESMF_Field) :: lfield type(med_fldList_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' @@ -319,12 +321,12 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) + call field_getdata1d(lfield, dataptr_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (count == 0) then - dataptr1d(:) = czero + dataptr_out(:) = czero else - dataptr1d(:) = dataptr1d(:) / real(count, r8) + dataptr_out(:) = dataptr_out(:) / real(count, r8) end if end if end do @@ -359,12 +361,12 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! This will ensure that no irrig is sent from the land - call fldbun_getdata1d(FBlndAccum2rof_r, irrig_flux_field, dataptr, rc) - dataptr(:) = czero + call fldbun_getdata1d(FBlndAccum2rof_r, irrig_flux_field, dataptr_out, rc) + dataptr_out(:) = czero end if !--------------------------------------- - ! auto merges to create FBExp(comprof) - assumes that all data is coming from FBlndAccum2rof_r + ! create FBExp(comprof) !--------------------------------------- if (dbug_flag > 1) then @@ -373,10 +375,25 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! data coming from FBlndAccum2rof_r call med_merge_auto(compsrc=complnd, FBout=is_local%wrap%FBExp(comprof), & FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! custom merge for glc->rof + ! glc->rof is mapped in med_phases_post_glc + do ns = 1,is_local%wrap%num_icesheets + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + do nf = 1,size(fldnames_fr_glc) + call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & + trim(fldnames_fr_glc(nf)), dataptr_out, rc) + call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & + trim(fldnames_fr_glc(nf)), dataptr_in , rc) + dataptr_out(:) = dataptr_in(): + end do + end if + end do + ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -402,9 +419,9 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) + call field_getdata1d(lfield, dataptr_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = czero + dataptr_out(:) = czero end if end do From 4a644c05a20c56b42d274535b80461222831d5f2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 29 May 2024 02:17:34 -0600 Subject: [PATCH 30/69] updates for cism2mosart coupling --- mediator/esmFldsExchange_cesm_mod.F90 | 48 +++++++++++++++++---------- mediator/med_phases_post_glc_mod.F90 | 1 + mediator/med_phases_prep_rof_mod.F90 | 14 +++++--- 3 files changed, 42 insertions(+), 21 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 5fd4b5042..af552dc2d 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3037,30 +3037,44 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to rof: liquid and ice from glc ! --------------------------------------------------------------------- - ! Note: we are assuming that the rof mesh has a mask of one everywhere - ! TODO: should the following have fractional mapping? do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofl', comprof, mapconsd, 'one' , 'unset') - ! Custom merge in med_phases_prep_rof - end if - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofi', comprof, mapconsd, 'one', 'unset') - ! Custom merge in med_phases_prep_rof + if (phase == 'advertise') then + call addfld_from(compglc(ns), 'Fgrg_rofl') + call addfld_from(compglc(ns), 'Fgrg_rofi') + call addfld_to(comprof, 'Fgrg_rofl') + call addfld_to(comprof, 'Fgrg_rofi') + else + ! Note: we are assuming that the rof mesh has a mask of one everywhere + ! TODO: should the following have fractional mapping? + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl', comprof, mapconsd, 'one' , 'unset') + ! Custom merge in med_phases_prep_rof + end if + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi', comprof, mapconsd, 'one', 'unset') + ! Custom merge in med_phases_prep_rof + end if end if end do ! --------------------------------------------------------------------- - ! to rof: liquid and ice from glc + ! to rof: liquid and ice from glc water isoptopes ! --------------------------------------------------------------------- do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl_wiso' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofl_wiso', comprof, mapconsd, 'one' , 'unset') - ! TODO: implement custom merge - end if - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi_wiso' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofi_wiso', comprof, mapconsd, 'one', 'unset') - ! TODO: implement custom merge + if (phase == 'advertise') then + call addfld_from(compglc(ns), 'Fgrg_rofl_wiso') + call addfld_from(compglc(ns), 'Fgrg_rofi_wiso') + call addfld_to(comprof, 'Fgrg_rofl_wiso') + call addfld_to(comprof, 'Fgrg_rofi_wiso') + else + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl_wiso' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl_wiso', comprof, mapconsd, 'one' , 'unset') + ! TODO: implement custom merge + end if + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi_wiso' , rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi_wiso', comprof, mapconsd, 'one', 'unset') + ! TODO: implement custom merge + end if end if end do diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 139330d76..959f2873b 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -154,6 +154,7 @@ subroutine med_phases_post_glc(gcomp, rc) !--------------------------------------- ! glc->rof mapping !--------------------------------------- + if (glc2rof_coupling) then do ns = 1,is_local%wrap%num_icesheets if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index d2fedcdcf..f49f68d5f 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -61,7 +61,7 @@ module med_phases_prep_rof_mod type(ESMF_FieldBundle), public :: FBlndAccum2rof_l type(ESMF_FieldBundle), public :: FBlndAccum2rof_r - character(len=9) :: fldnames_fr_glc(2) = (/'Frgg_rofl', 'Frgg_rofi') + character(len=9) :: fldnames_fr_glc(2) = (/'Fgrg_rofl', 'Fgrg_rofi'/) character(*) , parameter :: u_FILE_u = & __FILE__ @@ -386,14 +386,20 @@ subroutine med_phases_prep_rof(gcomp, rc) if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then do nf = 1,size(fldnames_fr_glc) call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & - trim(fldnames_fr_glc(nf)), dataptr_out, rc) + trim(fldnames_fr_glc(nf)), dataptr_in, rc) call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & - trim(fldnames_fr_glc(nf)), dataptr_in , rc) - dataptr_out(:) = dataptr_in(): + trim(fldnames_fr_glc(nf)), dataptr_out , rc) + ! Determine export data + if (ns == 1) then + dataptr_out(:) = dataptr_in(:) + else + dataptr_out(:) = dataptr_out(:) + dataptr_in(:) + end if end do end if end do + ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From a90affa284d26c082d320545fd240d0f558074da Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 30 May 2024 04:30:58 -0600 Subject: [PATCH 31/69] fixed ice discharge --- mediator/esmFldsExchange_cesm_mod.F90 | 52 ++++++++++++--------------- mediator/med_internalstate_mod.F90 | 2 ++ mediator/med_phases_prep_atm_mod.F90 | 11 ++++-- mediator/med_phases_prep_glc_mod.F90 | 18 +++++++--- mediator/med_phases_prep_rof_mod.F90 | 4 +-- 5 files changed, 48 insertions(+), 39 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4b9e44374..e05518b62 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -20,7 +20,7 @@ module esmFldsExchange_cesm_mod !-------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : logunit, maintask + use med_internalstate_mod , only : logunit, maintask, samegrid_atmlnd implicit none public @@ -45,7 +45,6 @@ module esmFldsExchange_cesm_mod character(len=CX) :: ice2atm_map='unset' character(len=CX) :: ocn2atm_map='unset' character(len=CX) :: lnd2atm_map='unset' - character(len=CX) :: lnd2rof_map='unset' character(len=CX) :: rof2lnd_map='unset' character(len=CX) :: atm2wav_map='unset' @@ -57,8 +56,6 @@ module esmFldsExchange_cesm_mod logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND - logical :: samegrid_al ! true=>atm and lnd are on the same grid - character(*), parameter :: u_FILE_u = & __FILE__ @@ -178,11 +175,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) - ! mapping to rof - call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) - ! mapping to wav call NUOPC_CompAttributeGet(gcomp, name='atm2wav_map', value=atm2wav_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -231,9 +223,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(atm_mesh) == trim(lnd_mesh)) then - samegrid_al = .true. + samegrid_atmlnd = .true. else - samegrid_al = .false. + samegrid_atmlnd = .false. end if ! write diagnostic output @@ -1169,7 +1161,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1201,7 +1193,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1233,7 +1225,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1265,7 +1257,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1297,7 +1289,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1329,7 +1321,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1362,7 +1354,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1623,7 +1615,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -1644,7 +1636,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) - if (samegrid_al) then + if (samegrid_atmlnd) then mrg_fracname_lnd='lfrac' else mrg_fracname_lnd='lfrin' @@ -3165,8 +3157,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3185,8 +3177,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3205,8 +3197,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3225,8 +3217,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' @@ -3245,8 +3237,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', lnd2rof_map) - if (samegrid_al) then + call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', 'unset') + if (samegrid_atmlnd) then mrg_fracname_lnd = 'lfrac' else mrg_fracname_lnd = 'lfrin' diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index fb35645db..a0fd7d959 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -115,6 +115,8 @@ module med_internalstate_mod real(r8), pointer :: lons(:) => null() end type mesh_info_type + logical, public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + ! private internal state to keep instance data type InternalStateStruct diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b9e7582e1..f8744800e 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -17,7 +17,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -183,8 +183,13 @@ subroutine med_phases_prep_atm(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4a1df0eea..cb7acea1b 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -814,8 +814,13 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get land fraction field on land mesh - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_l, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield_lfrac_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield_lfrac_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) do ns = 1,is_local%wrap%num_icesheets @@ -1149,8 +1154,13 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! determine fraction on land grid, lfrac(:) - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + else + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrin', lfrac, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end if ! get qice_l_ec call fldbun_getdata2d(FBlndAccum2glc_l, trim(qice_fieldname)//'_elev', qice_l_ec, rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 55b2dae82..8aeba272c 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -13,7 +13,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -619,7 +619,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_lnd, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrin', field=field_lfrac_lnd, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_map_field_normalized( & From b34de125d6f92119d0288d3d9524520e7f9be4af Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 31 May 2024 04:54:17 -0600 Subject: [PATCH 32/69] fixes for commit --- mediator/esmFldsExchange_cesm_mod.F90 | 249 +++++++++----------------- mediator/med_diag_mod.F90 | 13 +- mediator/med_fraction_mod.F90 | 163 ++++++++++++----- mediator/med_internalstate_mod.F90 | 48 ++++- mediator/med_phases_prep_glc_mod.F90 | 30 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 +- 6 files changed, 265 insertions(+), 242 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index e05518b62..a4280c5a1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -21,6 +21,9 @@ module esmFldsExchange_cesm_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : logunit, maintask, samegrid_atmlnd + use med_internalstate_mod , only : mrg_fracname_lnd2atm_state, mrg_fracname_lnd2atm_flux, map_fracname_lnd2atm + use med_internalstate_mod , only : mrg_fracname_lnd2rof, map_fracname_lnd2rof + use med_internalstate_mod , only : mrg_fracname_lnd2glc, map_fracname_lnd2glc implicit none public @@ -28,25 +31,25 @@ module esmFldsExchange_cesm_mod public :: esmFldsExchange_cesm ! currently required mapping files - character(len=CX) :: glc2ice_rmap ='unset' - character(len=CX) :: glc2ocn_liq_rmap ='unset' - character(len=CX) :: glc2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_fmap ='unset' character(len=CX) :: rof2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_liq_rmap ='unset' - character(len=CX) :: wav2ocn_smap ='unset' - character(len=CX) :: ice2wav_smap ='unset' - character(len=CX) :: ocn2wav_smap ='unset' ! no mapping files (value is 'idmap' or 'unset') - character(len=CX) :: atm2ice_map='unset' - character(len=CX) :: atm2ocn_map='unset' - character(len=CX) :: atm2lnd_map='unset' - character(len=CX) :: ice2atm_map='unset' - character(len=CX) :: ocn2atm_map='unset' - character(len=CX) :: lnd2atm_map='unset' - character(len=CX) :: rof2lnd_map='unset' - character(len=CX) :: atm2wav_map='unset' + character(len=CX) :: atm2ice_map ='unset' + character(len=CX) :: atm2ocn_map ='unset' + character(len=CX) :: atm2lnd_map ='unset' + character(len=CX) :: ice2atm_map ='unset' + character(len=CX) :: ocn2atm_map ='unset' + character(len=CX) :: ocn2wav_smap ='unset' + character(len=CX) :: lnd2atm_map ='unset' + character(len=CX) :: rof2lnd_map ='unset' + character(len=CX) :: atm2wav_map ='unset' + character(len=CX) :: wav2ocn_smap ='unset' + character(len=CX) :: ice2wav_smap ='unset' + character(len=CX) :: glc2ice_rmap ='unset' + character(len=CX) :: glc2ocn_liq_rmap ='unset' + character(len=CX) :: glc2ocn_ice_rmap ='unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN @@ -97,9 +100,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CL) :: cvalue logical :: wav_coupling_to_cice logical :: ocn2glc_coupling - character(len=CL) :: atm_mesh - character(len=CL) :: lnd_mesh - character(len=CS) :: mrg_fracname_lnd character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- @@ -217,16 +217,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths - ! determine if atm and lnd have the same mesh - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(atm_mesh) == trim(lnd_mesh)) then - samegrid_atmlnd = .true. - else - samegrid_atmlnd = .false. - end if ! write diagnostic output if (maintask) then @@ -813,9 +803,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdr', rc=rc)) then - call addmap_from(complnd, 'Sl_avsdr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_avsdr', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_avsdr', & - mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_avsdr', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdr', rc=rc)) then call addmap_from(compice, 'Si_avsdr', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -840,9 +830,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_avsdf', rc=rc)) then - call addmap_from(complnd, 'Sl_avsdf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_avsdf', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_avsdf', & - mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_avsdf', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_avsdf', rc=rc)) then call addmap_from(compice, 'Si_avsdf', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -867,9 +857,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidr', rc=rc)) then - call addmap_from(complnd, 'Sl_anidr', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_anidr', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_anidr', & - mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_anidr', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidr', rc=rc)) then call addmap_from(compice, 'Si_anidr', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -894,9 +884,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! Note that for aqua-plant there will be no import from complnd or compice - and the ! current logic below takes care of this. if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_anidf', rc=rc)) then - call addmap_from(complnd, 'Sl_anidf', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_anidf', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_anidf', & - mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_anidf', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_anidf', rc=rc)) then call addmap_from(compice, 'Si_anidf', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -926,9 +916,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -953,9 +943,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -980,9 +970,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1008,9 +998,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1042,9 +1032,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1069,9 +1059,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1096,9 +1086,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1124,9 +1114,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1160,14 +1150,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_taux', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_taux', rc=rc)) then - call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_taux', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_taux', & - mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_taux', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc)) then call addmap_from(compice , 'Faii_taux', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1192,14 +1177,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then - call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_tauy', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_tauy', & - mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_tauy', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_tauy', rc=rc)) then call addmap_from(compice , 'Faii_tauy', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1224,14 +1204,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then - call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_lat', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_lat', & - mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_lat', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lat', rc=rc)) then call addmap_from(compice , 'Faii_lat', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1256,14 +1231,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then - call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_sen', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_sen', & - mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then call addmap_from(compice , 'Faii_sen', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1288,14 +1258,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then - call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then call addmap_from(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1320,14 +1285,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then - call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_lwup', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_lwup', & - mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_lwup', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_lwup', rc=rc)) then call addmap_from(compice , 'Faii_lwup', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1353,14 +1313,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then - call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, 'lfrin', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if + call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then call addmap_from(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) @@ -1390,9 +1345,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compatm), 'Sx_t', rc=rc)) then if (fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap_from(complnd, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_t', compatm, mapconsf , map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sx_t', & - mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Sl_t', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) end if if (fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then call addmap_from(compice, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_map) @@ -1461,7 +1416,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - ! --------------------------------------------------------------------- ! to atm: surface snow depth from ice (needed for cam) ! to atm: mean ice volume per unit area from ice @@ -1551,7 +1505,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_fv', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_fv', rc=rc)) then - call addmap_from(complnd, 'Sl_fv', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_fv', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_fv', mrg_from=complnd, mrg_fld='Sl_fv', mrg_type='copy') end if end if @@ -1561,7 +1515,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_ram1', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_ram1', rc=rc)) then - call addmap_from(complnd, 'Sl_ram1', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_ram1', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_ram1', mrg_from=complnd, mrg_fld='Sl_ram1', mrg_type='copy') end if end if @@ -1571,13 +1525,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_snowh', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_snowh', rc=rc)) then - call addmap_from(complnd, 'Sl_snowh', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_snowh', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_snowh', mrg_from=complnd, mrg_fld='Sl_snowh', mrg_type='copy') end if end if ! --------------------------------------------------------------------- - ! atm atm: CARMA fields (volumetric soil water) from land + ! to atm: CARMA fields (volumetric soil water) from land !----------------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(complnd, 'Sl_soilw') @@ -1585,7 +1539,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_soilw', rc=rc) .and. & fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_soilw', rc=rc)) then - call addmap_from(complnd, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Sl_soilw', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') end if end if @@ -1599,9 +1553,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_flxdst', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_flxdst', rc=rc)) then - call addmap_from(complnd, 'Fall_flxdst', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmap_from(complnd, 'Fall_flxdst', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_flxdst', & - mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_flxdst', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if @@ -1615,13 +1569,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if call addmrg_to(compatm, 'Fall_voc', & - mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if @@ -1635,14 +1584,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then + call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) - if (samegrid_atmlnd) then - mrg_fracname_lnd='lfrac' - else - mrg_fracname_lnd='lfrin' - end if call addmrg_to(compatm, 'Fall_fire', & - mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if ! 'wild fire plume height' @@ -3157,14 +3102,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, 'lfrin', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofsur', & - mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3177,14 +3117,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, 'lfrin', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofi', & - mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3197,14 +3132,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, 'lfrin', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofgwl', & - mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3217,14 +3147,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, 'lfrac', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_rofsub', & - mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3237,14 +3162,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, 'lfrac', 'unset') - if (samegrid_atmlnd) then - mrg_fracname_lnd = 'lfrac' - else - mrg_fracname_lnd = 'lfrin' - endif + call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, map_fracname_lnd2rof, 'unset') call addmrg_to(comprof, 'Flrl_irrig', & - mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd) + mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) end if end if @@ -3274,14 +3194,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 do ns = 1,is_local%wrap%num_icesheets if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then - call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc)) then - call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc)) then - ! This is needed just for mappingn to glc - but is not sent as a field - call addmap_from(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, 'lfrac', 'unset') + ! This is needed just for mapping to glc - but is not sent as a field + call addmap_from(complnd, 'Sl_topo_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if end do end if @@ -3400,7 +3320,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2glc) end if else if (flds_co2c) then @@ -3448,7 +3368,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) call addmrg_to(compatm, 'Fall_fco2_lnd', & - mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname='lfrac') + mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', & + mrg_fracname=mrg_fracname_lnd2atm_flux) end if ! --------------------------------------------------------------------- @@ -3476,7 +3397,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! it will be weighted by ifrac in the merge to the atm if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then - call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, 'lfrac', ocn2atm_map) + call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, mrg_fracname_lnd2atm_flux, ocn2atm_map) call addmrg_to(compatm , 'Faoo_dms_ocn', & mrg_from=compmed, mrg_fld='Faoo_dms_ocn', mrg_type='merge', mrg_fracname='ofrac') end if diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8ea6651ea..590368a0f 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -27,7 +27,7 @@ module med_diag_mod use med_constants_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice, shr_const_latvap use med_constants_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : InternalState, logunit, maintask, diagunit + use med_internalstate_mod , only : InternalState, logunit, maintask, diagunit, samegrid_atmlnd use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk @@ -666,8 +666,13 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get fractions on atm mesh - call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (samegrid_atmlnd) then + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) @@ -986,7 +991,7 @@ subroutine med_phases_diag_lnd( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get fractions on lnd mesh - call fldbun_getdata1d(is_local%wrap%FBfrac(complnd), 'lfrac', lfrac, rc=rc) + call fldbun_getdata1d(is_local%wrap%FBfrac(complnd), 'lfrin', lfrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return areas => is_local%wrap%mesh_info(complnd)%areas diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index b0cd53a61..864df1ebf 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -10,6 +10,11 @@ module med_fraction_mod ! ifrad = fraction of ocn on a grid at last radiation time ! ofrad = fraction of ice on a grid at last radiation time ! + ! ofrad = fraction of ice on a grid at last radiation time + ! afrac, lfrac, ifrac, and ofrac are the self-consistent values in the + ! system. lfrin is the fraction on the land grid and is allowed to + ! vary from the self-consistent value as descibed below. ifrad + ! and ofrad are needed for the swnet calculation. ! lfrac, ifrac, and ofrac: ! are the self-consistent values in the system ! ifrad and ofrad: @@ -17,12 +22,12 @@ module med_fraction_mod ! ! the fractions fields are defined for each grid in the fraction bundles as ! needed as follows. - ! character(*),parameter :: fraclist_a = 'ifrac:ofrac:lfrac:aofrac + ! character(*),parameter :: fraclist_a = 'ifrac:ofrac:lfrac:lfrin:aofrac ! character(*),parameter :: fraclist_o = 'ifrac:ofrac:ifrad:ofrad' ! character(*),parameter :: fraclist_i = 'ifrac:ofrac' - ! character(*),parameter :: fraclist_l = 'lfrac' - ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' - ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' + ! character(*),parameter :: fraclist_l = 'lfrac:lfrin' + ! character(*),parameter :: fraclist_g = 'gfrac:lfrac:lfrin' + ! character(*),parameter :: fraclist_r = 'rfrac:lfrac:lfrin' ! ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps @@ -44,6 +49,9 @@ module med_fraction_mod ! where fractions_* are a bundle of fractions on a particular grid and ! *frac is the fraction of a particular component in the bundle. ! + ! in general, on every grid, + ! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0 + ! ! the fractions are computed fundamentally as follows (although the ! detailed implementation might be slightly different) ! @@ -52,8 +60,12 @@ module med_fraction_mod ! fractions_*(ifrac) = 0.0 ! fractions/masks provided by surface components ! fractions_o(ofrac) = ocean "mask" provided by ocean + ! fractions_l(lfrin) = Sl_lfrin ! land model fraction computed as + ! map of ocean mask to land grid ! then mapped to the atm model ! fractions_a(ofrac) = mapo2a(fractions_o(ofrac)) + ! fractions_a(lfrin) = mapl2a(fractions_l(lfrin)) + ! ! and a few things are then derived ! fractions_a(lfrac) = 1.0 - fractions_a(ofrac) ! this is truncated to zero for very small values (< 0.001) @@ -79,8 +91,8 @@ module med_fraction_mod ! fraction corrections in mapping are as follows ! mapo2a uses *fractions_o(ofrac) and /fractions_a(ofrac) ! mapi2a uses *fractions_i(ifrac) and /fractions_a(ifrac) - ! mapl2a uses *fractions_l(lfrac) - ! mapl2g weights by fractions_l(lfrac) with normalization and multiplies by fractions_g(lfrac) + ! mapl2a uses *fractions_l(lfrin) and /fractions_a(lfrin) + ! mapl2g weights by fractions_l(lfrin) with normalization and multiplies by fractions_g(lfrin) ??? ! ! run time: ! fractions_a(lfrac) + fractions_a(ofrac) + fractions_a(ifrac) ~ 1.0 @@ -95,6 +107,19 @@ module med_fraction_mod ! is_local%wrap%FBImp(compocn,compocn) => 'So_omask' ! is_local%wrap%FBImp(compice,compice) => 'Si_ifrac' (runtime) ! + ! NOTE: In trigrid configurations, lfrin MUST be defined as the + ! conservative o2l mapping of the complement of the ocean mask. + ! In non-trigrid configurations, lfrin is generally associated with + ! the fraction of land grid defined by the surface dataset and might + ! be 1 everywhere for instance. In many cases, the non-trigrid + ! lfrin is defined to be the conservative o2a mapping of the complement + ! of the ocean mask. In this case, it is defined the same as the + ! trigrid. But to support all cases, + ! for trigrid: + ! mapping from the land grid should use the lfrin field (same in non-trigrid) + ! budget diagnostics should use lfrin (lfrac in non-trigrid) + ! merges in the atm should use lfrac (same in non-trigrid) + ! the runoff should use the lfrin fraction in the runoff merge (lfrac in non-trigrid) !----------------------------------------------------------------------------- use med_kind_mod , only : CX =>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -118,15 +143,15 @@ module med_fraction_mod public med_fraction_init public med_fraction_set - integer, parameter :: nfracs = 5 - character(len=6),allocatable :: fraclist(:,:) - character(len=6),parameter,dimension(4) :: fraclist_a = (/'ifrac ','ofrac ','lfrac ','aofrac'/) - character(len=6),parameter,dimension(4) :: fraclist_o = (/'ifrac ','ofrac ','ifrad ','ofrad '/) - character(len=6),parameter,dimension(2) :: fraclist_i = (/'ifrac ','ofrac '/) - character(len=6),parameter,dimension(1) :: fraclist_l = (/'lfrac '/) - character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) - character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) - character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + integer, parameter :: nfracs = 5 + character(len=6),allocatable :: fraclist(:,:) + character(len=6),parameter :: fraclist_a(5) = (/'ifrac ','ofrac ','lfrac ','lfrin ','aofrac'/) + character(len=6),parameter :: fraclist_o(4) = (/'ifrac ','ofrac ','ifrad ','ofrad '/) + character(len=6),parameter :: fraclist_i(2) = (/'ifrac ','ofrac '/) + character(len=6),parameter :: fraclist_l(2) = (/'lfrac ','lfrin '/) + character(len=6),parameter :: fraclist_g(3) = (/'gfrac ','lfrac ','lfrin '/) + character(len=6),parameter :: fraclist_r(3) = (/'rfrac ','lfrac ','lfrin '/) + character(len=6),parameter :: fraclist_w(1) = (/'wfrac '/) !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) @@ -169,6 +194,7 @@ subroutine med_fraction_init(gcomp, rc) real(R8), pointer :: ofrac(:) real(R8), pointer :: aofrac(:) real(R8), pointer :: lfrac(:) + real(R8), pointer :: lfrin(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: gfrac(:) real(R8), pointer :: rfrac(:) @@ -251,9 +277,12 @@ subroutine med_fraction_init(gcomp, rc) endif !--------------------------------------- - ! Set 'lfrac' for FBFrac(complnd) - this might be overwritten later + ! Set 'lfrin' in FBFrac(complnd) + ! Set 'lfrac' in FBFrac(complnd) !--------------------------------------- + ! Initially both lfrac and lfrin in FBFrac are the same + ! However, 'lfrac' in FBFrac(complnd) might be overwritten later if (is_local%wrap%comp_present(complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(complnd,complnd) , 'Sl_lfrin', Sl_lfrin, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -262,6 +291,11 @@ subroutine med_fraction_init(gcomp, rc) if (associated(lfrac)) then lfrac(:) = Sl_lfrin(:) end if + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd) , 'lfrin', lfrin, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (associated(lfrin)) then + lfrin(:) = Sl_lfrin(:) + end if end if !--------------------------------------- @@ -378,8 +412,42 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'lfrac' in FBFrac(compatm) and correct 'ofrac' in FBFrac(compatm) + ! Set 'lfrin' in FBFrac(compatm) + ! --------------------------------------- + + if ( is_local%wrap%comp_present(compatm) .and. & + is_local%wrap%comp_present(complnd) .and. & + is_local%wrap%med_coupling_active(complnd,compatm)) then + + if (med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),mapfcopy, rc=rc)) then + maptype = mapfcopy + else + maptype = mapconsd + if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),maptype, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then + call med_map_routehandles_init( complnd, compatm, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + !--------------------------------------- + ! Set 'lfrac' in FBFrac(compatm) + ! Reset 'ofrac' in FBFrac(compatm) if appropriate ! --------------------------------------- + ! These should actually be mapo2a of ofrac and lfrac but we can't ! map lfrac from o2a due to masked mapping weights. So we have to ! settle for a residual calculation that is truncated to zero to @@ -387,9 +455,10 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compatm)) then - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then + if ( is_local%wrap%comp_present(compocn) .or. & + is_local%wrap%comp_present(compice)) then - ! Ocean is present + ! Ocean or ice are present call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) @@ -407,36 +476,19 @@ subroutine med_fraction_init(gcomp, rc) end if end if - else if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compatm)) then + else if (is_local%wrap%comp_present(complnd) .and. & + is_local%wrap%med_coupling_active(complnd,compatm)) then - ! If the ocean or ice are absent, regrid 'lfrac' from FBFrac(complnd) -> FBFrac(compatm) - if (med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),mapfcopy, rc=rc)) then - maptype = mapfcopy - else - maptype = mapconsd - if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),maptype, rc=rc)) then - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then - call med_map_routehandles_init( complnd, compatm, & - FBSrc=is_local%wrap%FBImp(complnd,complnd), & - FBDst=is_local%wrap%FBImp(complnd,compatm), & - mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - end if - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrac', field=field_dst, rc=rc) + ! Ocean or ice are not present but land is present and couples to atm + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrin, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (associated(ofrac)) then do n = 1,size(lfrac) + lfrac(n) = lfrin(n) ofrac(n) = 1.0_R8 - lfrac(n) if (abs(ofrac(n)) < eps_fraclim) then ofrac(n) = 0.0_R8 @@ -451,13 +503,13 @@ subroutine med_fraction_init(gcomp, rc) ! Reset 'lfrac' in FBFrac(complnd) if appropriate !--------------------------------------- + ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) + ! If the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) from above + if ( is_local%wrap%comp_present(complnd) .and. & + is_local%wrap%comp_present(compatm) .and. & is_local%wrap%med_coupling_active(complnd,compatm)) then - ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) - ! Note that if the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) - ! from above - if (med_map_RH_is_created(is_local%wrap%RH(compatm,complnd,:),mapfcopy, rc=rc)) then maptype = mapfcopy else @@ -479,7 +531,7 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'rfrac' and 'lfrac' for FBFrac(comprof) + ! Set 'rfrac', 'lfrac' and 'lfrin' in FBFrac(comprof) !--------------------------------------- if (is_local%wrap%comp_present(comprof)) then @@ -502,7 +554,7 @@ subroutine med_fraction_init(gcomp, rc) endif endif - ! Set 'lfrac' in FBFrac(comprof) + ! Set 'lfrac' and 'lfrin' in FBFrac(comprof) if (is_local%wrap%comp_present(complnd)) then maptype = mapconsd if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,comprof,:),maptype, rc=rc)) then @@ -518,11 +570,18 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,comprof,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif !--------------------------------------- - ! Set 'gfrac' and 'lfrac' for FBFrac(compglc) + ! Set 'gfrac', 'lfrac' and 'lfrin' in FBFrac(compglc) !--------------------------------------- do ns = 1,is_local%wrap%num_icesheets @@ -563,6 +622,13 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrin', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrin', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compglc(ns),:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif end do @@ -785,6 +851,7 @@ 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 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) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index a0fd7d959..da73d98ec 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -115,7 +115,14 @@ module med_internalstate_mod real(r8), pointer :: lons(:) => null() end type mesh_info_type - logical, public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + logical , public :: samegrid_atmlnd = .true. ! true=>atm and lnd are on the same grid + character(len=CS), public :: mrg_fracname_lnd2atm_state + character(len=CS), public :: mrg_fracname_lnd2atm_flux + character(len=CS), public :: map_fracname_lnd2atm + character(len=CS), public :: mrg_fracname_lnd2rof + character(len=CS), public :: map_fracname_lnd2rof + character(len=CS), public :: mrg_fracname_lnd2glc + character(len=CS), public :: map_fracname_lnd2glc ! private internal state to keep instance data type InternalStateStruct @@ -193,11 +200,11 @@ module med_internalstate_mod type(mesh_info_type) , pointer :: mesh_info(:) type(ESMF_FieldBundle) , pointer :: FBArea(:) ! needed for mediator history writes - end type InternalStateStruct + end type InternalStateStruct - type, public :: InternalState + type, public :: InternalState type(InternalStateStruct), pointer :: wrap - end type InternalState + end type InternalState character(len=*), parameter :: u_FILE_u = & __FILE__ @@ -225,6 +232,8 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets + character(len=CL) :: atm_mesh + character(len=CL) :: lnd_mesh character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -232,6 +241,37 @@ subroutine med_internalstate_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(atm_mesh) == trim(lnd_mesh)) then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if + + ! See med_fraction_mod for the following definitions + if (samegrid_atmlnd) then + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrac' ! in fraclist_a + map_fracname_lnd2rof = 'lfrac' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrac' ! in fraclist_r + map_fracname_lnd2glc = 'lfrac' ! in fraclist_g + mrg_fracname_lnd2glc = 'lfrac' ! in fraclist_g + else + map_fracname_lnd2atm = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_r + map_fracname_lnd2rof = 'lfrin' ! in fraclist_r + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r + map_fracname_lnd2glc = 'lfrin' ! in fraclist_g + mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_g + endif + ! Determine if glc is present call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index cb7acea1b..0720fd423 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -22,7 +22,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 use ESMF , only : ESMF_FieldRegrid, ESMF_REGION_EMPTY use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc - use med_internalstate_mod , only : InternalState, maintask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2glc use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_map_mod , only : med_map_field_normalized, med_map_field use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -814,13 +814,8 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get land fraction field on land mesh - if (samegrid_atmlnd) then - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrac', field=lfield_lfrac_l, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='lfrin', field=lfield_lfrac_l, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), fieldName=map_fracname_lnd2glc, field=field_lfrac_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) do ns = 1,is_local%wrap%num_icesheets @@ -1059,7 +1054,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) , pointer :: frac_l_ec(:,:) ! EC fractions (Sg_ice_covered) on land grid real(r8) , pointer :: icemask_g(:) ! icemask on glc grid real(r8) , pointer :: icemask_l(:) ! icemask on land grid - real(r8) , pointer :: lfrac(:) ! land fraction on land grid + real(r8) , pointer :: lndfrac(:) ! land fraction on land grid real(r8) , pointer :: dataptr1d(:) ! temporary 1d pointer integer :: ec ! loop index over elevation classes integer :: n @@ -1073,7 +1068,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) ! renormalization factors (should be close to 1, e.g. in range 0.95 to 1.05) real(r8) :: accum_renorm_factor ! ratio between global accumulation on the two grids real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids - real(r8) :: effective_area ! grid cell area multiplied by min(lfrac,icemask_l). + real(r8) :: effective_area ! grid cell area multiplied by min(lndfrac,icemask_l). real(r8), pointer :: area_g(:) ! areas on glc grid character(len=*), parameter :: subname=' (renormalize_smb) ' !--------------------------------------------------------------- @@ -1153,14 +1148,9 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) call field_getdata2d(field_frac_l_ec, frac_l_ec, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - ! determine fraction on land grid, lfrac(:) - if (samegrid_atmlnd) then - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrac', lfrac, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - else - call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), 'lfrin', lfrac, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end if + ! determine fraction on land grid, lndfrac(:) + call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), map_fracname_lnd2glc, lndfrac, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return ! get qice_l_ec call fldbun_getdata2d(FBlndAccum2glc_l, trim(qice_fieldname)//'_elev', qice_l_ec, rc) @@ -1168,9 +1158,9 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) local_accum_lnd(1) = 0.0_r8 local_ablat_lnd(1) = 0.0_r8 - do n = 1, size(lfrac) + do n = 1, size(lndfrac) ! Calculate effective area for sum - need the mapped icemask_l - effective_area = min(lfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) + effective_area = min(lndfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) if (effective_area > 0.0_r8) then do ec = 1, ungriddedCount if (qice_l_ec(ec,n) >= 0.0_r8) then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 8aeba272c..f69bf59ad 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -13,7 +13,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd + use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2rof use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -619,7 +619,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrin', field=field_lfrac_lnd, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), map_fracname_lnd2rof, field=field_lfrac_lnd, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_map_field_normalized( & From 1451526906fc085ce48faef052f9b9720774288b Mon Sep 17 00:00:00 2001 From: David Bailey Date: Fri, 31 May 2024 16:11:06 -0600 Subject: [PATCH 33/69] Add bilinr_nostd for wav2ice coupling --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 47d0ae1a7..649db539a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2916,7 +2916,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') + call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', wav2ocn_smap) call addmrg_to(compice, 'Sw_elevation_spectrum', & mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if From 452962c7c9a7ad54aecb2126f160a7f2bff8bb1b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 3 Jun 2024 02:48:43 -0600 Subject: [PATCH 34/69] bug fix --- mediator/med_phases_prep_rof_mod.F90 | 35 ++++++++++++++++------------ 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index f49f68d5f..f0ec87c37 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf @@ -383,23 +384,27 @@ subroutine med_phases_prep_rof(gcomp, rc) ! custom merge for glc->rof ! glc->rof is mapped in med_phases_post_glc do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then - do nf = 1,size(fldnames_fr_glc) - call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & - trim(fldnames_fr_glc(nf)), dataptr_in, rc) - call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & - trim(fldnames_fr_glc(nf)), dataptr_out , rc) - ! Determine export data - if (ns == 1) then - dataptr_out(:) = dataptr_in(:) - else - dataptr_out(:) = dataptr_out(:) + dataptr_in(:) - end if - end do - end if + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + do nf = 1,size(fldnames_fr_glc) + if ( fldbun_fldchk(is_local%wrap%FBImp(compglc(ns),comprof), fldnames_fr_glc(nf), rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(comprof), fldnames_fr_glc(nf), rc=rc) ) then + call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & + trim(fldnames_fr_glc(nf)), dataptr_in, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & + trim(fldnames_fr_glc(nf)), dataptr_out , rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine export data + if (ns == 1) then + dataptr_out(:) = dataptr_in(:) + else + dataptr_out(:) = dataptr_out(:) + dataptr_in(:) + end if + end if + end do + end if end do - ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From b3053ca5bf151aa1647df0983566b2ed07b6d973 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 3 Jun 2024 03:09:58 -0600 Subject: [PATCH 35/69] more updates --- mediator/esmFldsExchange_cesm_mod.F90 | 8 +++--- mediator/med_internalstate_mod.F90 | 10 +++---- mediator/med_phases_prep_rof_mod.F90 | 38 +++++++++++++++------------ 3 files changed, 30 insertions(+), 26 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 407c27fb4..4cff81c0f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1560,7 +1560,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, map_fracname_lnd2atm, atm2lnd_map) call addmrg_to(compatm, 'Fall_voc', & mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if @@ -1577,7 +1577,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then - call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_fire', & mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) end if @@ -1589,7 +1589,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then - call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if @@ -1603,7 +1603,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then - call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 7f7f8b12b..bf6cf2571 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -232,8 +232,8 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets - character(len=CL) :: atm_mesh - character(len=CL) :: lnd_mesh + character(len=CL) :: atm_mesh_name + character(len=CL) :: lnd_mesh_name character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -243,11 +243,11 @@ subroutine med_internalstate_init(gcomp, rc) ! determine if atm and lnd have the same mesh - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=atm_mesh, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='ATM_DOMAIN_MESH', value=lnd_mesh, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(atm_mesh) == trim(lnd_mesh)) then + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then samegrid_atmlnd = .true. else samegrid_atmlnd = .false. diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 44daf091b..7ba28334e 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,8 +12,8 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use med_internalstate_mod , only : complnd, compglc, comprof, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit, , map_fracname_lnd2rof + use med_internalstate_mod , only : complnd, compglc, comprof, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2rof use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -383,23 +383,27 @@ subroutine med_phases_prep_rof(gcomp, rc) ! custom merge for glc->rof ! glc->rof is mapped in med_phases_post_glc do ns = 1,is_local%wrap%num_icesheets - if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then - do nf = 1,size(fldnames_fr_glc) - call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & - trim(fldnames_fr_glc(nf)), dataptr_in, rc) - call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & - trim(fldnames_fr_glc(nf)), dataptr_out , rc) - ! Determine export data - if (ns == 1) then - dataptr_out(:) = dataptr_in(:) - else - dataptr_out(:) = dataptr_out(:) + dataptr_in(:) - end if - end do - end if + if (is_local%wrap%med_coupling_active(compglc(ns),comprof)) then + do nf = 1,size(fldnames_fr_glc) + if ( fldbun_fldchk(is_local%wrap%FBImp(compglc(ns),comprof), fldnames_fr_glc(nf), rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(comprof), fldnames_fr_glc(nf), rc=rc) ) then + call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),comprof), & + trim(fldnames_fr_glc(nf)), dataptr_in, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(is_local%wrap%FBExp(comprof), & + trim(fldnames_fr_glc(nf)), dataptr_out , rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine export data + if (ns == 1) then + dataptr_out(:) = dataptr_in(:) + else + dataptr_out(:) = dataptr_out(:) + dataptr_in(:) + end if + end if + end do + end if end do - ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 5ad8bfacbfd2481a675262e46923e0d7b7c9f4e6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 7 Jun 2024 07:22:32 -0600 Subject: [PATCH 36/69] updates for cism->mosart->ocean routine --- mediator/esmFldsExchange_cesm_mod.F90 | 184 ++++++++++++++------------ mediator/fd_cesm.yaml | 28 ++-- mediator/med_diag_mod.F90 | 33 ++++- 3 files changed, 134 insertions(+), 111 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index af552dc2d..3a2d4c8c7 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -5,10 +5,49 @@ module esmFldsExchange_cesm_mod ! fields exchanged between components and their associated routing, ! mapping and merging ! - ! Merging arguments: - ! mrg_fromN = source component index that for the field to be merged - ! mrg_fldN = souce field name to be merged - ! mrg_typeN = merge type ('copy', 'copy_with_weights', 'sum', 'sum_with_weights', 'merge') + ! ----------------------------------------------------------------------------------------- + ! subroutine med_fldList_addmrg_to(index, fldname, mrg_from, mrg_fld, mrg_type, mrg_fracname, rc) + ! integer , intent(in) :: index + ! character(len=*), intent(in) :: fldname + ! integer , intent(in) :: mrg_from + ! character(len=*), intent(in) :: mrg_fld + ! character(len=*), intent(in) :: mrg_type + ! character(len=*), intent(in) , optional :: mrg_fracname + ! integer , intent(out), optional :: rc + ! + ! index : destination component index that merging will occur to + ! fldname : field name in mediator export field bundle for destination component + ! mrg_from : source component index that will contribute to the merge + ! mrg_field : field name fom source component field bundle that will be used in merge + ! mrg_type : one of ['copy', 'copy_with_weights', 'sum', 'sum_with_weights', 'merge'] + ! mrg_fracname : if mrg_type is copy_with_weights or merge - + ! fraction name in fraction field bundle to use in merge + ! + ! ----------------------------------------------------------------------------------------- + ! subroutine med_fldList_addmap_from(index, fldname, destcomp, maptype, mapnorm, mapfile) + ! integer , intent(in) :: index + ! character(len=*) , intent(in) :: fldname + ! integer , intent(in) :: destcomp + ! integer , intent(in) :: maptype + ! character(len=*) , intent(in) :: mapnorm + ! character(len=*) , intent(in), optional :: mapfile + ! + ! index : source component index that mapping will occur from + ! fldname : field name in mediator import field for source component + ! destcomp : destination component index + ! maptype : mapping type (see med_internal_state_mod.F90 for the supported mapping types) + ! if maptype is mapfcopy - create a redistribution route handle + ! mapnorm : normalization type, one of ['unset', 'one', 'none', fracname] + ! fracname - is the field name of the field in the fraction field bundle corresponding to the + ! source field that will be used for normalization + ! 'one' - implies that the mapped field is divided by mapping 'one' from the source to the + ! destination mesh + ! 'none' - do not use any normalization - use if maytype is not mapfcopy + ! 'unset' - do not use any normalization - only used if maptype is mapfcopy + ! mapfile : if mapfile is idmap - create a redistribution route nhandle + ! if mapfile is unset then create the mapping route handle at run time + ! + ! ----------------------------------------------------------------------------------------- ! NOTE: ! mrg_from(compmed) can either be for mediator computed fields for atm/ocn fluxes or for ocn albedos ! @@ -28,24 +67,23 @@ module esmFldsExchange_cesm_mod public :: esmFldsExchange_cesm ! currently required mapping files - character(len=CX) :: glc2ice_rmap ='unset' - character(len=CX) :: rof2ocn_fmap ='unset' character(len=CX) :: rof2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_liq_rmap ='unset' - character(len=CX) :: wav2ocn_smap ='unset' - character(len=CX) :: ice2wav_smap ='unset' - character(len=CX) :: ocn2wav_smap ='unset' ! no mapping files (value is 'idmap' or 'unset') - character(len=CX) :: atm2ice_map='unset' - character(len=CX) :: atm2ocn_map='unset' - character(len=CX) :: atm2lnd_map='unset' - character(len=CX) :: ice2atm_map='unset' - character(len=CX) :: ocn2atm_map='unset' - character(len=CX) :: lnd2atm_map='unset' - character(len=CX) :: lnd2rof_map='unset' - character(len=CX) :: rof2lnd_map='unset' - character(len=CX) :: atm2wav_map='unset' + character(len=CX) :: atm2ice_map = 'unset' + character(len=CX) :: atm2ocn_map = 'unset' + character(len=CX) :: atm2lnd_map = 'unset' + character(len=CX) :: ice2atm_map = 'unset' + character(len=CX) :: ocn2atm_map = 'unset' + character(len=CX) :: lnd2atm_map = 'unset' + character(len=CX) :: lnd2rof_map = 'unset' + character(len=CX) :: rof2lnd_map = 'unset' + character(len=CX) :: atm2wav_map = 'unset' + character(len=CX) :: wav2ocn_smap = 'unset' + character(len=CX) :: ice2wav_smap = 'unset' + character(len=CX) :: ocn2wav_smap = 'unset' + character(len=CX) :: rof2ocn_fmap = 'unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN @@ -142,9 +180,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='atm2ice_map', value=atm2ice_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) - call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'glc2ice_rmapname = '// trim(glc2ice_rmap) ! mapping to ocn call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_map', value=atm2ocn_map, rc=rc) @@ -205,7 +240,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso - ! are water isotope exchanges enabled? + call NUOPC_CompAttributeGet(gcomp, name='flds_r2l_stream_channel_depths', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths @@ -1558,7 +1593,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'one', atm2lnd_map) + call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, 'lfrin', lnd2atm_map) call addmrg_to(compatm, 'Fall_voc', & mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname='lfrac') end if @@ -1573,7 +1608,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_fire', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then - call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'lfrin', lnd2atm_map) call addmrg_to(compatm, 'Fall_fire', & mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname='lfrac') end if @@ -1585,7 +1620,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then - call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, 'lfrin', lnd2atm_map) call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if @@ -1598,7 +1633,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_ddvel', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_ddvel', rc=rc)) then - call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, 'one', lnd2atm_map) + call addmap_from(complnd, 'Sl_ddvel', compatm, mapconsf, 'lfrin', lnd2atm_map) call addmrg_to(compatm, 'Sl_ddvel', mrg_from=complnd, mrg_fld='Sl_ddvel', mrg_type='copy') end if end if @@ -2177,20 +2212,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if !----------------------------- - ! to ocn: liquid runoff from rof components - ! to ocn: frozen runoff flux from rof and glc components + ! to ocn: liquid runoff from rof originating from lnd + ! to ocn: liquid runoff from rof originating from glc + ! to ocn: ice runoff from rof originating from lnd + ! to ocn: ice runoff from rof originating from glc ! to ocn: waterflux back to ocn due to flooding from rof !----------------------------- if (phase == 'advertise') then ! Note that Flrr_flood below needs to be added to - ! fldlistFr(comprof) in order to be mapped correctly but the ocean - ! does not receive it so it is advertised but it will! not be connected + ! fldlistFr(comprof) in order to be mapped correctly to the ocean but the ocean + ! does not receive it so it is advertised but it will not be connected call addfld_from(comprof, 'Forr_rofl') - call addfld_to(compocn, 'Foxx_rofl') - call addfld_to(compocn, 'Flrr_flood') call addfld_from(comprof, 'Forr_rofi') + call addfld_from(comprof, 'Forr_rofl_glc') + call addfld_from(comprof, 'Forr_rofi_glc') + call addfld_to(compocn, 'Foxx_rofl') call addfld_to(compocn, 'Foxx_rofi') + call addfld_to(compocn, 'Forr_rofl_glc') + call addfld_to(compocn, 'Forr_rofi_glc') + call addfld_to(compocn, 'Flrr_flood') else if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then ! liquid from river and possibly flood from river to ocean @@ -2219,6 +2260,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') end if end if + + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl_glc', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl_glc', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + call addmrg_to(compocn, 'Foxx_rofl_glc', mrg_from=comprof, mrg_fld='Forr_rofl_glc', mrg_type='copy') + end if + + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofi_glc', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofo_glc', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + call addmrg_to(compocn, 'Foxx_rofl_glc', mrg_from=comprof, mrg_fld='Forr_rofi_glc', mrg_type='copy') + end if end if if (flds_wiso) then @@ -2802,54 +2863,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - ! --------------------------------------------------------------------- - ! to ice: frozen runoff from rof and glc - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(comprof, 'Firr_rofi') ! water flux into sea ice due to runoff (frozen) - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Figg_rofi') ! glc frozen runoff_iceberg flux to ice - end do - call addfld_to(compice, 'Fixx_rofi') ! total frozen water flux into sea ice - else - if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi', rc=rc)) then - call addmap_from(comprof, 'Forr_rofi', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg_to(compice, 'Fixx_rofi', mrg_from=comprof, mrg_fld='Firr_rofi', mrg_type='sum') - end if - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi', rc=rc)) then - call addmap_from(compglc(ns), 'Figg_rofi', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg_to(compice, 'Fixx_rofi', mrg_from=compglc(ns), mrg_fld='Figg_rofi', mrg_type='sum') - end if - end do - end if - end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(comprof, 'Firr_rofi_wiso') ! water flux into sea ice due to runoff (frozen) - do ns = 1, is_local%wrap%num_icesheets - call addfld_from(compglc(ns), 'Figg_rofi_wiso') ! glc frozen runoff_iceberg flux to ice - end do - call addfld_to(compice, 'Fixx_rofi_wiso') ! total frozen water flux into sea ice - else - if ( fldchk(is_local%wrap%FBExp(compice), 'Fixx_rofi_wiso', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso', rc=rc)) then - call addmap_from(comprof, 'Forr_rofi_wiso', compice, mapconsf, 'none', rof2ocn_ice_rmap) - call addmrg_to(compice, 'Fixx_rofi_wiso', & - mrg_from=comprof, mrg_fld='Firr_rofi_wiso', mrg_type='sum') - end if - do ns = 1, is_local%wrap%num_icesheets - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Figg_rofi_wiso', rc=rc)) then - call addmap_from(compglc(ns), 'Figg_rofi_wiso', compice, mapconsf, 'one' , glc2ice_rmap) - call addmrg_to(compice, 'Fixx_rofi_wiso', & - mrg_from=compglc(ns), mrg_fld='Figg_rofi_wiso', mrg_type='sum') - end if - end do - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- @@ -3045,13 +3058,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to(comprof, 'Fgrg_rofi') else ! Note: we are assuming that the rof mesh has a mask of one everywhere - ! TODO: should the following have fractional mapping? - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofl', comprof, mapconsd, 'one' , 'unset') + if ( fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofl', rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl', comprof, mapconsd, 'gfrac' , 'unset') ! Custom merge in med_phases_prep_rof end if - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofi', comprof, mapconsd, 'one', 'unset') + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofi', rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi', comprof, mapconsd, 'gfrac', 'unset') ! Custom merge in med_phases_prep_rof end if end if diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index a15bd2fc4..50200efa2 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1172,6 +1172,10 @@ canonical_units: kg m-2 s-1 description: river export to ocean - water flux due to runoff (frozen) # + - standard_name: Forr_rofi_glc + canonical_units: kg m-2 s-1 + description: river export to ocean - water flux due to runoff originating from glc (frozen) + # - standard_name: Forr_rofi_wiso canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO @@ -1180,29 +1184,13 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff (liquid) # - - standard_name: Forr_rofl_wiso - canonical_units: kg m-2 s-1 - description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO - # - - standard_name: Firr_rofi - canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) - # - - standard_name: Firr_rofi_wiso + - standard_name: Forr_rofl_glc canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) for 16O, 18O, HDO + description: river import to med - water flux due to runoff originating from glc (liquid) # - #----------------------------------- - # section: river export from med (computed in med) - #----------------------------------- - # - - standard_name: Fixx_rofi - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and lnd-ice - # - - standard_name: Fixx_rofi_wiso + - standard_name: Forr_rofl_wiso canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and lnd-ice for 16O, 18O, HDO + description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO # #----------------------------------- # section: wav import to med diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 473c23e6e..b527dc279 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -1197,8 +1197,15 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi' , f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Firr_rofi' , f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc', rc=rc)) then + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc', rc=rc)) then + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (flds_wiso) then call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Forr_flood_wiso', & @@ -1231,6 +1238,14 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofi' , f_watr_ioff, ic, areas, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldbun_fldchk(is_local%wrap%FBExp(comprof), 'Fgrg_rofl', rc=rc)) then + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofl' , f_watr_roff, ic, areas, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldbun_fldchk(is_local%wrap%FBExp(comprof), 'Fgrg_rofi', rc=rc)) then + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofi' , f_watr_ioff, ic, areas, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (flds_wiso) then call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Flrl_rofl_wiso', & @@ -1533,11 +1548,21 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_snow' , f_watr_snow , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , f_watr_roff , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , f_watr_ioff , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if ( fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc)) then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , f_watr_roff , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if ( fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc)) then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , f_watr_ioff , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (flds_wiso) then call diag_ocn_wiso(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', & f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, ic, areas, ofrac, budget_local, rc=rc) @@ -1893,8 +1918,6 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ice_send(is_local%wrap%FBExp(compice), 'Faxa_snow', f_watr_snow, areas, lats, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ice_send(is_local%wrap%FBExp(compice), 'Fixx_rofi', f_watr_ioff, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBExp(compice), 'Fioo_q', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBExp(compice), 'Fioo_q', data, rc=rc) @@ -1913,14 +1936,12 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ic = c_inh_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice if (trim(budget_table_version) == 'v0') then budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if ic = c_ish_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice if (trim(budget_table_version) == 'v0') then budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if From 3e45430e08ea9fc6a435274c9a8240910ca81b4f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 7 Jun 2024 07:39:25 -0600 Subject: [PATCH 37/69] more cleanup of mapping file specification --- cime_config/namelist_definition_drv.xml | 36 ------------------------- mediator/esmFldsExchange_cesm_mod.F90 | 10 +++---- 2 files changed, 5 insertions(+), 41 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 03dfcbe54..ea73c46d0 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2256,42 +2256,6 @@ - - char - mapping - abs - MED_attributes - - glc2ocn runoff mapping file for liquid runoff - - - $GLC2OCN_LIQ_RMAPNAME - - - - char - mapping - abs - MED_attributes - - glc to ice runoff conservative mapping file - - - $GLC2ICE_RMAPNAME - - - - char - mapping - abs - MED_attributes - - glc2ocn runoff mapping file for ice runoff - - - $GLC2OCN_ICE_RMAPNAME - - char mapping diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 3a2d4c8c7..645aa83af 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -74,16 +74,16 @@ module esmFldsExchange_cesm_mod character(len=CX) :: atm2ice_map = 'unset' character(len=CX) :: atm2ocn_map = 'unset' character(len=CX) :: atm2lnd_map = 'unset' + character(len=CX) :: atm2wav_map = 'unset' character(len=CX) :: ice2atm_map = 'unset' - character(len=CX) :: ocn2atm_map = 'unset' + character(len=CX) :: ice2wav_smap = 'unset' character(len=CX) :: lnd2atm_map = 'unset' character(len=CX) :: lnd2rof_map = 'unset' - character(len=CX) :: rof2lnd_map = 'unset' - character(len=CX) :: atm2wav_map = 'unset' - character(len=CX) :: wav2ocn_smap = 'unset' - character(len=CX) :: ice2wav_smap = 'unset' + character(len=CX) :: ocn2atm_map = 'unset' character(len=CX) :: ocn2wav_smap = 'unset' + character(len=CX) :: rof2lnd_map = 'unset' character(len=CX) :: rof2ocn_fmap = 'unset' + character(len=CX) :: wav2ocn_smap = 'unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN From 21a692ff088a257313c61c0b12a487879aa79970 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Sun, 9 Jun 2024 16:02:05 -0400 Subject: [PATCH 38/69] simply ufs fix for new aoflux variables --- mediator/esmFldsExchange_ufs_mod.F90 | 7 ++++--- mediator/med_phases_aofluxes_mod.F90 | 19 ++++++++----------- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index aa8088306..57c266b59 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -131,9 +131,10 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) deallocate(flds) ! 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 '/) + allocate(flds(12)) + flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ', 'So_ssq ', & + 'So_u10 ', 'So_duu10n ', 'Faox_lat ', 'So_ugustOut ', 'So_u10withGust', & + 'So_u10res ', 'Faxa_rainc '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index a95bd08bc..e6dfa9870 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1601,7 +1601,7 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (coupling_mode == 'cesm') then + if (associated(aoflux_in%rainc)) then call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -1716,6 +1716,13 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_tauy', aoflux_out%tauy, xgrid=xgrid, rc=rc) @@ -1745,18 +1752,8 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return else allocate(aoflux_out%ugust_out(lsize)); aoflux_out%ugust_out(:) = 0._R8 - allocate(aoflux_out%u10_withGust(lsize)); aoflux_out%u10_withGust(:) = 0._R8 - end if - - if (coupling_mode == 'cesm') then - call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux_out%u10res(lsize)); aoflux_out%u10res(:) = 0._R8 end if end subroutine set_aoflux_out_pointers From ec56320a93693648203139147ed5dd32792cbd47 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Jun 2024 10:00:40 +0200 Subject: [PATCH 39/69] generalized lnd2rof mapping --- mediator/med_phases_prep_rof_mod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 7ba28334e..f0ec87c37 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -12,8 +12,8 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field - use med_internalstate_mod , only : complnd, compglc, comprof, mapconsd, mapconsf, mapfcopy - use med_internalstate_mod , only : InternalState, maintask, logunit, map_fracname_lnd2rof + use med_internalstate_mod , only : complnd, compglc, comprof, mapconsf, mapfcopy + use med_internalstate_mod , only : InternalState, maintask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf @@ -646,7 +647,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), map_fracname_lnd2rof, field=field_lfrac_lnd, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), 'lfrac', field=field_lfrac_lnd, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_map_field_normalized( & From ac67312c7ddbacc9a0efc66f60b8c26a34676708 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Jun 2024 11:08:03 -0600 Subject: [PATCH 40/69] updates to get f09_f09 working --- mediator/med_fraction_mod.F90 | 51 +++++++++++++++++++----------- mediator/med_internalstate_mod.F90 | 12 ++++++- 2 files changed, 44 insertions(+), 19 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 864df1ebf..63e8cfb2c 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -277,12 +277,10 @@ subroutine med_fraction_init(gcomp, rc) endif !--------------------------------------- + ! Set 'lfrac' in FBFrac(complnd) - this might be overwritten later ! Set 'lfrin' in FBFrac(complnd) - ! Set 'lfrac' in FBFrac(complnd) !--------------------------------------- - ! Initially both lfrac and lfrin in FBFrac are the same - ! However, 'lfrac' in FBFrac(complnd) might be overwritten later if (is_local%wrap%comp_present(complnd)) then call fldbun_getdata1d(is_local%wrap%FBImp(complnd,complnd) , 'Sl_lfrin', Sl_lfrin, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -447,7 +445,6 @@ subroutine med_fraction_init(gcomp, rc) ! Set 'lfrac' in FBFrac(compatm) ! Reset 'ofrac' in FBFrac(compatm) if appropriate ! --------------------------------------- - ! These should actually be mapo2a of ofrac and lfrac but we can't ! map lfrac from o2a due to masked mapping weights. So we have to ! settle for a residual calculation that is truncated to zero to @@ -455,10 +452,9 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compatm)) then - if ( is_local%wrap%comp_present(compocn) .or. & - is_local%wrap%comp_present(compice)) then + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then - ! Ocean or ice are present + ! Ocean or ice is present call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) @@ -476,12 +472,30 @@ subroutine med_fraction_init(gcomp, rc) end if end if - else if (is_local%wrap%comp_present(complnd) .and. & - is_local%wrap%med_coupling_active(complnd,compatm)) then + else if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compatm)) then - ! Ocean or ice are not present but land is present and couples to atm - call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrin, rc) + ! If the ocean or ice are absent, regrid 'lfrac' from FBFrac(complnd) -> FBFrac(compatm) + if (med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),mapfcopy, rc=rc)) then + maptype = mapfcopy + else + maptype = mapconsd + if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compatm,:),maptype, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then + call med_map_routehandles_init( complnd, compatm, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compatm), 'lfrac', field=field_dst, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) @@ -503,13 +517,13 @@ subroutine med_fraction_init(gcomp, rc) ! Reset 'lfrac' in FBFrac(complnd) if appropriate !--------------------------------------- - ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) - ! If the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) from above - if ( is_local%wrap%comp_present(complnd) .and. & - is_local%wrap%comp_present(compatm) .and. & is_local%wrap%med_coupling_active(complnd,compatm)) then + ! If lnd -> atm coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) + ! Note that if the atmosphere is absent, then simply set fractions_l(lfrac) = fractions_l(lfrin) + ! from above + if (med_map_RH_is_created(is_local%wrap%RH(compatm,complnd,:),mapfcopy, rc=rc)) then maptype = mapfcopy else @@ -531,7 +545,7 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'rfrac', 'lfrac' and 'lfrin' in FBFrac(comprof) + ! Set 'rfrac' and 'lfrac' for FBFrac(comprof) !--------------------------------------- if (is_local%wrap%comp_present(comprof)) then @@ -564,6 +578,7 @@ subroutine med_fraction_init(gcomp, rc) mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(is_local%wrap%FBfrac(comprof), 'lfrac', field=field_dst, rc=rc) @@ -606,7 +621,7 @@ subroutine med_fraction_init(gcomp, rc) endif endif - ! Set 'lfrac' in FBFrac(compglc(ns)) + ! Set 'lfrac' and 'lfrin' in FBFrac(compglc(ns)) if ( is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compglc(ns))) then maptype = mapconsd if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compglc(ns),:),maptype, rc=rc)) then @@ -616,6 +631,7 @@ subroutine med_fraction_init(gcomp, rc) mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(complnd), 'lfrac', field=field_src, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compglc(ns)), 'lfrac', field=field_dst, rc=rc) @@ -851,7 +867,6 @@ 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 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) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index bf6cf2571..577c8a942 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -265,13 +265,23 @@ subroutine med_internalstate_init(gcomp, rc) else map_fracname_lnd2atm = 'lfrin' ! in fraclist_a mrg_fracname_lnd2atm_state = 'lfrin' ! in fraclist_a - mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_r + mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_a map_fracname_lnd2rof = 'lfrin' ! in fraclist_r mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r map_fracname_lnd2glc = 'lfrin' ! in fraclist_g mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_g endif + if (maintask) then + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2atm = '//trim(map_fracname_lnd2atm) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_state = '//trim(mrg_fracname_lnd2atm_state)//' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2atm_flux = '//trim(mrg_fracname_lnd2atm_flux) //' in fraclist_a' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2rof = '//trim(map_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_r' + write(logunit,'(a,i8)') trim(subname)//' map_fracname_lnd2glc = '//trim(map_fracname_lnd2glc) //' in fraclist_g' + write(logunit,'(a,i8)') trim(subname)//' mrg_fracname_lnd2rof = '//trim(mrg_fracname_lnd2rof) //' in fraclist_g' + end if + ! Determine if glc is present call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From dcabb3827763915aedc42c96c56c3c4c5769a9c2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 12 Jun 2024 15:49:59 -0600 Subject: [PATCH 41/69] test github testing in cime PR #4631 --- .github/workflows/srt.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 63121dd7a..1858ef66d 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -91,7 +91,9 @@ jobs: sed -i".bak" "s/git@github.com:/https:\/\/github.com\//g" "${PWD}/.gitmodules" fi + git checkout fix-quiet-lockedfiles git submodule update --init + cd ../components/cdeps git checkout main git submodule update --init From e643dfe828367ddfe054fa687ae7012803dd9ce1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 14 Jun 2024 05:13:38 -0600 Subject: [PATCH 42/69] more cleanup --- cime_config/config_component.xml | 56 -------- cime_config/namelist_definition_drv.xml | 48 ------- mediator/esmFldsExchange_cesm_mod.F90 | 168 +++++++++++------------- 3 files changed, 74 insertions(+), 198 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 938e0e31c..33add8b2b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1389,14 +1389,6 @@ rof2lnd flux mapping file - - char - idmap - run_domain - env_run.xml - rof2ocn flux mapping file - - char idmap @@ -1413,54 +1405,6 @@ rof2ocn runoff mapping file - - char - idmap - run_domain - env_run.xml - glc2ice runoff mapping file - - - - char - idmap - run_domain - env_run.xml - glc2ocn runoff mapping file for liquid runoff - - - - char - idmap - run_domain - env_run.xml - glc2ocn runoff mapping file for ice runoff - - - - char - idmap - run_domain - env_run.xml - ocn2wav state mapping file - - - - char - idmap - run_domain - env_run.xml - ice2wav state mapping file - - - - char - idmap - run_domain - env_run.xml - wav2ocn state mapping file - - char 1.0e-02 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index ea73c46d0..ce3ed5a1b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2256,18 +2256,6 @@ - - char - mapping - abs - MED_attributes - - runoff to ocn area overlap conservative mapping file - - - $ROF2OCN_FMAPNAME - - char mapping @@ -2292,42 +2280,6 @@ $ROF2OCN_ICE_RMAPNAME - - char - mapping - abs - MED_attributes - - ocn to wav state mapping file for states - - - $OCN2WAV_SMAPNAME - - - - char - mapping - abs - MED_attributes - - ice to wav state mapping file for states - - - $ICE2WAV_SMAPNAME - - - - char - mapping - abs - MED_attributes - - wav to ocn state mapping file for states - - - $WAV2OCN_SMAPNAME - - diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 645aa83af..f5d45485a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -69,21 +69,21 @@ module esmFldsExchange_cesm_mod ! currently required mapping files character(len=CX) :: rof2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_liq_rmap ='unset' + character(len=CX) :: rof2lnd_map = 'unset' + character(len=CX) :: lnd2rof_map = 'unset' ! no mapping files (value is 'idmap' or 'unset') - character(len=CX) :: atm2ice_map = 'unset' - character(len=CX) :: atm2ocn_map = 'unset' - character(len=CX) :: atm2lnd_map = 'unset' - character(len=CX) :: atm2wav_map = 'unset' - character(len=CX) :: ice2atm_map = 'unset' - character(len=CX) :: ice2wav_smap = 'unset' - character(len=CX) :: lnd2atm_map = 'unset' - character(len=CX) :: lnd2rof_map = 'unset' - character(len=CX) :: ocn2atm_map = 'unset' - character(len=CX) :: ocn2wav_smap = 'unset' - character(len=CX) :: rof2lnd_map = 'unset' - character(len=CX) :: rof2ocn_fmap = 'unset' - character(len=CX) :: wav2ocn_smap = 'unset' + character(len=CX) :: atm2ice_map = 'unset' + character(len=CX) :: atm2ocn_map = 'unset' + character(len=CX) :: atm2lnd_map = 'unset' + character(len=CX) :: atm2wav_map = 'unset' + character(len=CX) :: ice2atm_map = 'unset' + character(len=CX) :: ice2wav_map = 'unset' + character(len=CX) :: lnd2atm_map = 'unset' + character(len=CX) :: ocn2atm_map = 'unset' + character(len=CX) :: ocn2wav_map = 'unset' + character(len=CX) :: rof2ocn_map = 'unset' + character(len=CX) :: wav2ocn_map = 'unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN @@ -117,7 +117,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux use esmFlds , only : addmap_ocnalb => med_fldList_addmap_ocnalb - use esmFlds , only : addfld_to => med_fldList_addfld_to use esmFlds , only : addfld_from => med_fldList_addfld_from use esmFlds , only : addmap_from => med_fldList_addmap_from @@ -131,6 +130,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local integer :: n, ns + character(len=CL) :: atm_mesh_name + character(len=CL) :: lnd_mesh_name + character(len=CL) :: ice_mesh_name + character(len=CL) :: ocn_mesh_name character(len=CL) :: cvalue logical :: wav_coupling_to_cice logical :: ocn2glc_coupling @@ -157,40 +160,37 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then - ! mapping to atm - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_map', value=ice2atm_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'ice2atm_map = '// trim(ice2atm_map) - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_map', value=lnd2atm_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'lnd2atm_map = '// trim(lnd2atm_map) - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_map', value=ocn2atm_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'ocn2atm_map = '// trim(ocn2atm_map) + ! determine if atm and lnd have the same mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=ice_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=ocn_mesh_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then + atm2lnd_map = 'idmap' + lnd2atm_map = 'idmap' + end if + if (trim(atm_mesh_name) == trim(ocn_mesh_name)) then + atm2ocn_map = 'idmap' + ocn2atm_map = 'idmap' + end if + if (trim(atm_mesh_name) == trim(ice_mesh_name)) then + atm2ice_map = 'idmap' + ice2atm_map = 'idmap' + end if - ! mapping to lnd - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_map', value=atm2lnd_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'atm2lnd_map = '// trim(atm2lnd_map) + ! mapping rof=>lnd and lnd=>rof - the following two maps are needed for MIZUROUTE call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_map', value=rof2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2lnd_map = '// trim(rof2lnd_map) - - ! mapping to ice - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_map', value=atm2ice_map, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) + if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) - ! mapping to ocn - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_map', value=atm2ocn_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) - call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_fmapname = '// trim(rof2ocn_fmap) + ! mapping to rof => ocn with custom mapping call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) @@ -198,23 +198,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) - ! mapping to rof - call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) - - ! mapping to wav - call NUOPC_CompAttributeGet(gcomp, name='atm2wav_map', value=atm2wav_map, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//'atm2wav_map = '// trim(atm2wav_map) - - call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//'ice2wav_smapname = '// trim(ice2wav_smap) - call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_smap) - ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1638,6 +1621,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + !----------------------------------------------------------------------------- + ! to atm: dms from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_dms_ocn') + call addfld_to(compatm, 'Faoo_dms_ocn') + else + ! Note that Faoo_dmds should not be weighted by ifrac - since + ! it will be weighted by ifrac in the merge to the atm + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then + call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, 'lfrac', ocn2atm_map) + call addmrg_to(compatm , 'Faoo_dms_ocn', & + mrg_from=compmed, mrg_fld='Faoo_dms_ocn', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -2242,7 +2242,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_map) call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') @@ -2299,7 +2299,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(comprof, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_fmap) + call addmap_from(comprof, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_map) call addmrg_to(compocn, 'Foxx_rofl_wiso', & mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') else @@ -2355,7 +2355,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_lamult', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_lamult', rc=rc)) then - call addmap_from(compwav, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2368,7 +2368,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes', rc=rc)) then - call addmap_from(compwav, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') end if end if @@ -2381,7 +2381,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes', rc=rc)) then - call addmap_from(compwav, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') end if end if @@ -2394,7 +2394,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_hstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_hstokes', rc=rc)) then - call addmap_from(compwav, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') end if end if @@ -2407,7 +2407,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_x', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_x', rc=rc)) then - call addmap_from(compwav, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') end if end if @@ -2420,7 +2420,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_y', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_y', rc=rc)) then - call addmap_from(compwav, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') end if end if @@ -2894,7 +2894,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) + call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if @@ -2908,7 +2908,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then - call addmap_from(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) + call addmap_from(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') end if end if @@ -2923,7 +2923,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then - call addmap_from(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) + call addmap_from(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') end if end if @@ -2937,8 +2937,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_t', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_t', rc=rc)) then - ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_t', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_t', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if @@ -2952,7 +2951,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_u', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_u', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_u', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_u', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_u', mrg_from=compocn, mrg_fld='So_u', mrg_type='copy') end if end if @@ -2963,7 +2962,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_v', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_v', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_v', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_v', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_v', mrg_from=compocn, mrg_fld='So_v', mrg_type='copy') end if end if @@ -2978,7 +2977,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compocn, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmap_from(compocn, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_map) call addmrg_to(compwav, 'So_bldepth', mrg_from=compocn, mrg_fld='So_bldepth', mrg_type='copy') end if end if @@ -3382,25 +3381,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if endif - !===================================================================== - ! DMS EXCHANGE - !===================================================================== - - ! Get dms flux from ocn and send to atm - if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_dms_ocn') - call addfld_to(compatm, 'Faoo_dms_ocn') - else - ! Note that Faoo_dmds should not be weighted by ifrac - since - ! it will be weighted by ifrac in the merge to the atm - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then - call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, 'lfrac', ocn2atm_map) - call addmrg_to(compatm , 'Faoo_dms_ocn', & - mrg_from=compmed, mrg_fld='Faoo_dms_ocn', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod From e35644a703d4a037c6e2f6e13c25ac9e8f7ac901 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 Jun 2024 03:38:27 -0600 Subject: [PATCH 43/69] fixed compilation problems --- mediator/esmFldsExchange_cesm_mod.F90 | 15 +++++++++++---- mediator/fd_cesm.yaml | 6 +++++- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- 3 files changed, 18 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 115035788..09bcad029 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -233,6 +233,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! write diagnostic output if (maintask) then + write(logunit,'(a)' ) ' flds_co2a: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' flds_co2b: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' and surface flux of CO2 from lnd is sent back to atm' + write(logunit,'(a)' ) ' flds_co2c: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' + write(logunit,'(a)' ) ' and surface flux of CO2 from lnd is sent back to atm' + write(logunit,'(a)' ) ' and surface flux of CO2 from ocn is sent back to atm' write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2c @@ -1607,9 +1613,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Fall_voc', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Fall_voc', rc=rc)) then - call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map + call addmap_from(complnd, 'Fall_voc', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) call addmrg_to(compatm, 'Fall_voc', & - mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) + mrg_from=complnd, mrg_fld='Fall_voc', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if @@ -1625,7 +1631,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBExp(compatm) , 'Fall_fire', rc=rc)) then call addmap_from(complnd, 'Fall_fire', compatm, mapconsf, 'lfrin', lnd2atm_map) call addmrg_to(compatm, 'Fall_fire', & - mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) + mrg_from=complnd, mrg_fld='Fall_fire', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) end if end if ! 'wild fire plume height' @@ -1636,7 +1642,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then call addmap_from(complnd, 'Sl_fztop', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm, 'Sl_fztop', mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') + call addmrg_to(compatm, 'Sl_fztop', & + mrg_from=complnd, mrg_fld='Sl_fztop', mrg_type='copy') end if end if diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 50200efa2..ae9c22ba6 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -857,12 +857,16 @@ # - standard_name: Faoo_fco2_ocn canonical_units: moles m-2 s-1 - description: ocn import to med + description: ocn import to med - surface flux of CO2 (downward positive) # - standard_name: Faoo_dms_ocn canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of DMS (downward positive) # + - standard_name: Faoo_bromo_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of Bromoform (downward positive) + # - standard_name: So_anidf canonical_units: 1 description: ocn import to med diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 837f00c64..0b876b0cf 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,7 +32,7 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_to_ocn(3) = (/'Faoo_bromo_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ' + character(len=14) :: fldnames_to_ocn(3) = (/'Faoo_bromo_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn '/) character(*), parameter :: u_FILE_u = & __FILE__ @@ -54,7 +54,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: dataPtr2(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) - integer :: n + integer :: n,nf type(med_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- From 5e5c1813da237047886b5f5e3843e418373322b9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 18 Jun 2024 03:31:44 -0600 Subject: [PATCH 44/69] add simplification for how glc runoff is sent to mom/blom --- mediator/esmFldsExchange_cesm_mod.F90 | 145 +++++++++++--------------- 1 file changed, 63 insertions(+), 82 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index f5d45485a..86f513d7a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -18,7 +18,7 @@ module esmFldsExchange_cesm_mod ! index : destination component index that merging will occur to ! fldname : field name in mediator export field bundle for destination component ! mrg_from : source component index that will contribute to the merge - ! mrg_field : field name fom source component field bundle that will be used in merge + ! mrg_fld : field name fom source component field bundle that will be used in merge ! mrg_type : one of ['copy', 'copy_with_weights', 'sum', 'sum_with_weights', 'merge'] ! mrg_fracname : if mrg_type is copy_with_weights or merge - ! fraction name in fraction field bundle to use in merge @@ -135,6 +135,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CL) :: ice_mesh_name character(len=CL) :: ocn_mesh_name character(len=CL) :: cvalue + character(len=CS) :: mrgfld_source logical :: wav_coupling_to_cice logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' @@ -2233,93 +2234,73 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to(compocn, 'Forr_rofi_glc') call addfld_to(compocn, 'Flrr_flood') else - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then - ! 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, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_map) - call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') - else - call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') - end if + ! Liquid runoff from land and glc - mapping + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + 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 - end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then - ! 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, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) - end if - call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') + end if + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then + call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_map) + end if + end if + if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then + if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc', rc=rc) .or. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl', rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl_glc', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl_glc', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if - end if - - if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then - if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl_glc', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofl_glc', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - call addmrg_to(compocn, 'Foxx_rofl_glc', mrg_from=comprof, mrg_fld='Forr_rofl_glc', mrg_type='copy') - end if + end if + end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then - if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi_glc', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofo_glc', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - call addmrg_to(compocn, 'Foxx_rofl_glc', mrg_from=comprof, mrg_fld='Forr_rofi_glc', mrg_type='copy') - end if - end if + ! Liquid runoff from land and glc - merging + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then + mrgfld_source = 'Forr_rofl' + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then + mrgfld_source = trim(mrgfld_source) //':Flrr_flood' + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then + mrgfld_source = trim(mrgfld_source) //':Forr_rofl_glc' + end if + call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') + end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(comprof, 'Forr_rofl_wiso') - call addfld_from(comprof, 'Forr_rofi_wiso') - call addfld_to(compocn, 'Foxx_rofl_wiso') - call addfld_to(compocn, 'Foxx_rofi_wiso') - call addfld_to(compocn, 'Flrr_flood_wiso') - else - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , rc=rc)) then - ! liquid from river and possibly flood from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_wiso' , rc=rc)) then - if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl_wiso', compocn, mapconsd, 'none', 'unset') - else - call addmap_from(comprof, 'Forr_rofl_wiso', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood_wiso', compocn, mapconsd, 'one', rof2ocn_map) - call addmrg_to(compocn, 'Foxx_rofl_wiso', & - mrg_from=comprof, mrg_fld='Forr_rofl:Flrr_flood', mrg_type='sum') - else - call addmrg_to(compocn, 'Foxx_rofl_wiso', & - mrg_from=comprof, mrg_fld='Forr_rofl', mrg_type='sum') - end if - end if + ! Frozen runoff from land and glc - mapping + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + 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 - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi_wiso' , rc=rc)) then - ! ice from river to ocean - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_wiso' , rc=rc)) then - if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi_wiso', compocn, mapconsd, 'none', 'unset') - else - call addmap_from(comprof, 'Forr_rofi_wiso', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) - end if - call addmrg_to(compocn, 'Foxx_rofi_wiso', mrg_from=comprof, mrg_fld='Forr_rofi', mrg_type='sum') - end if + end if + end if + if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then + if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc', rc=rc) .or. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi', rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofi_glc', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofi_glc', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if - end if + end if + end if + + ! Frozen runoff from land and glc - merging + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then + mrgfld_source = 'Forr_rofi' + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then + mrgfld_source = trim(mrgfld_source) //':Forr_rofi_glc' + end if + call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') + end if end if !----------------------------- From 3455b507f1ddf1d6e91a975e61a5a12144c4cb63 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 18 Jun 2024 05:42:40 -0600 Subject: [PATCH 45/69] Revert "test github testing in cime PR #4631" --- .github/workflows/srt.yml | 2 -- 1 file changed, 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 1858ef66d..63121dd7a 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -91,9 +91,7 @@ jobs: sed -i".bak" "s/git@github.com:/https:\/\/github.com\//g" "${PWD}/.gitmodules" fi - git checkout fix-quiet-lockedfiles git submodule update --init - cd ../components/cdeps git checkout main git submodule update --init From f79221ee02f4f78e9e9010765324ce6fd5f733d8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 18 Jun 2024 05:46:27 -0600 Subject: [PATCH 46/69] replace manage-externals with git-fleximod --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 63121dd7a..c33bf0e34 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -79,7 +79,7 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps share mct cpl7 parallelio + ./bin/git-fleximod update ccs_config cdeps share mct parallelio cd ccs_config git checkout main cd ../ From a1209b88795f26c62cb589bd9dad3a80b26cf8ef Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 19 Jun 2024 14:55:36 +0200 Subject: [PATCH 47/69] fix for merging in trigrid --- mediator/med_internalstate_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 577c8a942..2855d5cca 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -264,7 +264,7 @@ subroutine med_internalstate_init(gcomp, rc) mrg_fracname_lnd2glc = 'lfrac' ! in fraclist_g else map_fracname_lnd2atm = 'lfrin' ! in fraclist_a - mrg_fracname_lnd2atm_state = 'lfrin' ! in fraclist_a + mrg_fracname_lnd2atm_state = 'lfrac' ! in fraclist_a mrg_fracname_lnd2atm_flux = 'lfrin' ! in fraclist_a map_fracname_lnd2rof = 'lfrin' ! in fraclist_r mrg_fracname_lnd2rof = 'lfrin' ! in fraclist_r From ef749fa621816a3cf910d4addf455bc57f21d89c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 20 Jun 2024 21:01:38 -0600 Subject: [PATCH 48/69] Remove negative runoff by downweighting positive runoff globally --- mediator/med_phases_post_rof_mod.F90 | 170 ++++++++++++++++++++++++--- 1 file changed, 156 insertions(+), 14 deletions(-) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index aafeec011..6a8ba5f2c 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -2,10 +2,26 @@ module med_phases_post_rof_mod ! Post rof phase, if appropriate, map initial rof->lnd, rof->ocn, rof->ice + use NUOPC_Mediator , only : NUOPC_MediatorGet + use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_REDUCE_SUM + use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use med_internalstate_mod , only : complnd, compocn, compice, comprof + use med_internalstate_mod , only : InternalState, maintask, logunit + use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_phases_history_mod, only : med_phases_history_write_comp + use med_map_mod , only : med_map_field_packed + use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d + use perf_mod , only : t_startf, t_stopf + implicit none private - public :: med_phases_post_rof + public :: med_phases_post_rof + private :: med_phases_post_rof_remove_negative_runoff character(*) , parameter :: u_FILE_u = & __FILE__ @@ -16,19 +32,6 @@ module med_phases_post_rof_mod subroutine med_phases_post_rof(gcomp, rc) - use NUOPC_Mediator , only : NUOPC_MediatorGet - use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : complnd, compocn, compice, comprof - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState - use med_phases_history_mod, only : med_phases_history_write_comp - use med_map_mod , only : med_map_field_packed - use perf_mod , only : t_startf, t_stopf - ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -50,6 +53,11 @@ subroutine med_phases_post_rof(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_post_rof_remove_negative_runoff(gcomp, 'Forr_rofl', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_phases_post_rof_remove_negative_runoff(gcomp, 'Forr_rofi', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! map rof to lnd if (is_local%wrap%med_coupling_active(comprof,complnd)) then call t_startf('MED:'//trim(subname)//' map_rof2lnd') @@ -105,4 +113,138 @@ subroutine med_phases_post_rof(gcomp, rc) end subroutine med_phases_post_rof + subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) + !--------------------------------------------------------------- + ! For one runoff field, remove negative runoff by downweighting all positive runoff to + ! spread the negative runoff globally. + + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: field_name ! name of runoff flux field to process + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm + real(r8), pointer :: runoff_flux(:) ! temporary 1d pointer + real(r8), pointer :: areas(:) + real(r8) :: local_positive(1), global_positive(1) + real(r8) :: local_negative(1), global_negative(1) + real(r8) :: global_sum + real(r8) :: multiplier + real(r8) :: local_positive_final(1), global_positive_final(1) + real(r8) :: local_negative_final(1), global_negative_final(1) + real(r8) :: global_sum_final + integer :: n + + integer, parameter :: dbug_threshold = 20 ! threshold for writing debug information in this subroutine + character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_remove_negative_runoff)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Note that we don't use rof fractions in the global sum. This is consistent with the + ! global budget calculations in med_diag_mod and is because the rof fractions are 1 + ! everywhere. + areas => is_local%wrap%mesh_info(comprof)%areas + + call fldbun_getdata1d(is_local%wrap%FBImp(comprof,comprof), trim(field_name), runoff_flux, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + local_positive(1) = 0.0_r8 + local_negative(1) = 0.0_r8 + do n = 1, size(runoff_flux) + if (runoff_flux(n) >= 0.0_r8) then + local_positive(1) = local_positive(1) + areas(n) * runoff_flux(n) + else + local_negative(1) = local_negative(1) + areas(n) * runoff_flux(n) + end if + end do + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_positive, recvdata=global_positive, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_negative, recvdata=global_negative, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + global_sum = global_positive(1) + global_negative(1) + if (maintask .and. dbug_flag > dbug_threshold) then + write(logunit,'(a)') subname//' Before correction: '//trim(field_name) + write(logunit,'(a,e27.17)') subname//' global_positive = ', global_positive(1) + write(logunit,'(a,e27.17)') subname//' global_negative = ', global_negative(1) + write(logunit,'(a,e27.17)') subname//' global_sum = ', global_sum + end if + + if (global_sum > 0.0_r8) then + ! There is enough positive runoff to absorb all of the negative runoff; so set + ! negative runoff to 0 and downweight positive runoff to conserve. + multiplier = global_sum/global_positive(1) + do n = 1, size(runoff_flux) + if (runoff_flux(n) > 0.0_r8) then + runoff_flux(n) = runoff_flux(n) * multiplier + else + runoff_flux(n) = 0.0_r8 + end if + end do + else if (global_sum < 0.0_r8) then + ! There is more negative than positive runoff. Hopefully this happens rarely, if + ! ever; so set positive runoff to 0 and downweight negative runoff to minimize + ! negative runoff and conserve. + multiplier = global_sum/global_negative(1) + do n = 1, size(runoff_flux) + if (runoff_flux(n) < 0.0_r8) then + runoff_flux(n) = runoff_flux(n) * multiplier + else + runoff_flux(n) = 0.0_r8 + end if + end do + else + ! global_sum == 0 - i.e., positive and negative exactly balance (very rare, unless + ! the fluxes are already 0 everywhere!); set all fluxes to 0 in this case. + do n = 1, size(runoff_flux) + runoff_flux(n) = 0.0_r8 + end do + end if + + if (dbug_flag > dbug_threshold) then + ! Recompute positives, negatives and total sum for output diagnostic purposes + local_positive_final(1) = 0.0_r8 + local_negative_final(1) = 0.0_r8 + do n = 1, size(runoff_flux) + if (runoff_flux(n) >= 0.0_r8) then + local_positive_final(1) = local_positive_final(1) + areas(n) * runoff_flux(n) + else + local_negative_final(1) = local_negative_final(1) + areas(n) * runoff_flux(n) + end if + end do + call ESMF_VMAllreduce(vm, senddata=local_positive_final, recvdata=global_positive_final, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_negative_final, recvdata=global_negative_final, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + global_sum_final = global_positive_final(1) + global_negative_final(1) + if (maintask) then + write(logunit,'(a)') subname//' After correction: '//trim(field_name) + write(logunit,'(a,e27.17)') subname//' global_positive_final = ', global_positive_final(1) + write(logunit,'(a,e27.17)') subname//' global_negative_final = ', global_negative_final(1) + write(logunit,'(a,e27.17)') subname//' global_sum_final = ', global_sum_final + end if + end if + + call t_stopf('MED:'//subname) + + end subroutine med_phases_post_rof_remove_negative_runoff + end module med_phases_post_rof_mod From f3761e0045cf6bc204fc0374c137a392ba8bcc48 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 21 Jun 2024 18:31:21 -0600 Subject: [PATCH 49/69] Removing negative runoff: Create a dedicated FieldBundle for mods Avoid modifying fields in place so that the ROF import fields are truly what came from ROF. So this removal of negative runoff will just appear in the fields mapped to OCN. --- mediator/med_phases_post_rof_mod.F90 | 105 +++++++++++++++++++++++++-- 1 file changed, 97 insertions(+), 8 deletions(-) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 6a8ba5f2c..61ebb4979 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -6,6 +6,10 @@ module med_phases_post_rof_mod use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_Field, ESMF_FieldCreate + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleAdd use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_REDUCE_SUM use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : complnd, compocn, compice, comprof @@ -15,14 +19,25 @@ module med_phases_post_rof_mod use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d + use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh use perf_mod , only : t_startf, t_stopf implicit none private public :: med_phases_post_rof + private :: med_phases_post_rof_create_rof_field_bundle private :: med_phases_post_rof_remove_negative_runoff + ! A local FieldBundle to hold a copy of rof fields, so that when we modify them, we + ! aren't modifying the import fields in-place. + type(ESMF_FieldBundle) :: FBrof_r + integer :: num_rof_fields + character(len=CS), allocatable :: rof_field_names(:) + + character(len=9), parameter :: fields_to_remove_negative_runoff(2) = & + ['Forr_rofl', 'Forr_rofi'] + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -39,6 +54,9 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock + real(r8), pointer :: data_orig(:) + real(r8), pointer :: data_copy(:) + integer :: n character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -53,16 +71,29 @@ subroutine med_phases_post_rof(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_post_rof_remove_negative_runoff(gcomp, 'Forr_rofl', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_phases_post_rof_remove_negative_runoff(gcomp, 'Forr_rofi', rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. ESMF_FieldBundleIsCreated(FBrof_r)) then + call med_phases_post_rof_create_rof_field_bundle(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + do n = 1, num_rof_fields + call fldbun_getdata1d(is_local%wrap%FBImp(comprof,comprof), trim(rof_field_names(n)), data_orig, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(FBrof_r, trim(rof_field_names(n)), data_copy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + data_copy(:) = data_orig(:) + end do + + do n = 1, size(fields_to_remove_negative_runoff) + call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff(n), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! map rof to lnd if (is_local%wrap%med_coupling_active(comprof,complnd)) then call t_startf('MED:'//trim(subname)//' map_rof2lnd') call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(comprof,comprof), & + FBSrc=FBrof_r, & FBDst=is_local%wrap%FBImp(comprof,complnd), & FBFracSrc=is_local%wrap%FBFrac(comprof), & field_normOne=is_local%wrap%field_normOne(comprof,complnd,:), & @@ -75,7 +106,7 @@ subroutine med_phases_post_rof(gcomp, rc) if (is_local%wrap%med_coupling_active(comprof,compocn)) then call t_startf('MED:'//trim(subname)//' map_rof2ocn') call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(comprof,comprof), & + FBSrc=FBrof_r, & FBDst=is_local%wrap%FBImp(comprof,compocn), & FBFracSrc=is_local%wrap%FBFrac(comprof), & field_normOne=is_local%wrap%field_normOne(comprof,compocn,:), & @@ -88,7 +119,7 @@ subroutine med_phases_post_rof(gcomp, rc) if (is_local%wrap%med_coupling_active(comprof,compice)) then call t_startf('MED:'//trim(subname)//' map_rof2ice') call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(comprof,comprof), & + FBSrc=FBrof_r, & FBDst=is_local%wrap%FBImp(comprof,compice), & FBFracSrc=is_local%wrap%FBFrac(comprof), & field_normOne=is_local%wrap%field_normOne(comprof,compice,:), & @@ -113,6 +144,61 @@ subroutine med_phases_post_rof(gcomp, rc) end subroutine med_phases_post_rof + subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) + !--------------------------------------------------------------- + ! Create FBrof_r + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: field + integer, parameter :: dbug_threshold = 20 ! threshold for writing debug information in this subroutine + character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_create_rof_field_bundle)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getmesh(is_local%wrap%FBImp(comprof,comprof), mesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), fieldCount=num_rof_fields, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(rof_field_names(num_rof_fields)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), fieldNameList=rof_field_names, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Note that, for simplicity, we'll add all rof fields to this local FieldBundle, even + ! though we only need to modify a subset of the fields. + FBrof_r = ESMF_FieldBundleCreate(name='FBrof_r', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, num_rof_fields + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(FBrof_r, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_post_rof_create_rof_field_bundle + subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) !--------------------------------------------------------------- ! For one runoff field, remove negative runoff by downweighting all positive runoff to @@ -157,7 +243,7 @@ subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) ! everywhere. areas => is_local%wrap%mesh_info(comprof)%areas - call fldbun_getdata1d(is_local%wrap%FBImp(comprof,comprof), trim(field_name), runoff_flux, rc=rc) + call fldbun_getdata1d(FBrof_r, trim(field_name), runoff_flux, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return local_positive(1) = 0.0_r8 @@ -243,6 +329,9 @@ subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) end if end if + if (dbug_flag > dbug_threshold) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if call t_stopf('MED:'//subname) end subroutine med_phases_post_rof_remove_negative_runoff From 8133bdca356ba8b44829d5b5cf5115fab2258028 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 21 Jun 2024 20:53:08 -0600 Subject: [PATCH 50/69] Add a namelist flag controlling the removal of negative runoff --- cime_config/namelist_definition_drv.xml | 11 ++++ mediator/med.F90 | 6 +- mediator/med_phases_post_rof_mod.F90 | 79 +++++++++++++++++++++---- 3 files changed, 84 insertions(+), 12 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 03dfcbe54..a63571444 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -872,6 +872,17 @@ off + + logical + control + MED_attributes + + If true, remove negative runoff by downweighting all positive runoff globally. + + + .true. + + integer diff --git a/mediator/med.F90 b/mediator/med.F90 index 4fdbb06a6..4e1f916f3 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1622,7 +1622,7 @@ subroutine DataInitialize(gcomp, rc) use med_phases_post_lnd_mod , only : med_phases_post_lnd use med_phases_post_glc_mod , only : med_phases_post_glc use med_phases_post_ocn_mod , only : med_phases_post_ocn - use med_phases_post_rof_mod , only : med_phases_post_rof + use med_phases_post_rof_mod , only : med_phases_post_rof_init, med_phases_post_rof use med_phases_post_wav_mod , only : med_phases_post_wav use med_phases_ocnalb_mod , only : med_phases_ocnalb_run use med_phases_aofluxes_mod , only : med_phases_aofluxes_init_fldbuns @@ -1924,6 +1924,10 @@ subroutine DataInitialize(gcomp, rc) call med_phases_prep_rof_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (is_local%wrap%comp_present(comprof)) then + call med_phases_post_rof_init(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- ! Set the data initialize flag to false !--------------------------------------- diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 61ebb4979..d4c5976b4 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -3,12 +3,13 @@ module med_phases_post_rof_mod ! Post rof phase, if appropriate, map initial rof->lnd, rof->ocn, rof->ice use NUOPC_Mediator , only : NUOPC_MediatorGet + use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : ESMF_Clock, ESMF_ClockIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldCreate - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleAdd use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_REDUCE_SUM use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 @@ -21,10 +22,12 @@ module med_phases_post_rof_mod use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh use perf_mod , only : t_startf, t_stopf + use shr_sys_mod , only : shr_sys_abort implicit none private + public :: med_phases_post_rof_init public :: med_phases_post_rof private :: med_phases_post_rof_create_rof_field_bundle private :: med_phases_post_rof_remove_negative_runoff @@ -35,6 +38,8 @@ module med_phases_post_rof_mod integer :: num_rof_fields character(len=CS), allocatable :: rof_field_names(:) + logical :: remove_negative_runoff + character(len=9), parameter :: fields_to_remove_negative_runoff(2) = & ['Forr_rofl', 'Forr_rofi'] @@ -45,6 +50,61 @@ module med_phases_post_rof_mod contains !================================================================================================ + subroutine med_phases_post_rof_init(gcomp, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(CL) :: cvalue + logical :: isPresent, isSet + logical :: flds_wiso + + character(len=*), parameter :: subname='(med_phases_post_rof_init)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + + call med_phases_post_rof_create_rof_field_bundle(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='remove_negative_runoff', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) remove_negative_runoff + else + remove_negative_runoff = .false. + end if + + ! remove_negative_runoff isn't yet set up to handle isotope fields, so ensure that + ! this isn't set along with flds_wiso + call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_wiso + else + flds_wiso = .false. + end if + if (remove_negative_runoff .and. flds_wiso) then + call shr_sys_abort('remove_negative_runoff must be set to false when flds_wiso is true') + end if + + if (maintask) then + write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff = ', remove_negative_runoff + end if + + 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_post_rof_init + subroutine med_phases_post_rof(gcomp, rc) ! input/output variables @@ -71,11 +131,6 @@ subroutine med_phases_post_rof(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. ESMF_FieldBundleIsCreated(FBrof_r)) then - call med_phases_post_rof_create_rof_field_bundle(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - do n = 1, num_rof_fields call fldbun_getdata1d(is_local%wrap%FBImp(comprof,comprof), trim(rof_field_names(n)), data_orig, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -84,10 +139,12 @@ subroutine med_phases_post_rof(gcomp, rc) data_copy(:) = data_orig(:) end do - do n = 1, size(fields_to_remove_negative_runoff) - call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff(n), rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + if (remove_negative_runoff) then + do n = 1, size(fields_to_remove_negative_runoff) + call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff(n), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if ! map rof to lnd if (is_local%wrap%med_coupling_active(comprof,complnd)) then @@ -174,7 +231,7 @@ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) call fldbun_getmesh(is_local%wrap%FBImp(comprof,comprof), mesh, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), fieldCount=num_rof_fields, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(rof_field_names(num_rof_fields)) From 8b6aa75f87a5300508e5c3526fb5124715e94f33 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 24 Jun 2024 07:19:57 -0600 Subject: [PATCH 51/69] this call is no longer needed and removing it fully removes the mct library from cesm --- cesm/driver/esm.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index a8342f54c..e2ed64891 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -1164,9 +1163,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo - call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) - - deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) end subroutine esm_init_pelayout From d183d22147a3e27c3bff0b336e42c3055bb67f94 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 24 Jun 2024 10:29:13 -0600 Subject: [PATCH 52/69] fix for UFS --- mediator/med_internalstate_mod.F90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 2855d5cca..46eb55c31 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -234,6 +234,7 @@ subroutine med_internalstate_init(gcomp, rc) integer :: num_icesheets character(len=CL) :: atm_mesh_name character(len=CL) :: lnd_mesh_name + logical :: isPresent, isSet character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -241,16 +242,20 @@ subroutine med_internalstate_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! determine if atm and lnd have the same mesh call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then - samegrid_atmlnd = .true. + if (isPresent .and. isSet) then + if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then + samegrid_atmlnd = .true. + else + samegrid_atmlnd = .false. + end if else - samegrid_atmlnd = .false. + samegrid_atmlnd = .true. end if ! See med_fraction_mod for the following definitions From 516b8ef76216958c7c1cf0d2453425ab92ce2412 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 24 Jun 2024 16:25:04 -0600 Subject: [PATCH 53/69] Remove negative runoff from new glc runoff fields --- mediator/med_phases_post_rof_mod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index d4c5976b4..ff05bb2e0 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -40,8 +40,11 @@ module med_phases_post_rof_mod logical :: remove_negative_runoff - character(len=9), parameter :: fields_to_remove_negative_runoff(2) = & - ['Forr_rofl', 'Forr_rofi'] + character(len=13), parameter :: fields_to_remove_negative_runoff(4) = & + ['Forr_rofl ', & + 'Forr_rofi ', & + 'Forr_rofl_glc', & + 'Forr_rofi_glc'] character(*) , parameter :: u_FILE_u = & __FILE__ From 4c5996ebe70765a613d79456953d30c66ce1f5ce Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 24 Jun 2024 16:31:55 -0600 Subject: [PATCH 54/69] Don't try to remove negative runoff on an absent field I'm not sure if this is necessary, but it seems like it could be in some configurations, and it won't hurt to do this check. --- mediator/med_phases_post_rof_mod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index ff05bb2e0..f58c901d4 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -120,6 +120,7 @@ subroutine med_phases_post_rof(gcomp, rc) real(r8), pointer :: data_orig(:) real(r8), pointer :: data_copy(:) integer :: n + logical :: exists character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -144,8 +145,12 @@ subroutine med_phases_post_rof(gcomp, rc) if (remove_negative_runoff) then do n = 1, size(fields_to_remove_negative_runoff) - call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff(n), rc) + call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff(n)), isPresent=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff(n), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end do end if From 2d3c1a77909808f38b747bbcd8956119219eca33 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Jun 2024 07:57:59 -0600 Subject: [PATCH 55/69] updates for new fields from ocn --- mediator/esmFldsExchange_cesm_mod.F90 | 56 ++++++++++++++++++++------- mediator/fd_cesm.yaml | 12 +++++- mediator/med_fraction_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 3 +- 4 files changed, 55 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 662b8c4dc..3ef6ddd1e 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1684,37 +1684,65 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compocn, 'Faoo_fco2_ocn') call addfld_to(compatm, 'Faoo_fco2_ocn') else - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_co2_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_co2_ocn', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fco2_ocn', rc=rc)) then call addmap_from(compocn, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if !----------------------------------------------------------------------------- - ! to atm: dms from ocean + ! to atm: surface flux of dms from ocean !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_dms_ocn') - call addfld_to(compatm, 'Faoo_dms_ocn') + call addfld_from(compocn, 'Faoo_fdms_ocn') + call addfld_to(compatm, 'Faoo_fdms_ocn') else - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_dms_ocn', compocn, mapconsd, 'one', ocn2atm_map) + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fdms_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fdms_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fdms_ocn', compocn, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if !----------------------------------------------------------------------------- - ! to atm: bromoform from ocean + ! to atm: surface flux of bromoform from ocean !----------------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_bromo_ocn') - call addfld_to(compatm, 'Faoo_bromo_ocn') + call addfld_from(compocn, 'Faoo_fbrf_ocn') + call addfld_to(compatm, 'Faoo_fbrf_ocn') else - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_bromo_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_bromo_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_bromo_ocn', compocn, mapconsd, 'one', ocn2atm_map) + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fbrf_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fbrf_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fbrf_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: surface flux of n2o from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fn2o_ocn') + call addfld_to(compatm, 'Faoo_fn2o_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fn2o_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fn2o_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fn2o_ocn', compocn, mapconsd, 'one', ocn2atm_map) + ! custom merge in med_phases_prep_atm + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: surface flux of nh3 from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fnh3_ocn') + call addfld_to(compatm, 'Faoo_fnh3_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fnh3_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fnh3_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fnh3_ocn', compocn, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index ae9c22ba6..c6d57857c 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -859,14 +859,22 @@ canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of CO2 (downward positive) # - - standard_name: Faoo_dms_ocn + - standard_name: Faoo_fdms_ocn canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of DMS (downward positive) # - - standard_name: Faoo_bromo_ocn + - standard_name: Faoo_fbrf_ocn canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of Bromoform (downward positive) # + - standard_name: Faoo_fn2o_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of N2O (downward positive) + # + - standard_name: Faoo_fnh3_ocn + canonical_units: moles m-2 s-1 + description: ocn import to med - surface flux of NH3 (downward positive) + # - standard_name: So_anidf canonical_units: 1 description: ocn import to med diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 63e8cfb2c..8245b5582 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -50,7 +50,7 @@ module med_fraction_mod ! *frac is the fraction of a particular component in the bundle. ! ! in general, on every grid, - ! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0 + ! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0 ! ! the fractions are computed fundamentally as follows (although the ! detailed implementation might be slightly different) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 0b876b0cf..e4baa1990 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,7 +32,8 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_to_ocn(3) = (/'Faoo_bromo_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn '/) + character(len=14) :: fldnames_to_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& + 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) character(*), parameter :: u_FILE_u = & __FILE__ From 5624c70818a6cd4dd85e460d9c4fb925f073a398 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Jun 2024 08:06:38 -0600 Subject: [PATCH 56/69] fixes for problems found in UFS --- mediator/med_internalstate_mod.F90 | 9 ++++--- mediator/med_phases_prep_atm_mod.F90 | 36 +++++++++++++++------------- 2 files changed, 25 insertions(+), 20 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 46eb55c31..95745098f 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -234,7 +234,8 @@ subroutine med_internalstate_init(gcomp, rc) integer :: num_icesheets character(len=CL) :: atm_mesh_name character(len=CL) :: lnd_mesh_name - logical :: isPresent, isSet + logical :: isPresent_lnd, isSet_lnd + logical :: isPresent_atm, isSet_atm character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -243,12 +244,14 @@ subroutine med_internalstate_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine if atm and lnd have the same mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then + + if ((isPresent_lnd .and. isSet_lnd) .and. (isPresent_atm .and. isSet_atm)) then if (trim(atm_mesh_name) == trim(lnd_mesh_name)) then samegrid_atmlnd = .true. else diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index e4baa1990..3ae84c97e 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,8 +32,8 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_to_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& - 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) + character(len=14) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& + 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) character(*), parameter :: u_FILE_u = & __FILE__ @@ -211,21 +211,23 @@ subroutine med_phases_prep_atm(gcomp, rc) call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do nf = 1,len(fldnames_to_ocn) - if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_to_ocn(nf)), rc=rc) .and. & - FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_to_ocn(nf)), rc=rc)) then - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), fieldName=trim(fldnames_to_ocn(nf)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), fieldName=trim(fldnames_to_ocn(nf)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr2) - dataptr2(n) = (ifrac(n) + ofrac(n)) * dataptr1(n) - end do - end if + do nf = 1,len(fldnames_from_ocn) + if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_from_ocn(nf)), rc=rc) .and. & + FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_from_ocn(nf)), rc=rc)) then + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), & + fieldName=trim(fldnames_from_ocn(nf)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2) + dataptr2(n) = (ifrac(n) + ofrac(n)) * dataptr1(n) + end do + end if end do ! Add enthalpy correction to sensible heat if appropriate From 9b3cec233e11bb2d467b5099af2e3caed7e07991 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Jun 2024 11:57:26 -0600 Subject: [PATCH 57/69] fixed bug --- mediator/med_internalstate_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 95745098f..d09903be5 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -245,10 +245,10 @@ subroutine med_internalstate_init(gcomp, rc) ! determine if atm and lnd have the same mesh call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=atm_mesh_name, & - isPresent=isPresent, isSet=isSet, rc=rc) + isPresent=isPresent_atm, isSet=isSet_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=lnd_mesh_name, & - isPresent=isPresent, isSet=isSet, rc=rc) + isPresent=isPresent_lnd, isSet=isSet_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ((isPresent_lnd .and. isSet_lnd) .and. (isPresent_atm .and. isSet_atm)) then From 66ce7e5786d0ac939efab7ae8b23835a8a8a64c9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 26 Jun 2024 07:02:15 -0600 Subject: [PATCH 58/69] fixed bug --- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 3ae84c97e..c4d872d1d 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -32,7 +32,7 @@ module med_phases_prep_atm_mod real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - character(len=14) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn ','Faoo_fco2_ocn ',& + character(len=13) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn','Faoo_fco2_ocn',& 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) character(*), parameter :: u_FILE_u = & @@ -211,7 +211,7 @@ subroutine med_phases_prep_atm(gcomp, rc) call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do nf = 1,len(fldnames_from_ocn) + do nf = 1,size(fldnames_from_ocn) if ( FB_FldChk(is_local%wrap%FBExp(compatm) , trim(fldnames_from_ocn(nf)), rc=rc) .and. & FB_FldChk(is_local%wrap%FBImp(compocn,compocn), trim(fldnames_from_ocn(nf)), rc=rc)) then call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), & From 06a825a01d6c1abdecdcb0a4c41068a95b83745c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 26 Jun 2024 09:39:52 -0600 Subject: [PATCH 59/69] bug fix for wav2ocn_map --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ed956d31a..7055fdf7e 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2988,7 +2988,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then - call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compice, 'Sw_elevation_spectrum', & mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') end if From f2af60b1f4f1bac8c896c501f74f3d9e377c84d4 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 27 Jun 2024 17:30:17 -0600 Subject: [PATCH 60/69] new fix for add_gusts --- mediator/med_phases_aofluxes_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index e6dfa9870..406160cb0 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1601,7 +1601,7 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (associated(aoflux_in%rainc)) then + if (add_gusts) then call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From 428ecc6cbe4d046be11b032445ab0fa7fdf212d0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Jun 2024 06:28:38 -0600 Subject: [PATCH 61/69] update share to use head of main in srt test --- .github/workflows/srt.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index c33bf0e34..95f7bbcdf 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -95,6 +95,8 @@ jobs: cd ../components/cdeps git checkout main git submodule update --init + cd ../../share + git checkout main - name: Cache ESMF id: cache-esmf From 1605a750fdc5f0b646017335bf4879df8a1719dd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Jun 2024 06:48:28 -0600 Subject: [PATCH 62/69] debug workflow --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 95f7bbcdf..efec7ba88 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -172,6 +172,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 From 7085a8772409c00796d49489f4d8ae0ffbf51e14 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 1 Jul 2024 02:35:09 -0600 Subject: [PATCH 63/69] bug fix primarily for usf testing --- mediator/med_fraction_mod.F90 | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 8245b5582..3755b8f74 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -134,7 +134,7 @@ module med_fraction_mod use med_methods_mod , only : fldbun_init => med_methods_FB_init use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_map_mod , only : med_map_field - use med_internalstate_mod , only : ncomps + use med_internalstate_mod , only : ncomps, samegrid_atmlnd implicit none private @@ -496,21 +496,26 @@ subroutine med_fraction_init(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(complnd,compatm,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Reset ofrac in FBFrac(compatm) + if (samegrid_atmlnd) then + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'lfrin', lfrac, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call fldbun_getdata1d(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (associated(ofrac)) then - do n = 1,size(lfrac) - lfrac(n) = lfrin(n) - ofrac(n) = 1.0_R8 - lfrac(n) - if (abs(ofrac(n)) < eps_fraclim) then - ofrac(n) = 0.0_R8 - end if - end do + do n = 1,size(lfrac) + ofrac(n) = 1.0_R8 - lfrac(n) + if (abs(ofrac(n)) < eps_fraclim) then + ofrac(n) = 0.0_R8 + end if + end do end if - end if + end if end if !--------------------------------------- From fbb231817a245c3f247401fea141db01f5f7794d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 1 Jul 2024 07:00:34 -0600 Subject: [PATCH 64/69] remove redundent use statement --- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 780a6c611..3d6c292ee 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,8 +1,6 @@ module seq_drydep_mod use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff - use shr_drydep_mod - implicit none ! method specification From 527f9a5b85d9df404e462b6851cf4d3d2505e526 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 1 Jul 2024 07:11:17 -0600 Subject: [PATCH 65/69] removed duplicate references --- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 780a6c611..199c2f1c0 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,7 +1,6 @@ module seq_drydep_mod use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff - use shr_drydep_mod implicit none From 96c9095dd6be3c9a7675b24169b966e70ae2a593 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 9 Jul 2024 08:06:48 -0600 Subject: [PATCH 66/69] gnu reports an error if this unused variable is not allocated --- mediator/med_phases_aofluxes_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 406160cb0..7697b5740 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1604,6 +1604,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (add_gusts) then call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! rainc is not used without add_gusts but some compilers complain about the unallocated pointer + ! in the subroutine interface + allocate(aoflux_in%rainc(1)) end if end if From df46cf16bd736d30bd18d3209721fa77a64654ac Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jul 2024 16:02:52 -0600 Subject: [PATCH 67/69] Separate the control of removing negative runoff for lnd vs glc At least for now, we want the default to be to remove negative runoff for lnd-derived runoff, but NOT for glc-derived runoff. --- cime_config/namelist_definition_drv.xml | 15 ++++++- mediator/med_phases_post_rof_mod.F90 | 55 +++++++++++++++++-------- 2 files changed, 51 insertions(+), 19 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 0f8622af1..165e34f4f 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -872,17 +872,28 @@ off - + logical control MED_attributes - If true, remove negative runoff by downweighting all positive runoff globally. + If true, remove negative runoff generated from the land component by downweighting all positive runoff globally. .true. + + logical + control + MED_attributes + + If true, remove negative runoff generated from the glc (ice sheet) component by downweighting all positive runoff globally. + + + .false. + + integer diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index f58c901d4..036eeca30 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -38,14 +38,16 @@ module med_phases_post_rof_mod integer :: num_rof_fields character(len=CS), allocatable :: rof_field_names(:) - logical :: remove_negative_runoff - - character(len=13), parameter :: fields_to_remove_negative_runoff(4) = & - ['Forr_rofl ', & - 'Forr_rofi ', & - 'Forr_rofl_glc', & + logical :: remove_negative_runoff_lnd + logical :: remove_negative_runoff_glc + + character(len=9), parameter :: fields_to_remove_negative_runoff_lnd(2) = & + ['Forr_rofl', & + 'Forr_rofi'] + character(len=13), parameter :: fields_to_remove_negative_runoff_glc(2) = & + ['Forr_rofl_glc', & 'Forr_rofi_glc'] - + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -77,12 +79,20 @@ subroutine med_phases_post_rof_init(gcomp, rc) call med_phases_post_rof_create_rof_field_bundle(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='remove_negative_runoff', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='remove_negative_runoff_lnd', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) remove_negative_runoff_lnd + else + remove_negative_runoff_lnd = .false. + end if + + call NUOPC_CompAttributeGet(gcomp, name='remove_negative_runoff_glc', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - read(cvalue,*) remove_negative_runoff + read(cvalue,*) remove_negative_runoff_glc else - remove_negative_runoff = .false. + remove_negative_runoff_glc = .false. end if ! remove_negative_runoff isn't yet set up to handle isotope fields, so ensure that @@ -94,12 +104,13 @@ subroutine med_phases_post_rof_init(gcomp, rc) else flds_wiso = .false. end if - if (remove_negative_runoff .and. flds_wiso) then - call shr_sys_abort('remove_negative_runoff must be set to false when flds_wiso is true') + if ((remove_negative_runoff_lnd .or. remove_negative_runoff_glc) .and. flds_wiso) then + call shr_sys_abort('remove_negative_runoff_lnd and remove_negative_runoff_glc must be set to false when flds_wiso is true') end if if (maintask) then - write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff = ', remove_negative_runoff + write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_lnd = ', remove_negative_runoff_lnd + write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_glc = ', remove_negative_runoff_glc end if if (dbug_flag > 20) then @@ -143,12 +154,22 @@ subroutine med_phases_post_rof(gcomp, rc) data_copy(:) = data_orig(:) end do - if (remove_negative_runoff) then - do n = 1, size(fields_to_remove_negative_runoff) - call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff(n)), isPresent=exists, rc=rc) + if (remove_negative_runoff_lnd) then + do n = 1, size(fields_to_remove_negative_runoff_lnd) + call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff_lnd(n)), isPresent=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff_lnd(n), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end if + if (remove_negative_runoff_glc) then + do n = 1, size(fields_to_remove_negative_runoff_glc) + call ESMF_FieldBundleGet(FBrof_r, fieldName=trim(fields_to_remove_negative_runoff_glc(n)), isPresent=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff(n), rc) + call med_phases_post_rof_remove_negative_runoff(gcomp, fields_to_remove_negative_runoff_glc(n), rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do From e4a5e5849abfd2164458741681b5b34f140ff13c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 Jul 2024 05:57:33 -0600 Subject: [PATCH 68/69] make sure variables are allocated before deallocating (#480) --- mediator/med_io_mod.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index f4abadaf6..6966a37d2 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1086,7 +1086,15 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call pio_syncfile(io_file) call pio_freedecomp(io_file, iodesc) endif - deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) + if(allocated(ownedElemCoords)) then + deallocate(ownedElemCoords) + endif + if(allocated(ownedElemCoords_x)) then + deallocate(ownedElemCoords_x) + endif + if(allocated(ownedElemCoords_y)) then + deallocate(ownedElemCoords_y) + endif if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From ce9cfe287907720f1cf159e1f9aff68865a75c5a Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 12 Jul 2024 20:30:24 +0200 Subject: [PATCH 69/69] fix bug in ocn2glc_coupling and add blom (#484) * add new functionality for transferring dms,bfr,n2o and nh3 from ocn to atm (only valid for BLOM) * added blom configurations * fixed bug in that advertising for So_t_depth and So_s_depth was never happening * addressed issues isn PR review Co-authored-by: Mariana Vertenstein --- cime_config/config_component_cesm.xml | 78 +++++++++++++++++++++---- cime_config/namelist_definition_drv.xml | 48 +++++++++++++++ mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 3 files changed, 117 insertions(+), 11 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index a19814827..4dd12e1e4 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -141,6 +141,54 @@ + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates DMS fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates Bromoform fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates N2O fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + + + logical + FALSE + TRUE,FALSE + run_coupling + env_run.xml + + Activates NH3 fluxes to be sent from ocn to atm. + Currently this is only available with BLOM ocean component. + + + char @@ -190,14 +238,15 @@ 24 24 - - + 24 + 24 144 24 + 24 24 @@ -205,6 +254,7 @@ 24 48 48 + 48 @@ -279,6 +329,7 @@ $ATM_NCPL 24 + 24 1 24 24 @@ -303,6 +354,7 @@ $ATM_NCPL $ATM_NCPL 1 + 1 run_coupling env_run.xml @@ -336,11 +388,13 @@ 1 $ATM_NCPL + $ATM_NCPL $ATM_NCPL $ATM_NCPL 1 8 8 + 8 $ATM_NCPL 1 $ATM_NCPL @@ -372,13 +426,14 @@ TRUE TRUE + TRUE TRUE FALSE run_component_cpl env_run.xml - Only used for compsets with DATM and POP (currently C, G and J): + Only used for compsets with DATM and [POP or MOM] (currently C, G and J): If true, compute albedos to work with daily avg SW down If false (default), albedos are computed with the assumption that downward solar radiation from the atm component has a diurnal cycle and zenith-angle @@ -419,14 +474,15 @@ TIGHT,OPTION1,OPTION2 TIGHT - OPTION2 - OPTION2 - OPTION1 - OPTION1 - OPTION1 + OPTION2 + OPTION2 + OPTION1 + OPTION1 + OPTION1 + OPTION1 OPTION2 - OPTION2 - OPTION2 + OPTION2 + OPTION2 run_coupling env_run.xml @@ -482,7 +538,9 @@ TRUE TRUE + TRUE TRUE + TRUE TRUE TRUE diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 165e34f4f..222a15b26 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2426,6 +2426,54 @@ + + logical + flds + ALLCOMP_attributes + + Pass DMS from OCN to ATM component + + + .false. + + + + + logical + flds + ALLCOMP_attributes + + Pass Bromoform from OCN to ATM component + + + .false. + + + + + logical + flds + ALLCOMP_attributes + + Pass N2O from OCN to ATM component + + + .false. + + + + + logical + flds + ALLCOMP_attributes + + Pass NH3 from OCN to ATM component + + + .false. + + + logical seq_flds diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 7055fdf7e..f6d98c229 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3322,7 +3322,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- ! to glc: from ocn !----------------------------- - if (is_local%wrap%ocn2glc_coupling) then + if (ocn2glc_coupling) then if (phase == 'advertise') then call addfld_from(compocn, 'So_t_depth') call addfld_from(compocn, 'So_s_depth')