diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 8ddbb727f..1c5d3ca67 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -244,7 +244,7 @@ subroutine SetModelServices(ensemble_driver, rc) call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRV_modelio"//trim(inst_suffix)//"::", rc=rc) + call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver log to the driver task 0 diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index d28ddacb0..bd124639f 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -5,13 +5,12 @@ module ESM !----------------------------------------------------------------------------- use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_log_mod , only : shrlogunit=> shr_log_unit use shr_sys_mod , only : shr_sys_abort use shr_mpi_mod , only : shr_mpi_bcast use shr_mem_mod , only : shr_mem_init use shr_file_mod , only : shr_file_setLogunit use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr - use perf_mod , only : t_initf + use perf_mod , only : t_initf, t_setLogUnit implicit none private @@ -220,8 +219,7 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - - call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) + call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -670,8 +668,11 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(gcomp, config, trim(compname)//"_modelio"//trim(inst_suffix)//"::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(gcomp, config, trim(compname)//"_modelio::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) then + print *,__FILE__,__LINE__,"ERROR reading ",trim(compname)," modelio from runconfig" + return + endif call ReadAttributes(gcomp, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -807,7 +808,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init2 + use shr_pio_mod , only : shr_pio_init, shr_pio_component_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -931,6 +932,11 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) inst_suffix = "" endif + ! Initialize PIO + ! This reads in the pio parameters that are independent of component + call shr_pio_init(driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 comms = MPI_COMM_NULL @@ -1174,12 +1180,14 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return enddo + ! Read in component dependent PIO parameters and initialize + ! IO systems + call shr_pio_component_init(driver, size(comps), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) - ! Initialize PIO - call shr_pio_init2(comps(2:), compLabels, comp_iamin, comms(2:), comp_comm_iam) deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 1516ffa10..12cf1537d 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -15,7 +15,6 @@ program esmApp use mpi use NUOPC, only : NUOPC_FieldDictionarySetup use ensemble_driver, only : SetServices - use shr_pio_mod, only : shr_pio_init1 use shr_sys_mod, only : shr_sys_abort implicit none @@ -44,17 +43,6 @@ program esmApp #endif COMP_COMM = MPI_COMM_WORLD - !----------------------------------------------------------------------------- - ! Initialize PIO - !----------------------------------------------------------------------------- - - ! For planned future use of async io using pio2. The IO tasks are seperated from the compute tasks here - ! and COMP_COMM will be MPI_COMM_NULL on the IO tasks which then call shr_pio_init2 and do not return until - ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models - ! supported - - call shr_pio_init1(8, "drv_in", COMP_COMM) - !----------------------------------------------------------------------------- ! Initialize ESMF !----------------------------------------------------------------------------- diff --git a/cesm/driver/esm_utils_mod.F90 b/cesm/nuopc_cap_share/esm_utils_mod.F90 similarity index 100% rename from cesm/driver/esm_utils_mod.F90 rename to cesm/nuopc_cap_share/esm_utils_mod.F90 diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 421606fd1..da7891c49 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - + use shr_pio_mod, only : shr_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -143,6 +143,8 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) ! local variables character(len=CL) :: diro character(len=CL) :: logfile + character(len=CL) :: inst_suffix + integer :: inst_index ! not used here !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -154,14 +156,23 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call get_component_instance(gcomp, inst_suffix, inst_index, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Multiinstance logfile name needs a correction + if(logfile(4:4) == '_') then + logfile = logfile(1:3)//trim(inst_suffix)//logfile(9:) + endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + ! Write the PIO settings to the beggining of each component log + call shr_pio_log_comp_settings(gcomp, logunit) + else logUnit = 6 endif - + ! TODO: shr_file mod is deprecated and should be removed. call shr_file_setLogUnit (logunit) - + end subroutine set_component_logging !=============================================================================== diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 34bb1423c..0d98f5c85 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -893,6 +893,7 @@ subroutine seq_drydep_readnl(NLFilename, drydep_nflds) !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + drydep_nflds = 0 !--- Open and read namelist --- if ( len_trim(NLFilename) == 0 )then diff --git a/cesm/nuopc_cap_share/shr_ndep_mod.F90 b/cesm/nuopc_cap_share/shr_ndep_mod.F90 index d3a9f9801..6e0fcb91a 100644 --- a/cesm/nuopc_cap_share/shr_ndep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ndep_mod.F90 @@ -49,9 +49,9 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species integer :: localpet integer :: mpicom - character(*),parameter :: F00 = "('(shr_ndep_read) ',8a)" - character(*),parameter :: FI1 = "('(shr_ndep_init) ',a,I2)" - character(*),parameter :: subName = '(shr_ndep_read) ' + + character(*),parameter :: subName = '(shr_ndep_readnl) ' + character(*),parameter :: F00 = "('(shr_ndep_readnl) ',8a)" ! ------------------------------------------------------------------ namelist /ndep_inparm/ ndep_list diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/shr_pio_mod.F90 new file mode 100644 index 000000000..e05a1ed99 --- /dev/null +++ b/cesm/nuopc_cap_share/shr_pio_mod.F90 @@ -0,0 +1,672 @@ +module shr_pio_mod + use pio + use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in + use shr_file_mod, only : shr_file_getunit, shr_file_freeunit + use shr_log_mod, only : shr_log_unit + use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr + use shr_sys_mod, only : shr_sys_abort +#ifndef NO_MPI2 + use mpi, only : mpi_comm_null, mpi_comm_world, mpi_finalize +#endif + use esm_utils_mod, only : chkerr + implicit none +#ifdef NO_MPI2 +#include +#endif + private + public :: shr_pio_init + public :: shr_pio_component_init + public :: shr_pio_getiosys + public :: shr_pio_getiotype + public :: shr_pio_getioroot + public :: shr_pio_finalize + public :: shr_pio_getioformat + public :: shr_pio_getrearranger + public :: shr_pio_log_comp_settings + + interface shr_pio_getiotype + module procedure shr_pio_getiotype_fromid, shr_pio_getiotype_fromname + end interface + interface shr_pio_getioformat + module procedure shr_pio_getioformat_fromid, shr_pio_getioformat_fromname + end interface + interface shr_pio_getiosys + module procedure shr_pio_getiosys_fromid, shr_pio_getiosys_fromname + end interface + interface shr_pio_getioroot + module procedure shr_pio_getioroot_fromid, shr_pio_getioroot_fromname + end interface + interface shr_pio_getindex + module procedure shr_pio_getindex_fromid, shr_pio_getindex_fromname + end interface + interface shr_pio_getrearranger + module procedure shr_pio_getrearranger_fromid, shr_pio_getrearranger_fromname + end interface + + type pio_comp_t + integer :: compid + integer :: pio_root + integer :: pio_stride + integer :: pio_numiotasks + integer :: pio_iotype + integer :: pio_rearranger + integer :: pio_netcdf_ioformat + logical :: pio_async_interface + end type pio_comp_t + + character(len=16), allocatable :: io_compname(:) + type(pio_comp_t), allocatable :: pio_comp_settings(:) + type (iosystem_desc_t), allocatable, target :: iosystems(:) + integer :: io_comm + logical :: pio_async_interface + integer, allocatable :: io_compid(:) + integer :: pio_debug_level=0, pio_blocksize=0 + integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 + + type(pio_rearr_opt_t) :: pio_rearr_opts + + integer :: total_comps + logical :: mastertask +#define DEBUGI 1 + +#ifdef DEBUGI + integer :: drank +#endif + + character(*), parameter :: u_FILE_u = & + __FILE__ + +contains + +!> +!! @public +!! @brief if pio_async_interface is true, tasks in io_comm do not return from this subroutine. +!! +!! if pio_async_interface is false each component namelist pio_inparm is read from compname_modelio.nml +!! Then a subset of each components compute tasks are Identified as IO tasks using the root, stride and count +!! variables to select the tasks. +!! +!< + + subroutine shr_pio_init(driver, rc) + use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet + use ESMF, only : ESMF_VMGet, ESMF_RC_NOT_VALID, ESMF_LogSetError + use NUOPC, only: NUOPC_CompAttributeGet + use shr_string_mod, only : shr_string_toLower + type(ESMF_GridComp) :: driver + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + integer :: i + character(len=shr_kind_cl) :: nlfilename, cname + integer :: ret + integer :: localPet + character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd + character(CS) :: msgstr + + character(*), parameter :: subName = '(shr_pio_init) ' + + call ESMF_GridCompGet(driver, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + mastertask = (localPet == 0) + + call NUOPC_CompAttributeGet(driver, name="pio_buffer_size_limit", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname,*) pio_buffer_size_limit + + ! 0 is a valid value of pio_buffer_size_limit + if(pio_buffer_size_limit>=0) then + if(mastertask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + call pio_set_buffer_size_limit(pio_buffer_size_limit) + endif + + call NUOPC_CompAttributeGet(driver, name="pio_blocksize", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname, *) pio_blocksize + + if(pio_blocksize>0) then + if(mastertask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + call pio_set_blocksize(pio_blocksize) + endif + + call NUOPC_CompAttributeGet(driver, name="pio_debug_level", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname, *) pio_debug_level + + if(pio_debug_level > 0) then + if(mastertask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level + ret = pio_set_log_level(pio_debug_level) + endif + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_type", value=pio_rearr_comm_type, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(trim(pio_rearr_comm_type) .eq. 'p2p') then + pio_rearr_opts%comm_type = PIO_REARR_COMM_P2P + else + pio_rearr_opts%comm_type = PIO_REARR_COMM_COLL + endif + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_fcd", value=pio_rearr_comm_fcd, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = (trim(cname) .eq. '.true.') + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_io2comp", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = (trim(cname) .eq. '.true.') + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = (trim(cname) .eq. '.true.') + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_io2comp", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = (trim(cname) .eq. '.true.') + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_comp2io", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname, *) pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req + + call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_io2comp", value=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cname, *) pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req + + if(mastertask) then + ! Log the rearranger options + write(shr_log_unit, *) "PIO rearranger options:" + write(shr_log_unit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" + write(shr_log_unit, *) " comm fcd = ", pio_rearr_opts%fcd, " (",trim(pio_rearr_comm_fcd),")" + if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req + end if + write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_hs + write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_isend + if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req + end if + write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_hs + write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend + end if + + end subroutine shr_pio_init + + subroutine shr_pio_component_init(driver, ncomps, rc) + use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated + use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use NUOPC_Driver, only : NUOPC_DriverGetComp + + type(ESMF_GridComp) :: driver + type(ESMF_VM) :: vm + integer, intent(in) :: ncomps + integer, intent(out) :: rc + + integer :: i, npets, default_stride + integer :: j + integer :: comp_comm, comp_rank + type(ESMF_GridComp), pointer :: gcomp(:) + character(CS) :: cval + character(CS) :: msgstr + integer :: do_async_init + type(iosystem_desc_t), allocatable :: async_iosystems(:) + + allocate(pio_comp_settings(ncomps)) + allocate(gcomp(ncomps)) + + allocate(io_compid(ncomps)) + allocate(io_compname(ncomps)) + allocate(iosystems(ncomps)) + + nullify(gcomp) + do_async_init = 0 + + call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + total_comps = size(gcomp) + + do i=1,total_comps + io_compid(i) = i+1 + + if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then + call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + io_compname(i) = trim(cval) + + call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write(cval, *) io_compid(i) + call NUOPC_CompAttributeSet(gcomp(i), name="MCTID", value=trim(cval), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=comp_comm, localPet=comp_rank, petCount=npets, & + ssiLocalPetCount=default_stride, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_stride + if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then + pio_comp_settings(i)%pio_stride = min(npets, default_stride) + endif + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_numiotasks + + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then + pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) + endif + + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_root + + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then + pio_comp_settings(i)%pio_root = 0 + endif + + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + select case (trim(cval)) + case ('pnetcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF + case ('netcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF + case ('netcdf4p') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P + case ('netcdf4c') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C + case DEFAULT + write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + + if (pio_comp_settings(i)%pio_async_interface) then + do_async_init = do_async_init + 1 + else + if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif + if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif + call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & + pio_rearr_opts) + endif + endif + enddo + if (do_async_init > 0) then + allocate(async_iosystems(do_async_init)) + j=1 + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + iosystems(i) = async_iosystems(j) + j = j+1 + endif + enddo + + endif + + deallocate(gcomp) + end subroutine shr_pio_component_init + + subroutine shr_pio_log_comp_settings(gcomp, logunit) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet + use NUOPC, only: NUOPC_CompAttributeGet + + type(ESMF_GridComp) :: gcomp + integer, intent(in) :: logunit + + integer :: compid + character(len=CS) :: name, cval + integer :: i + integer :: rc + logical :: isPresent + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="MCTID", value=cval, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(isPresent) then + read(cval, *) compid + i = shr_pio_getindex(compid) + endif + write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks + + write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride + + write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger + + write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root + + end subroutine shr_pio_log_comp_settings + +!=============================================================================== + subroutine shr_pio_finalize( ) + integer :: ierr + integer :: i + do i=1,total_comps + call pio_finalize(iosystems(i), ierr) + end do + + end subroutine shr_pio_finalize + +!=============================================================================== + function shr_pio_getiotype_fromid(compid) result(io_type) + integer, intent(in) :: compid + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_iotype + + end function shr_pio_getiotype_fromid + + + function shr_pio_getiotype_fromname(component) result(io_type) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(component))%pio_iotype + + end function shr_pio_getiotype_fromname + + function shr_pio_getrearranger_fromid(compid) result(io_type) + integer, intent(in) :: compid + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_rearranger + + end function shr_pio_getrearranger_fromid + + + function shr_pio_getrearranger_fromname(component) result(io_type) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_type + + io_type = pio_comp_settings(shr_pio_getindex(component))%pio_rearranger + + end function shr_pio_getrearranger_fromname + + function shr_pio_getioformat_fromid(compid) result(io_format) + integer, intent(in) :: compid + integer :: io_format + + io_format = pio_comp_settings(shr_pio_getindex(compid))%pio_netcdf_ioformat + + end function shr_pio_getioformat_fromid + + + function shr_pio_getioformat_fromname(component) result(io_format) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_format + + io_format = pio_comp_settings(shr_pio_getindex(component))%pio_netcdf_ioformat + + end function shr_pio_getioformat_fromname + +!=============================================================================== + function shr_pio_getioroot_fromid(compid) result(io_root) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + integer, intent(in) :: compid + integer :: io_root + + io_root = pio_comp_settings(shr_pio_getindex(compid))%pio_root + + end function shr_pio_getioroot_fromid + + function shr_pio_getioroot_fromname(component) result(io_root) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + integer :: io_root + + io_root = pio_comp_settings(shr_pio_getindex(component))%pio_root + + + end function shr_pio_getioroot_fromname + + +!=============================================================================== + + !! Given a component name, return the index of that component. + !! This is the index into io_compid, io_compname, comp_pio_iotype, etc. + !! If the given component is not found, return -1 + + integer function shr_pio_getindex_fromid(compid) result(index) + implicit none + integer, intent(in) :: compid + integer :: i + character(len=shr_kind_cl) :: msg + index = -1 + do i=1,total_comps + if(io_compid(i)==compid) then + index = i + exit + end if + end do + + if(index<0) then + write(msg, *) 'shr_pio_getindex :: compid=',compid,' out of allowed range: ' + call shr_sys_abort(msg) + end if + end function shr_pio_getindex_fromid + + + integer function shr_pio_getindex_fromname(component) result(index) + use shr_string_mod, only : shr_string_toupper + + implicit none + + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + + character(len=len(component)) :: component_ucase + integer :: i + + ! convert component name to upper case in order to match case in io_compname + component_ucase = shr_string_toUpper(component) + + index = -1 ! flag for not found + do i=1,size(io_compname) + if (trim(component_ucase) == trim(io_compname(i))) then + index = i + exit + end if + end do + if(index<0) then + call shr_sys_abort(' shr_pio_getindex:: compid out of allowed range') + end if + end function shr_pio_getindex_fromname + + function shr_pio_getiosys_fromid(compid) result(iosystem) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + integer, intent(in) :: compid + type(iosystem_desc_t), pointer :: iosystem + + iosystem => iosystems(shr_pio_getindex(compid)) + + end function shr_pio_getiosys_fromid + + function shr_pio_getiosys_fromname(component) result(iosystem) + ! 'component' must be equal to some element of io_compname(:) + ! (but it is case-insensitive) + character(len=*), intent(in) :: component + type(iosystem_desc_t), pointer :: iosystem + + iosystem => iosystems(shr_pio_getindex(component)) + + end function shr_pio_getiosys_fromname + + subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + use shr_string_mod, only : shr_string_toupper + character(len=*), intent(inout) :: pio_netcdf_format + integer, intent(out) :: pio_netcdf_ioformat + integer, intent(in) :: pio_default_netcdf_ioformat + + pio_netcdf_format = shr_string_toupper(pio_netcdf_format) + if ( pio_netcdf_format .eq. 'CLASSIC' ) then + pio_netcdf_ioformat = 0 + elseif ( pio_netcdf_format .eq. '64BIT_OFFSET' ) then + pio_netcdf_ioformat = PIO_64BIT_OFFSET + elseif ( pio_netcdf_format .eq. '64BIT_DATA' ) then + pio_netcdf_ioformat = PIO_64BIT_DATA + else + pio_netcdf_ioformat = pio_default_netcdf_ioformat + endif + + end subroutine shr_pio_getioformatfromname + + + subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) + use shr_string_mod, only : shr_string_toupper + character(len=*), intent(inout) :: typename + integer, intent(out) :: iotype + integer, intent(in) :: defaulttype + + typename = shr_string_toupper(typename) + if ( typename .eq. 'NETCDF' ) then + iotype = pio_iotype_netcdf + else if ( typename .eq. 'PNETCDF') then + iotype = pio_iotype_pnetcdf + else if ( typename .eq. 'NETCDF4P') then + iotype = pio_iotype_netcdf4p + else if ( typename .eq. 'NETCDF4C') then + iotype = pio_iotype_netcdf4c + else if ( typename .eq. 'NOTHING') then + iotype = defaulttype + else if ( typename .eq. 'DEFAULT') then + iotype = defaulttype + else + write(shr_log_unit,*) 'shr_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + iotype=pio_iotype_netcdf + end if + + end subroutine shr_pio_getiotypefromname + +!=============================================================================== + subroutine shr_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotasks, & + pio_iotype, iamroot, pio_rearranger, pio_netcdf_ioformat) + integer, intent(in) :: npes, mycomm + integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks + integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat + logical, intent(in) :: iamroot + character(*),parameter :: subName = '(shr_pio_namelist_set) ' + + call shr_mpi_bcast(pio_iotype , mycomm) + call shr_mpi_bcast(pio_stride , mycomm) + call shr_mpi_bcast(pio_root , mycomm) + call shr_mpi_bcast(pio_numiotasks, mycomm) + call shr_mpi_bcast(pio_rearranger, mycomm) + call shr_mpi_bcast(pio_netcdf_ioformat, mycomm) + + if (pio_root<0) then + pio_root = 1 + endif + if(.not. pio_async_interface) then + pio_root = min(pio_root,npes-1) +! If you are asking for parallel IO then you should use at least two io pes + if(npes > 1 .and. pio_numiotasks == 1 .and. & + (pio_iotype .eq. PIO_IOTYPE_PNETCDF .or. & + pio_iotype .eq. PIO_IOTYPE_NETCDF4P)) then + pio_numiotasks = 2 + pio_stride = min(pio_stride, npes/2) + endif + endif + + !-------------------------------------------------------------------------- + ! check/set/correct io pio parameters + !-------------------------------------------------------------------------- + if (pio_stride>0.and.pio_numiotasks<0) then + pio_numiotasks = max(1,npes/pio_stride) + else if(pio_numiotasks>0 .and. pio_stride<0) then + pio_stride = max(1,npes/pio_numiotasks) + else if(pio_numiotasks<0 .and. pio_stride<0) then + pio_stride = max(1,npes/4) + pio_numiotasks = max(1,npes/pio_stride) + end if + if(pio_stride == 1 .and. .not. pio_async_interface) then + pio_root = 0 + endif + if(pio_rearranger .ne. PIO_REARR_SUBSET .and. pio_rearranger .ne. PIO_REARR_BOX) then + write(shr_log_unit,*) 'pio_rearranger value, ',pio_rearranger,& + ', not supported - using PIO_REARR_BOX' + pio_rearranger = PIO_REARR_BOX + + endif + + + if (.not. pio_async_interface .and. & + pio_root + (pio_stride)*(pio_numiotasks-1) >= npes .or. & + pio_stride<=0 .or. pio_numiotasks<=0 .or. pio_root < 0 .or. & + pio_root > npes-1 ) then + if(npes<100) then + pio_stride = max(1,npes/4) + else if(npes<1000) then + pio_stride = max(1,npes/8) + else + pio_stride = max(1,npes/16) + end if + if(pio_stride>1) then + pio_numiotasks = npes/pio_stride + pio_root = min(1,npes-1) + else + pio_numiotasks = npes + pio_root = 0 + end if + if( iamroot) then + write(shr_log_unit,*) 'pio_stride, iotasks or root out of bounds - resetting to defaults: ',& + pio_stride,pio_numiotasks, pio_root + end if + end if + + end subroutine shr_pio_namelist_set + +!=============================================================================== + +end module shr_pio_mod diff --git a/cime_config/buildexe b/cime_config/buildexe index f2a0c905c..7f1a64471 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -105,7 +105,7 @@ def _main_func(): if os.path.isfile(exename): os.remove(exename) - cmd = "{} exec_se -j {} EXEC_SE={} MODEL=driver {} -f {} "\ + cmd = "{} exec_se -j {} EXEC_SE={} COMP_NAME=driver {} -f {} "\ .format(gmake, gmake_j, exename, gmake_args, makefile) diff --git a/cime_config/buildnml b/cime_config/buildnml index 2bc7c82b9..4cdcb7aac 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -100,7 +100,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #---------------------------------------------------- # Initialize namelist defaults #---------------------------------------------------- - nmlgen.init_defaults(infile, config) + nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) #-------------------------------- # Overwrite: set brnch_retain_casename @@ -233,7 +233,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # Write namelist file drv_in and initial input dataset list. #-------------------------------- namelist_file = os.path.join(confdir, "drv_in") - drv_namelist_groups = ["papi_inparm", "pio_default_inparm", "prof_inparm", "debug_inparm"] + drv_namelist_groups = ["papi_inparm", "prof_inparm", "debug_inparm"] nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups) #-------------------------------- @@ -288,7 +288,67 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): logger.info("Writing nuopc_runconfig for components {}".format(valid_comps)) nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") - nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path) + + if os.path.exists(nuopc_config_file): + os.unlink(nuopc_config_file) + + lid = os.environ["LID"] if "LID" in os.environ else get_timestamp("%y%m%d-%H%M%S") + + #if we are in multi-coupler mode the number of instances of mediator will be the max + # of any NINST_* value + maxinst = 1 + if case.get_value("MULTI_DRIVER"): + maxinst = case.get_value("NINST_MAX") + multi_driver = True + with open(nuopc_config_file, 'a', encoding="utf-8") as conffile: + nmlgen.write_nuopc_config_file(conffile, data_list_path=data_list_path) + + for model in case.get_values("COMP_CLASSES") + ['DRV']: + model = model.lower() + config = {} + config['component'] = model + nmlgen.init_defaults(infile, config, skip_entry_loop=True) + if model == 'cpl': + newgroup = "MED_modelio" + else: + newgroup = model.upper()+"_modelio" + nmlgen.rename_group("modelio", newgroup) + + if maxinst == 1 and model != 'cpl' and not multi_driver: + inst_count = case.get_value("NINST_" + model.upper()) + else: + inst_count = maxinst + if not model == 'drv': + for entry in ["pio_async_interface", + "pio_netcdf_format", + "pio_numiotasks", + "pio_rearranger", + "pio_root", + "pio_stride", + "pio_typename"]: + nmlgen.add_default(entry) + + + inst_string = "" + inst_index = 1 + while inst_index <= inst_count: + # determine instance string + if inst_count > 1: + inst_string = '_{:04d}'.format(inst_index) + + # Output the following to nuopc.runconfig + nmlgen.set_value("diro", case.get_value('RUNDIR')) + if model == 'cpl': + logfile = 'med' + inst_string + ".log." + str(lid) + else: + logfile = model + inst_string + ".log." + str(lid) + nmlgen.set_value("logfile", logfile) + inst_index = inst_index + 1 + nmlgen.write_nuopc_config_file(conffile) + + + + #-------------------------------- # Update nuopc.runconfig file if component needs it @@ -440,90 +500,6 @@ def compare_drv_flds_in(first, second, infile1, infile2): expect(False, "incompatible settings in drv_flds_in from \n %s \n and \n %s" % (infile1, infile2)) -############################################################################### -def _create_component_modelio_namelists(confdir, case, files): -############################################################################### - - # will need to create a new namelist generator - infiles = [] - definition_dir = os.path.dirname(files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component":"drv"})) - definition_file = [os.path.join(definition_dir, "namelist_definition_modelio.xml")] - - confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") - lid = os.environ["LID"] if "LID" in os.environ else get_timestamp("%y%m%d-%H%M%S") - - #if we are in multi-coupler mode the number of instances of mediator will be the max - # of any NINST_* value - maxinst = 1 - if case.get_value("MULTI_DRIVER"): - maxinst = case.get_value("NINST_MAX") - multi_driver = True - - nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") - for model in case.get_values("COMP_CLASSES"): - model = model.lower() - with NamelistGenerator(case, definition_file) as nmlgen: - config = {} - config['component'] = model - entries = nmlgen.init_defaults(infiles, config, skip_entry_loop=True) - if maxinst == 1 and model != 'cpl' and not multi_driver: - inst_count = case.get_value("NINST_" + model.upper()) - else: - inst_count = maxinst - - inst_string = "" - inst_index = 1 - while inst_index <= inst_count: - # determine instance string - if inst_count > 1: - inst_string = '_{:04d}'.format(inst_index) - - # Write out just the pio_inparm to the output file - for entry in entries: - nmlgen.add_default(entry) - - if inst_index == 1: - if model == "cpl": - modelio_file = "med_modelio.nml" - else: - modelio_file = model + "_modelio.nml" - nmlgen.write_nuopc_modelio_file(os.path.join(confdir, modelio_file)) - - # Output the following to nuopc.runconfig - moddiro = case.get_value('RUNDIR') - if model == 'cpl': - logfile = 'med' + inst_string + ".log." + str(lid) - else: - logfile = model + inst_string + ".log." + str(lid) - - with open(nuopc_config_file, 'a', encoding="utf-8") as outfile: - if model == 'cpl': - name = "MED" - else: - name = model.upper() - if inst_string: - outfile.write("{}_modelio{}::\n".format(name,inst_string)) - else: - outfile.write("{}_modelio::\n".format(name)) - outfile.write(" {}{}{}".format("diro = ", moddiro,"\n")) - outfile.write(" {}{}{}".format("logfile = ", logfile,"\n")) - outfile.write("::\n\n") - - # also write out a driver log file - if model == 'cpl': - name = "DRV" - logfile = 'drv' + inst_string + ".log." + str(lid) - if inst_string: - outfile.write("{}_modelio{}::\n".format(name,inst_string)) - else: - outfile.write("{}_modelio::\n".format(name)) - outfile.write(" {}{}{}".format("diro = ", moddiro,"\n")) - outfile.write(" {}{}{}".format("logfile = ", logfile,"\n")) - outfile.write("::\n\n") - - inst_index = inst_index + 1 - - ############################################################################### def buildnml(case, caseroot, component): ############################################################################### @@ -566,13 +542,13 @@ def buildnml(case, caseroot, component): comp_root_dir_cpl = files.get_value( "COMP_ROOT_DIR_CPL",{"component":"cpl"}, resolved=False) files.set_value("COMP_ROOT_DIR_CPL", comp_root_dir_cpl) - definition_file = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] - user_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") - if os.path.isfile(user_definition): - definition_file = [user_definition] + definition_files = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] + user_drv_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") + if os.path.isfile(user_drv_definition): + definition_files.append(user_drv_definition) # create the namelist generator object - independent of instance - nmlgen = NamelistGenerator(case, definition_file) + nmlgen = NamelistGenerator(case, definition_files) # create cplconf/namelist infile_text = "" @@ -586,9 +562,6 @@ def buildnml(case, caseroot, component): # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in _create_drv_namelists(case, infile, confdir, nmlgen, files) - # create the files comp_modelio.nml where comp = [atm, lnd...] - _create_component_modelio_namelists(confdir, case, files) - # set rundir rundir = case.get_value("RUNDIR") diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index aeb7770fc..b8909947b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -17,6 +17,15 @@ List of component classes supported by this driver + + char + + + case_comp + env_case.xml + Container environment to invoke, if any + + char cpl @@ -1919,15 +1928,6 @@ PIO configure options, see PIO configure utility for details - - logical - TRUE,FALSE - FALSE - run_pio - env_run.xml - TRUE implies perform asynchronous i/o - - char p2p,coll,default @@ -2031,6 +2031,25 @@ pio buffer size limit for pnetcdf output + + logical + TRUE,FALSE + run_pio + env_run.xml + TRUE implies perform asynchronous i/o + + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + + + char netcdf,pnetcdf,netcdf4p,netcdf4c,default diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index ba4bb69c0..b3becd832 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -503,6 +503,8 @@ FALSE TRUE + TRUE + TRUE TRUE TRUE diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 02c8f44ce..611c36619 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3537,28 +3537,13 @@ - + - - logical - pio - pio_default_inparm - - future asynchronous IO capability (not currently supported). - If pio_async_interface is .true. or {component}_PIO_* variable is not set or set to -99 - the component variable will be set using the pio_* value. - default: .false. - - - $PIO_ASYNC_INTERFACE - - - integer pio - pio_default_inparm + DRIVER_attributes 0,1,2,3,4,5,6 pio debug level @@ -3572,7 +3557,7 @@ integer pio - pio_default_inparm + DRIVER_attributes blocksize for pio box rearranger @@ -3584,7 +3569,7 @@ integer pio - pio_default_inparm + DRIVER_attributes pio buffer size limit @@ -3596,7 +3581,7 @@ char pio - pio_default_inparm + DRIVER_attributes p2p,coll,default pio rearranger communication type. @@ -3610,7 +3595,7 @@ char pio - pio_default_inparm + DRIVER_attributes 2denable,io2comp,comp2io,disable,default pio rearranger communication flow control direction. @@ -3623,7 +3608,7 @@ integer pio - pio_default_inparm + DRIVER_attributes pio rearranger communication max pending req (comp2io) @@ -3635,7 +3620,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable handshake (comp2io) @@ -3647,7 +3632,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable isends (comp2io) @@ -3659,7 +3644,7 @@ integer pio - pio_default_inparm + DRIVER_attributes pio rearranger communication max pending req (io2comp) @@ -3671,7 +3656,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable handshake (io2comp) @@ -3683,7 +3668,7 @@ logical pio - pio_default_inparm + DRIVER_attributes pio rearranger communication option: Enable isends (io2comp) default: .false. @@ -4026,4 +4011,176 @@ + + + + + + logical + pio + modelio + + future asynchronous IO capability (not currently supported). + If pio_async_interface is .true. or {component}_PIO_* variable is not set or set to -99 + the component variable will be set using the pio_* value. + default: .false. + + + $CPL_PIO_ASYNC_INTERFACE + $ATM_PIO_ASYNC_INTERFACE + $LND_PIO_ASYNC_INTERFACE + $OCN_PIO_ASYNC_INTERFACE + $ICE_PIO_ASYNC_INTERFACE + $ROF_PIO_ASYNC_INTERFACE + $GLC_PIO_ASYNC_INTERFACE + $WAV_PIO_ASYNC_INTERFACE + .false. + + + + + integer + pio + modelio + + stride of tasks in pio used generically, component based value takes precedent. + + + $CPL_PIO_STRIDE + $ATM_PIO_STRIDE + $LND_PIO_STRIDE + $OCN_PIO_STRIDE + $ICE_PIO_STRIDE + $ROF_PIO_STRIDE + $GLC_PIO_STRIDE + $WAV_PIO_STRIDE + -99 + + + + + integer + pio + modelio + + io task root in pio used generically, component based value takes precedent. + + + $CPL_PIO_ROOT + $ATM_PIO_ROOT + $LND_PIO_ROOT + $OCN_PIO_ROOT + $ICE_PIO_ROOT + $ROF_PIO_ROOT + $GLC_PIO_ROOT + $WAV_PIO_ROOT + -99 + + + + + integer + pio + modelio + -99,1,2 + + Rearranger method for pio 1=box, 2=subset. + + + $CPL_PIO_REARRANGER + $ATM_PIO_REARRANGER + $LND_PIO_REARRANGER + $OCN_PIO_REARRANGER + $ICE_PIO_REARRANGER + $ROF_PIO_REARRANGER + $GLC_PIO_REARRANGER + $WAV_PIO_REARRANGER + -99 + + + + + integer + pio + modelio + + number of io tasks in pio used generically, component based value takes precedent. + + + $CPL_PIO_NUMTASKS + $ATM_PIO_NUMTASKS + $LND_PIO_NUMTASKS + $OCN_PIO_NUMTASKS + $ICE_PIO_NUMTASKS + $ROF_PIO_NUMTASKS + $GLC_PIO_NUMTASKS + $WAV_PIO_NUMTASKS + -99 + + + + + char*64 + pio + modelio + netcdf,pnetcdf,netcdf4p,netcdf4c,default,nothing + + io type in pio used generically, component based value takes precedent. + valid values: netcdf, pnetcdf, netcdf4p, netcdf4c, default + + + $CPL_PIO_TYPENAME + $ATM_PIO_TYPENAME + $LND_PIO_TYPENAME + $OCN_PIO_TYPENAME + $ICE_PIO_TYPENAME + $ROF_PIO_TYPENAME + $GLC_PIO_TYPENAME + $WAV_PIO_TYPENAME + nothing + + + + + char*64 + pio + modelio + classic,64bit_offset,64bit_data + + format of netcdf files created by pio, ignored if + PIO_TYPENAME is netcdf4p or netcdf4c. 64bit_data only + supported in netcdf 4.4.0 or newer + + + $CPL_PIO_NETCDF_FORMAT + $ATM_PIO_NETCDF_FORMAT + $LND_PIO_NETCDF_FORMAT + $OCN_PIO_NETCDF_FORMAT + $ICE_PIO_NETCDF_FORMAT + $ROF_PIO_NETCDF_FORMAT + $GLC_PIO_NETCDF_FORMAT + $WAV_PIO_NETCDF_FORMAT + $ESP_PIO_NETCDF_FORMAT + + + + + char*256 + modelio + modelio + directory for output log files + + UNSET + + + + + char*256 + modelio + modelio + name of component output log file + + UNSET + + diff --git a/cime_config/namelist_definition_modelio.xml b/cime_config/namelist_definition_modelio.xml deleted file mode 100644 index 35af19567..000000000 --- a/cime_config/namelist_definition_modelio.xml +++ /dev/null @@ -1,207 +0,0 @@ - - - - - - - - - - - - - - integer - pio - pio_inparm - - stride of tasks in pio used generically, component based value takes precedent. - - - $CPL_PIO_STRIDE - $ATM_PIO_STRIDE - $LND_PIO_STRIDE - $OCN_PIO_STRIDE - $ICE_PIO_STRIDE - $ROF_PIO_STRIDE - $GLC_PIO_STRIDE - $WAV_PIO_STRIDE - -99 - - - - - integer - pio - pio_inparm - - io task root in pio used generically, component based value takes precedent. - - - $CPL_PIO_ROOT - $ATM_PIO_ROOT - $LND_PIO_ROOT - $OCN_PIO_ROOT - $ICE_PIO_ROOT - $ROF_PIO_ROOT - $GLC_PIO_ROOT - $WAV_PIO_ROOT - -99 - - - - - integer - pio - pio_inparm - -99,1,2 - - Rearranger method for pio 1=box, 2=subset. - - - $CPL_PIO_REARRANGER - $ATM_PIO_REARRANGER - $LND_PIO_REARRANGER - $OCN_PIO_REARRANGER - $ICE_PIO_REARRANGER - $ROF_PIO_REARRANGER - $GLC_PIO_REARRANGER - $WAV_PIO_REARRANGER - -99 - - - - - integer - pio - pio_inparm - - number of io tasks in pio used generically, component based value takes precedent. - - - $CPL_PIO_NUMTASKS - $ATM_PIO_NUMTASKS - $LND_PIO_NUMTASKS - $OCN_PIO_NUMTASKS - $ICE_PIO_NUMTASKS - $ROF_PIO_NUMTASKS - $GLC_PIO_NUMTASKS - $WAV_PIO_NUMTASKS - -99 - - - - - char*64 - pio - pio_inparm - netcdf,pnetcdf,netcdf4p,netcdf4c,default - - io type in pio used generically, component based value takes precedent. - valid values: netcdf, pnetcdf, netcdf4p, netcdf4c, default - - - $CPL_PIO_TYPENAME - $ATM_PIO_TYPENAME - $LND_PIO_TYPENAME - $OCN_PIO_TYPENAME - $ICE_PIO_TYPENAME - $ROF_PIO_TYPENAME - $GLC_PIO_TYPENAME - $WAV_PIO_TYPENAME - nothing - - - - - char*64 - pio - pio_inparm - classic,64bit_offset,64bit_data - - format of netcdf files created by pio, ignored if - PIO_TYPENAME is netcdf4p or netcdf4c. 64bit_data only - supported in netcdf 4.4.0 or newer - - - $CPL_PIO_NETCDF_FORMAT - $ATM_PIO_NETCDF_FORMAT - $LND_PIO_NETCDF_FORMAT - $OCN_PIO_NETCDF_FORMAT - $ICE_PIO_NETCDF_FORMAT - $ROF_PIO_NETCDF_FORMAT - $GLC_PIO_NETCDF_FORMAT - $WAV_PIO_NETCDF_FORMAT - $ESP_PIO_NETCDF_FORMAT - - - - - - - - - char*256 - modelio - modelio - input directory (no longer needed) - - UNSET - - - - - char*256 - modelio - modelio - directory for output log files - - UNSET - - - - - char*256 - modelio - modelio - name of component output log file - - UNSET - - - - diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a1b1a4897..4ee15aba1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -73,7 +73,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState, logunit, mastertask use med_internalstate_mod , only : compmed, compatm, complnd, compocn - use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps + 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 : coupling_mode @@ -1305,6 +1305,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if + ! --------------------------------------------------------------------- ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- @@ -1451,6 +1452,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- + ! CARMA fields (volumetric soil water) + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_soilw') + call addfld(fldListTo(compatm)%flds, 'Sl_soilw') + 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(fldListFr(complnd)%flds, 'Sl_soilw', compatm, mapconsf, 'lfrin', lnd2atm_map) + call addmrg(fldListTo(compatm)%flds, 'Sl_soilw', mrg_from=complnd, mrg_fld='Sl_soilw', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- if (phase == 'advertise') then @@ -1738,13 +1752,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) call addfld(fldListTo(compocn)%flds, 'Faxa_rain' ) call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) call addfld(fldListTo(compocn)%flds, 'Faxa_snow' ) else + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm wiht ofrac ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & @@ -1754,10 +1767,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & @@ -1766,10 +1775,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' , & mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow', mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') end if end if @@ -1777,12 +1782,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') - call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) - call addfld(fldListTo(compocn)%flds, 'Faxa_snow_wiso' ) else ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used @@ -1794,11 +1797,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso' , & mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_rain_wiso', & - mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & @@ -1808,11 +1806,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & mrg_type='sum_with_weights', mrg_fracname='ofrac') - else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg(fldListTo(compocn)%flds, 'Faxa_snow_wiso', & - mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') end if end if end if @@ -1954,6 +1947,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ocn: enthalpy from atm rain, snow, evaporation + ! to ocn: enthalpy from liquid and ice river runoff + ! to ocn: enthalpy from ice melt + ! --------------------------------------------------------------------- + ! Note - do not need to add addmap or addmrg for the following since they + ! will be computed directly in med_phases_prep_ocn + if (phase == 'advertise') then + call addfld(fldListTo(compocn)%flds, 'Foxx_hrain') + call addfld(fldListTo(compocn)%flds, 'Foxx_hsnow') + call addfld(fldListTo(compocn)%flds, 'Foxx_hevap') + call addfld(fldListTo(compocn)%flds, 'Foxx_hcond') + call addfld(fldListTo(compocn)%flds, 'Foxx_hrofl') + call addfld(fldListTo(compocn)%flds, 'Foxx_hrofi') + end if + ! --------------------------------------------------------------------- ! to ocn: merge zonal and meridional surface stress from ice and (atm or med) ! --------------------------------------------------------------------- @@ -3188,11 +3197,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if endif - !----------------------------------------------------------------------------- - ! CARMA fields (volumetric soil water) - !----------------------------------------------------------------------------- - ! TODO (mvertens, 2021-07-25): add this - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 81def7650..436232652 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -24,12 +24,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use NUOPC use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_chkerr + use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : mastertask, logunit use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, compwav, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use med_internalstate_mod , only : mapconsf_aofrac + use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod use med_internalstate_mod , only : coupling_mode, mapnames use esmFlds , only : med_fldList_type use esmFlds , only : addfld => med_fldList_AddFld @@ -48,12 +49,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname - character(len=CS), allocatable :: flds(:) + character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) character(len=*) , parameter :: subname='(esmFldsExchange_nems)' !-------------------------------------- rc = ESMF_SUCCESS + !--------------------------------------- + ! Get the internal state + !--------------------------------------- + nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -71,59 +76,82 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! scalar information !===================================================================== - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,ncomps - call addfld(fldListFr(n)%flds, trim(cvalue)) - call addfld(fldListTo(n)%flds, trim(cvalue)) - end do + if (phase == 'advertise') then + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,ncomps + call addfld(fldListFr(n)%flds, trim(cvalue)) + call addfld(fldListTo(n)%flds, trim(cvalue)) + end do + end if !===================================================================== ! Mediator fields !===================================================================== ! masks from components - call addfld(fldListFr(compice)%flds, 'Si_imask') - call addfld(fldListFr(compocn)%flds, 'So_omask') - call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice)) call addfld(fldListFr(compice)%flds, 'Si_imask') + if (is_local%wrap%comp_present(compocn)) call addfld(fldListFr(compocn)%flds, 'So_omask') + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') + end if + end if if ( trim(coupling_mode) == 'nems_orig_data') then - ! atm and ocn fields required for atm/ocn flux calculation' - allocate(flds(10)) - flds = (/'Sa_u ','Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum', & - 'Sa_u10m','Sa_v10m', 'Sa_t2m ', 'Sa_q2m '/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') - end do - deallocate(flds) - - ! unused fields needed by the atm/ocn flux computation - allocate(flds(13)) - flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & - 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & - 'Faox_evap', 'Faox_taux','Faox_tauy'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListMed_aoflux%flds, trim(fldname)) - end do - deallocate(flds) + ! atm fields required for atm/ocn flux calculation + allocate(flds(10)) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & + 'Sa_shum', 'Sa_u10m', 'Sa_v10m', 'Sa_t2m ', 'Sa_q2m '/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) )then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + end if + end if + end do + deallocate(flds) + + ! fields returned by the atm/ocn flux computation which are otherwise unadvertised + allocate(flds(8)) + flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ','So_ssq ', & + 'So_u10 ', 'So_duu10n', 'Faox_lat '/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds, trim(fldname)) + end if + end do + deallocate(flds) end if - ! unused fields from ice - but that are needed to be realized by the cice cap - call addfld(fldListFr(compice)%flds, 'Faii_evap') - call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn') + ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn') + end if !===================================================================== ! FIELDS TO ATMOSPHERE (compatm) !===================================================================== ! to atm: fractions (computed in med_phases_prep_atm) - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - ! ofrac used by atm - call addfld(fldListFr(compatm)%flds, 'Sa_ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compatm)%flds, 'Si_ifrac') + end if + ! ofrac used by atm + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compatm)%flds, 'Sa_ofrac') + end if + end if ! to atm: unmerged from ice ! - zonal surface stress, meridional surface stress @@ -135,44 +163,70 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - mean snow volume per unit area ! - surface temperatures allocate(flds(9)) - flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', & - 'Faii_sen ', 'Faii_lwup', 'Faii_evap', & - 'Si_vice ', 'Si_vsno ', 'Si_t '/) + flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', 'Faii_sen ', 'Faii_lwup', & + 'Faii_evap', 'Si_vice ', 'Si_vsno ', 'Si_t '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) allocate(flds(4)) - flds = (/'avsdr ', 'avsdf ', & - 'anidr ', 'anidf '/) + flds = (/'Si_avsdr', 'Si_avsdf', 'Si_anidr', 'Si_anidf'/) do n = 1,size(flds) - fldname = 'Si_'//trim(flds(n)) - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') + call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) ! to atm: unmerged surface temperatures from ocn - call addfld(fldListFr(compocn)%flds, 'So_t') - call addfld(fldListTo(compatm)%flds, 'So_t') - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') - call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') - - ! temporary conditional to avoid conflicts of advertised fields - ! when waves are passing through connectors - if (is_local%wrap%comp_present(compwav)) then - ! to atm: surface roughness length from wav - call addfld(fldListFr(compwav)%flds, 'Sw_z0') - call addfld(fldListTo(compatm)%flds, 'Sw_z0') - call addmap(fldListFr(compwav)%flds, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') - call addmrg(fldListTo(compatm)%flds, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compocn)%flds, 'So_t') + call addfld(fldListTo(compatm)%flds, 'So_t') + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') + call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + end if + end if + + ! to atm: surface roughness length from wav + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(compwav)%flds, 'Sw_z0') + call addfld(fldListTo(compatm)%flds, 'Sw_z0') + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sw_z0', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_z0', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + end if end if !===================================================================== @@ -180,116 +234,223 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) !===================================================================== ! to ocn: sea level pressure from atm - call addfld(fldListTo(compocn)%flds, 'Sa_pslv') - call addfld(fldListFr(compatm)%flds, 'Sa_pslv') - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') - - ! to ocn: from atm (custom merge in med_phases_prep_ocn) - ! - downward direct near-infrared incident solar radiation - ! - downward diffuse near-infrared incident solar radiation - ! - downward dirrect visible incident solar radiation - ! - downward diffuse visible incident solar radiation - allocate(flds(4)) - flds = (/'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Sa_pslv') + call addfld(fldListTo(compocn)%flds, 'Sa_pslv') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Sa_pslv', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_pslv', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, maptype, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from=compatm, mrg_fld='Sa_pslv', mrg_type='copy') + end if + end if + + ! to ocn: from sw from atm and sw net from ice (custom merge in med_phases_prep_ocn) + ! - downward direct near-infrared ("n" or "i") incident solar radiation + ! - downward diffuse near-infrared ("n" or "i") incident solar radiation + ! - downward direct visible ("v") incident solar radiation + ! - downward diffuse visible ("v") incident solar radiation + allocate(oflds(4)) + allocate(aflds(4)) + allocate(iflds(4)) + oflds = (/'Foxx_swnet_idr', 'Foxx_swnet_idf', 'Foxx_swnet_vdr', 'Foxx_swnet_vdf'/) + aflds = (/'Faxa_swndr' , 'Faxa_swndf' , 'Faxa_swvdr' , 'Faxa_swvdf'/) + iflds = (/'Fioi_swpen_idr', 'Fioi_swpen_idf', 'Fioi_swpen_vdr', 'Fioi_swpen_vdf'/) + do n = 1,size(oflds) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, trim(aflds(n))) + call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(aflds(n)), compocn, maptype, 'one', 'unset') + end if + end if end do - deallocate(flds) - ! to ocn: from ice net shortwave radiation (custom merge in med_phases_prep_ocn) - ! - downward direct near-infrared incident solar radiation - ! - downward diffuse near-infrared incident solar radiation - ! - downward dirrect visible incident solar radiation - ! - downward diffuse visible incident solar radiation - allocate(flds(4)) - flds = (/'vdr', 'vdf', 'idr', 'idf'/) - do n = 1,size(flds) - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_'//trim(flds(n))) - call addfld(fldListFr(compice)%flds, 'Fioi_swpen_'//trim(flds(n))) - call addmap(fldListFr(compice)%flds, 'Fioi_swpen_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + do n = 1,size(oflds) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compice)%flds, trim(iflds(n))) + call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + end if + end if end do - deallocate(flds) + deallocate(oflds) + deallocate(aflds) + deallocate(iflds) ! to ocn: rain and snow via auto merge allocate(flds(2)) flds = (/'Faxa_rain', 'Faxa_snow'/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if end do deallocate(flds) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn) - allocate(flds(2)) - flds = (/'taux', 'tauy'/) - do n = 1,size(flds) - call addfld(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n))) - call addfld(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n))) - call addfld(fldListFr(compatm)%flds, 'Faxa_'//trim(flds(n))) - call addmap(fldListFr(compatm)%flds, 'Faxa_'//trim(flds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + allocate(oflds(2)) + allocate(aflds(2)) + allocate(iflds(2)) + oflds = (/'Foxx_taux', 'Foxx_tauy'/) + aflds = (/'Faxa_taux', 'Faxa_tauy'/) + iflds = (/'Fioi_taux', 'Fioi_tauy'/) + do n = 1,size(oflds) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm) & + .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compice)%flds, trim(iflds(n))) + call addfld(fldListFr(compatm)%flds, trim(aflds(n))) + call addfld(fldListTo(compocn)%flds, trim(oflds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compatm)%flds, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') + end if + end if end do - deallocate(flds) + deallocate(oflds) + deallocate(aflds) + deallocate(iflds) ! to ocn: net long wave via auto merge - call addfld(fldListTo(compocn)%flds, 'Faxa_lwnet') - call addfld(fldListFr(compatm)%flds, 'Faxa_lwnet') - call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Faxa_lwnet', & - mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Faxa_lwnet') + call addfld(fldListTo(compocn)%flds, 'Faxa_lwnet') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Faxa_lwnet', & + mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%flds, 'Faxa_sen') - call addfld(fldListFr(compatm)%flds, 'Faxa_sen') - call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Faxa_sen') + call addfld(fldListTo(compocn)%flds, 'Faxa_sen') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_sen', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') + end if + end if ! to ocn: evaporation water flux (custom merge in med_phases_prep_ocn) - call addfld(fldListTo(compocn)%flds, 'Faxa_evap') - call addfld(fldListFr(compatm)%flds, 'Faxa_lat') - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compatm)%flds, 'Faxa_lat') + call addfld(fldListTo(compocn)%flds, 'Faxa_evap') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lat' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') + end if + end if else ! nems_orig_data ! to ocn: surface stress from mediator and ice stress via auto merge allocate(flds(2)) flds = (/'taux', 'tauy'/) do n = 1,size(flds) - call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(flds(n))) - call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(flds(n))) - call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & - mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & - mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) + call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(flds(n))) + call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(flds(n))) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(flds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(flds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(flds(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & + mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(flds(n)), & + mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') + end if + end if end do deallocate(flds) ! to ocn: long wave net via auto merge - call addfld(fldListTo(compocn)%flds, 'Foxx_lwnet') - call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') - call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & - mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & - mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_lwup') + call addfld(fldListFr(compatm)%flds, 'Faxa_lwdn') + call addfld(fldListTo(compocn)%flds, 'Foxx_lwnet') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! to ocn: sensible heat flux from mediator via auto merge - call addfld(fldListTo(compocn)%flds, 'Faox_sen') - call addmrg(fldListTo(compocn)%flds, 'Faox_sen', & - mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_sen') + call addfld(fldListTo(compocn)%flds, 'Faox_sen') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Faox_sen', & + mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if ! to ocn: evaporation water flux from mediator via auto merge - call addfld(fldListTo(compocn)%flds, 'Faox_evap') - call addmrg(fldListTo(compocn)%flds, 'Faox_evap', & - mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn)) then + call addfld(fldListMed_aoflux%flds , 'Faox_evap') + call addfld(fldListTo(compocn)%flds, 'Faox_evap') + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Faox_evap', & + mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + end if end if ! to ocn: water flux due to melting ice from ice @@ -299,30 +460,42 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) flds = (/'Fioi_meltw', 'Fioi_melth', 'Fioi_salt '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListFr(compice)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if + end if end do deallocate(flds) - ! temporary conditional to avoid conflicts of advertised fields - ! when waves are passing through connectors - if (is_local%wrap%comp_present(compwav)) then - ! to ocn: partitioned stokes drift from wav - allocate(flds(6)) - flds = (/'Sw_ustokes1', 'Sw_ustokes2', 'Sw_ustokes3', & - 'Sw_vstokes1', 'Sw_vstokes2', 'Sw_vstokes3'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - call addfld(fldListFr(compwav)%flds, trim(fldname)) - call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') - end do - deallocate(flds) - end if + ! to ocn: partitioned stokes drift from wav + allocate(flds(6)) + flds = (/'Sw_ustokes1', 'Sw_ustokes2', 'Sw_ustokes3', & + 'Sw_vstokes1', 'Sw_vstokes2', 'Sw_vstokes3'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then + call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) !===================================================================== ! FIELDS TO ICE (compice) @@ -338,14 +511,22 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ice: snow from atm allocate(flds(7)) - flds = (/'Faxa_lwdn ' , 'Faxa_swndr ' , 'Faxa_swvdr ' , 'Faxa_swndf ' , 'Faxa_swvdf ', & - 'Faxa_rain ' , 'Faxa_snow '/) + flds = (/'Faxa_lwdn ', 'Faxa_swndr', 'Faxa_swvdr', 'Faxa_swndf', 'Faxa_swvdf', & + 'Faxa_rain ', 'Faxa_snow '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) @@ -357,13 +538,22 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ice: meridional wind at the lowest model level from atm ! to ice: specific humidity at the lowest model level from atm allocate(flds(6)) - flds = (/'Sa_z ', 'Sa_pbot ', 'Sa_tbot ','Sa_u ','Sa_v ','Sa_shum '/) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & + 'Sa_shum'/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + endif + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) @@ -376,13 +566,22 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ice: meridional sea surface slope from ocn ! to ice: ocean melt and freeze potential from ocn allocate(flds(7)) - flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', 'So_dhdy', 'Fioo_q '/) + flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', & + 'So_dhdy', 'Fioo_q '/) do n = 1,size(flds) fldname = trim(flds(n)) - call addfld(fldListTo(compice)%flds, trim(fldname)) - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addmap(fldListFr(compocn)%flds, trim(fldname), compice, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compice)) then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + endif + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + call addmap(fldListFr(compocn)%flds, trim(fldname), compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if end do deallocate(flds) @@ -390,41 +589,61 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! FIELDS TO WAV (compwav) !===================================================================== - ! temporary conditional to avoid conflicts of advertised fields - ! when waves are passing through connectors - if (is_local%wrap%comp_present(compwav)) then - ! to wav - 10m winds and bottom temperature from atm - allocate(flds(3)) - flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') - call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end do - deallocate(flds) - - ! to wav: sea ice fraction - call addfld(fldListTo(compwav)%flds, 'Si_ifrac') - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') - - ! to wav: zonal sea water velocity from ocn - ! to wav: meridional sea water velocity from ocn - ! to wav: surface temperature from ocn - allocate(flds(3)) - flds = (/'So_u', 'So_v', 'So_t'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') - call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end do - deallocate(flds) - end if + ! to wav - 10m winds and bottom temperature from atm + allocate(flds(3)) + flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compwav)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) + + ! to wav: sea ice fraction + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + end if + end if + + ! to wav: zonal sea water velocity from ocn + ! to wav: meridional sea water velocity from ocn + ! to wav: surface temperature from ocn + allocate(flds(3)) + flds = (/'So_u', 'So_v', 'So_t'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) end subroutine esmFldsExchange_nems diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 55da80619..9196090d8 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1,7 +1,6 @@ field_dictionary: version_number: 0.0.0 institution: National ESPC, CSC & MCL Working Groups - source: automatically generated by the NUOPC Layer description: Community-based dictionary for shared coupling fields entries: # @@ -155,6 +154,10 @@ canonical_units: m description: land export # + - standard_name: Sl_soilw + canonical_units: m3/m3 + description: land export + # - standard_name: Sl_t canonical_units: K description: land export @@ -412,52 +415,52 @@ # - standard_name: Faxx_evap canonical_units: kg m-2 s-1 - description: atmosphere import + description: to atm merged water evaporation flux # - standard_name: Faxx_evap_wiso canonical_units: kg m-2 s-1 - description: atmosphere import + description: to atm merged water evaporation flux for 16O, 18O and HDO # - standard_name: Faxx_lat alias: mean_laten_heat_flx canonical_units: W m-2 - description: atmosphere import + description: to to atm merged latent heat flux # - standard_name: Faxx_lwup canonical_units: W m-2 - description: atmosphere import + description: to atm merged outgoing longwave radiation # - standard_name: Faxx_sen alias: mean_sensi_heat_flx canonical_units: W m-2 - description: atmosphere import + description: to atm merged sensible heat flux # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: atmosphere import - zonal component of momentum flux + description: to atm merged zonal surface stress # - standard_name: Faxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: atmosphere import - meridional component of momentum flux + description: to atm merged meridional surface stress # - standard_name: Sx_anidf canonical_units: 1 description: atmosphere import + description: to atm merged surface diffuse albedo (near-infrared radiation) # - standard_name: Sx_anidr canonical_units: 1 - description: atmosphere import + description: to atm merged direct surface albedo (near-infrared radiation) # - standard_name: Sx_avsdf canonical_units: 1 - description: atmosphere import + description: to atm merged surface diffuse albedo (visible radation) # - standard_name: Sx_avsdr canonical_units: 1 - description: atmosphere import + description: to atm merged direct surface albedo (visible radiation) # - standard_name: Sx_qref canonical_units: kg kg-1 @@ -980,6 +983,36 @@ # section: ocean import #----------------------------------- # + - standard_name: Foxx_hrain + alias: heat_content_lprec + canonical_units: W m-2 + description: to ocn heat content of rain + # + - standard_name: Foxx_hsnow + alias: heat_content_fprec + canonical_units: W m-2 + description: to ocn heat content of snow + # + - standard_name: Foxx_hevap + alias: heat_content_evap + canonical_units: W m-2 + description: to ocn heat content of evaporation + # + - standard_name: Foxx_hcond + alias: heat_content_cond + canonical_units: W m-2 + description: to ocn heat content of condensation + # + - standard_name: Foxx_hrofl + alias: heat_content_rofl + canonical_units: W m-2 + description: to ocn heat content of liquid runoff + # + - standard_name: Foxx_hrofi + alias: heat_content_rofi + canonical_units: W m-2 + description: to ocn heat content of ice runoff + # - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 diff --git a/mediator/med.F90 b/mediator/med.F90 index 4ac79c4cf..92be267e1 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -25,7 +25,6 @@ module MED use med_constants_mod , only : spval_init => med_constants_spval_init use med_constants_mod , only : spval => med_constants_spval use med_constants_mod , only : czero => med_constants_czero - use med_constants_mod , only : ispval_mask => med_constants_ispval_mask use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : Field_GeomPrint => med_methods_Field_GeomPrint use med_methods_mod , only : State_GeomPrint => med_methods_State_GeomPrint @@ -35,14 +34,13 @@ module MED use med_methods_mod , only : FB_Init => med_methods_FB_init use med_methods_mod , only : FB_Init_pointer => med_methods_FB_Init_pointer use med_methods_mod , only : FB_Reset => med_methods_FB_Reset - use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint use med_utils_mod , only : memcheck => med_memcheck use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling - use med_internalstate_mod , only : logunit, mastertask + use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, mastertask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc use med_internalstate_mod , only : coupling_mode @@ -550,7 +548,9 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet use med_internalstate_mod, only : mastertask, logunit, diagunit - +#ifdef CESMCOUPLED + use nuopc_shr_methods, only : set_component_logging +#endif type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -561,6 +561,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CL) :: cvalue integer :: localPet integer :: i + integer :: shrlogunit logical :: isPresent, isSet character(len=CX) :: msgString character(len=CX) :: diro @@ -591,8 +592,11 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (.not. isPresent .and. .not. isSet) then logfile = 'mediator.log' end if - open(newunit=logunit, file=trim(diro)//"/"//trim(logfile)) - +#ifdef CESMCOUPLED + call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) +#else + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) +#endif call NUOPC_CompAttributeGet(gcomp, name="do_budgets", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -649,13 +653,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize, ESMF_MAXSTR use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1 use med_phases_history_mod, only : med_phases_history_init + use med_internalstate_mod , only : atm_name ! input/output variables type(ESMF_GridComp) :: gcomp @@ -778,8 +783,7 @@ subroutine InitializeIPDv03p1(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) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' & - .or. trim(coupling_mode) == 'nems_orig_data') then + else if (trim(coupling_mode(1:4)) == 'nems') then call esmFldsExchange_nems(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'hafs') then @@ -790,6 +794,10 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if + ! Set default masking for mapping + call med_internalstate_defaultmasks(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------ ! Determine component present indices !------------------ @@ -1741,6 +1749,8 @@ 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:4)) == 'nems') then + call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) else if (trim(coupling_mode) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index ca8583803..2792d0a26 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -142,6 +142,13 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff integer :: f_heat_sen = unset_index ! heat : sensible + integer :: f_heat_rain = unset_index ! heat : heat content of rain + integer :: f_heat_snow = unset_index ! heat : heat content of snow + integer :: f_heat_evap = unset_index ! heat : heat content of evaporation + integer :: f_heat_cond = unset_index ! heat : heat content of evaporation + integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff + integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff + integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting integer :: f_watr_rain = unset_index ! water: precip, liquid @@ -264,6 +271,10 @@ subroutine med_diag_init(gcomp, rc) rc = ESMF_SUCCESS + if(mastertask) then + write(logunit,'(a)') ' Creating budget_diags%comps ' + end if + call NUOPC_CompAttributeGet(gcomp, name="budget_table_version", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (isPresent .and. isSet) then @@ -314,8 +325,19 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_latf ,'hlatfus' ) ! field heat : latent, fusion, snow call add_to_budget_diag(budget_diags%fields, f_heat_ioff ,'hiroff' ) ! field heat : latent, fusion, frozen runoff call add_to_budget_diag(budget_diags%fields, f_heat_sen ,'hsen' ) ! field heat : sensible - f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_sen ! field last index for heat + if (trim(budget_table_version) == 'v0') then + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_sen ! field last index for heat + else if (trim(budget_table_version) == 'v1') then + call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain + call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow + call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_rofi ! field last index for heat + end if ! ----------------------------------------- ! Water fluxes budget terms @@ -1549,6 +1571,19 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_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_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 @@ -1897,12 +1932,16 @@ 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 - budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + 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 - budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + if (trim(budget_table_version) == 'v0') then + budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX + end if if (flds_wiso) then call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_rain_wiso', & diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 8286118a9..b9b61e85e 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -15,6 +15,7 @@ module med_internalstate_mod ! public routines public :: med_internalstate_init public :: med_internalstate_coupling + public :: med_internalstate_defaultmasks integer, public :: logunit ! logunit for mediator log output integer, public :: diagunit ! diagunit for budget output (med master only) @@ -48,6 +49,9 @@ module med_internalstate_mod ! Coupling mode character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] + ! Default src and destination masks for mapping + integer, public, allocatable :: defaultMasks(:,:) + ! Mapping integer , public, parameter :: mapunset = 0 integer , public, parameter :: mapbilnr = 1 @@ -113,7 +117,7 @@ module med_internalstate_mod logical, pointer :: med_coupling_active(:,:) ! computes the active coupling integer :: num_icesheets ! obtained from attribute logical :: ocn2glc_coupling = .false. ! obtained from attribute - logical :: lnd2glc_coupling = .false. + logical :: lnd2glc_coupling = .false. logical :: accum_lnd2glc = .false. ! Mediator vm @@ -187,8 +191,8 @@ module med_internalstate_mod subroutine med_internalstate_init(gcomp, rc) - use ESMF , only : ESMF_LogFoundAllocError, ESMF_AttributeGet - use NUOPC_Comp , only : NUOPC_CompAttributeGet + use ESMF , only : ESMF_LogFoundAllocError, ESMF_AttributeGet + use NUOPC_Comp , only : NUOPC_CompAttributeGet ! input/output variables type(ESMF_GridComp) :: gcomp @@ -205,7 +209,7 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CL) :: cname character(len=ESMF_MAXSTR) :: mesh_glc character(len=CX) :: msgString - character(len=3) :: name + character(len=3) :: name integer :: num_icesheets character(len=*),parameter :: subname=' (internalstate init) ' !----------------------------------------------------------- @@ -329,7 +333,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Write out present flags write(logunit,*) do n1 = 1,ncomps - name = trim(compname(n1)) ! this trims the ice sheets index from the glc name + name = trim(compname(n1)) ! this trims the ice sheets index from the glc name write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//name//') = ',& is_local%wrap%comp_present(n1) write(logunit,'(a)') trim(msgString) @@ -353,7 +357,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Obtain dststatus_print setting if present call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) dststatus_print=(trim(cvalue)=="true") + if (isPresent .and. isSet) dststatus_print=(trim(cvalue) == "true") write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -551,4 +555,44 @@ subroutine med_internalstate_coupling(gcomp, rc) end subroutine med_internalstate_coupling + subroutine med_internalstate_defaultmasks(gcomp, rc) + + use med_constants_mod , only : ispval_mask => med_constants_ispval_mask + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + + !---------------------------------------------------------- + ! Default masking: for each component, the first element is + ! when it is the src and the second element is when it is + ! the destination + !---------------------------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(defaultMasks(ncomps,2)) + defaultMasks(:,:) = ispval_mask + 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:4)) == 'nems') then + if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1 + endif + if ( trim(coupling_mode) == 'hafs') then + if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,1) = 1 + endif + if ( trim(coupling_mode) /= 'cesm') then + if (is_local%wrap%comp_present(compatm) .and. trim(atm_name(1:4)) == 'datm') then + defaultMasks(compatm,1) = 0 + end if + end if + + end subroutine med_internalstate_defaultmasks + end module med_internalstate_mod diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 90fb0eb3f..1a1541475 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -576,6 +576,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 5921d927e..3717f5cba 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -342,7 +342,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, compname use med_internalstate_mod , only : coupling_mode, dststatus_print - use med_internalstate_mod , only : atm_name + use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask ! input/output variables @@ -389,63 +389,33 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ! set local flag to false ldstprint = .false. - polemethod=ESMF_POLEMETHOD_ALLAVG + ! set src and dst masking using defaults + srcMaskValue = defaultMasks(n1,1) + dstMaskValue = defaultMasks(n2,2) + + ! override defaults for specific cases if (trim(coupling_mode) == 'cesm') then - dstMaskValue = ispval_mask - srcMaskValue = ispval_mask - if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 - if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 if (n1 == compwav .and. n2 == compocn) then srcMaskValue = 0 dstMaskValue = ispval_mask endif - if (n1 == compwav .or. n2 == compwav) then - polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. - endif - else if (coupling_mode(1:4) == 'nems') then - if ( (n1 == compocn .or. n1 == compice .or. n1 == compwav) .and. & - (n2 == compocn .or. n2 == compice .or. n2 == compwav) ) then - srcMaskValue = 0 - dstMaskValue = 0 - else if (n1 == compatm .and. (n2 == compocn .or. n2 == compice .or. n2 == compwav)) then - srcMaskValue = 1 - dstMaskValue = 0 - if (atm_name(1:4).eq.'datm') then - srcMaskValue = 0 - endif - else if (n2 == compatm .and. (n1 == compocn .or. n1 == compice .or. n1 == compwav)) then - srcMaskValue = 0 - dstMaskValue = 1 - else - ! TODO: what should the condition be here? - dstMaskValue = ispval_mask + end if + if (trim(coupling_mode) == 'hafs') then + if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if - else if (trim(coupling_mode) == 'hafs') then - dstMaskValue = ispval_mask - srcMaskValue = ispval_mask - if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 - if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 - if (n1 == compatm .and. n2 == compocn) then - if (trim(atm_name).ne.'datm') then - srcMaskValue = 1 - endif - dstMaskValue = 0 - elseif (n1 == compocn .and. n2 == compatm) then - srcMaskValue = 0 - dstMaskValue = ispval_mask - elseif (n1 == compatm .and. n2 == compwav) then - dstMaskValue = 0 - elseif (n1 == compwav .and. n2 == compatm) then - srcMaskValue = 0 - dstMaskValue = ispval_mask - endif end if - write(string,'(a,i10,a,i10)') trim(compname(n1))//' to '//trim(compname(n2))//' srcMask = ', & srcMaskValue,' dstMask = ',dstMaskValue call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) + polemethod=ESMF_POLEMETHOD_ALLAVG + if (trim(coupling_mode) == 'cesm') then + if (n1 == compwav .or. n2 == compwav) then + polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. + endif + end if + ! Create route handle if (mapindex == mapfcopy) then if (mastertask) then diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 2b28164ac..794b84293 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1102,6 +1102,7 @@ subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_bilinr, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) end if + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_agrid2xgrid_input @@ -1144,6 +1145,7 @@ subroutine med_aofluxes_map_ogrid2xgrid_input(gcomp, rc) call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_ogrid2xgrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) end if + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_ogrid2xgrid_input @@ -1198,6 +1200,12 @@ subroutine med_aofluxes_map_agrid2ogrid_output(gcomp, rc) character(*),parameter :: subName = '(med_aofluxes_map_agrid2ogrid_output) ' !----------------------------------------------------------------------- + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do nf = 1,size(fldnames_aof_out) ! Create source field call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_a, fldnames_aof_out(nf), field=field_src, rc=rc) @@ -1220,6 +1228,7 @@ subroutine med_aofluxes_map_agrid2ogrid_output(gcomp, rc) call ESMF_FieldRegrid(field_src, field_dst, & routehandle=is_local%wrap%RH(compatm, compocn, maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_agrid2ogrid_output @@ -1262,6 +1271,7 @@ subroutine med_aofluxes_map_xgrid2agrid_output(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegrid(field_o, field_x, routehandle=rh_ogrid2xgrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field_x, farrayptr=ofrac_x, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1283,6 +1293,7 @@ subroutine med_aofluxes_map_xgrid2agrid_output(gcomp, rc) end do call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_xgrid2agrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return data_src(:) = data_src_save(:) deallocate(data_src_save) call ESMF_FieldGet(field_dst, farrayptr=data_dst, rc=rc) @@ -1338,6 +1349,7 @@ subroutine med_aofluxes_map_xgrid2ogrid_output(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_xgrid2ogrid, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end subroutine med_aofluxes_map_xgrid2ogrid_output diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 559e67345..d057506af 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -80,7 +80,7 @@ subroutine med_phases_post_lnd(gcomp, rc) if (is_local%wrap%lnd2glc_coupling) then call med_phases_prep_glc_accum_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Note that in this case med_phases_prep_glc_avg is called + ! Note that in this case med_phases_prep_glc_avg is called ! from med_phases_prep_glc in the run sequence else if (is_local%wrap%accum_lnd2glc) then call med_phases_prep_glc_accum_lnd(gcomp, rc) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index d3af6163d..485cdaf9b 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -13,6 +13,7 @@ module med_phases_prep_atm_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask @@ -26,6 +27,9 @@ module med_phases_prep_atm_mod private public :: med_phases_prep_atm + public :: med_phases_prep_atm_enthalpy_correction + + real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn character(*), parameter :: u_FILE_u = & __FILE__ @@ -221,6 +225,15 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Add enthalpy correction to sensible heat if appropriate + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr1(n) + global_htot_corr(1) + end do + end if + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if @@ -228,4 +241,48 @@ subroutine med_phases_prep_atm(gcomp, rc) end subroutine med_phases_prep_atm + !----------------------------------------------------------------------------- + subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) + + ! Enthalpy correction term calculation called by med_phases_prep_ocn_accum in + ! med_phases_prep_ocn_mod + ! Note that this is only called if the following fields are in FBExp(compocn) + ! 'Faxa_rain','Foxx_hrain','Faxa_snow' ,'Foxx_hsnow', + ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', + ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi' + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VM + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: hcorr(:) + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_htot_corr(1) + type(ESMF_VM) :: vm + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine sum of enthalpy correction for each hcorr index locally + local_htot_corr(1) = 0._r8 + do n = 1,size(hcorr) + local_htot_corr(1) = local_htot_corr(1) + hcorr(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_htot_corr, recvdata=global_htot_corr, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_atm_enthalpy_correction + end module med_phases_prep_atm_mod diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 0858462bc..de4599ffb 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -76,9 +76,11 @@ end subroutine med_phases_prep_ocn_init !----------------------------------------------------------------------------- subroutine med_phases_prep_ocn_accum(gcomp, rc) - use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi + use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction ! input/output variables type(ESMF_GridComp) :: gcomp @@ -87,6 +89,16 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt + real(r8) :: glob_area_inv + real(r8), pointer :: tocn(:) + real(r8), pointer :: rain(:), hrain(:) + real(r8), pointer :: snow(:), hsnow(:) + real(r8), pointer :: evap(:), hevap(:) + real(r8), pointer :: hcond(:) + real(r8), pointer :: rofl(:), hrofl(:) + real(r8), pointer :: rofi(:), hrofi(:) + real(r8), pointer :: areas(:) + real(r8), allocatable :: hcorr(:) character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -124,6 +136,80 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! compute enthaly associated with rain, snow, condensation and liquid river runoff + ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so + ! enthalpy from meltw **is not** included below + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc)) then + + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,size(tocn) + ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C + hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw + hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw + hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw + hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw + hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw + hrofi(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi(n) * shr_const_cpsw + end do + + ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm + ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only + ! need to calculate this if data is sent back to the atm + + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + allocate(hcorr(size(tocn))) + glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) + areas => is_local%wrap%mesh_info(compocn)%areas + do n = 1,size(tocn) + hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n)) * & + areas(n) * glob_area_inv + end do + call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hcorr) + end if + + end if + ! custom merges to ocean if (trim(coupling_mode) == 'cesm') then call med_phases_prep_ocn_custom_cesm(gcomp, rc) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 51e4db6e4..14cd7464b 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -73,7 +73,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & integer , optional , intent(in) :: opt_tod ! alarm tod (sec) type(ESMF_Time) , optional , intent(in) :: reftime ! reference time character(len=*) , optional , intent(in) :: alarmname ! alarm name - logical , optional , intent(in) :: advance_clock ! advance clock to trigger alarm + logical , optional , intent(in) :: advance_clock ! advance clock to trigger alarm integer , intent(out) :: rc ! Return code ! local variables @@ -264,7 +264,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Advance model clock to trigger alarm then reset model clock back to currtime - if (present(advance_clock)) then + if (present(advance_clock)) then if (advance_clock) then call ESMF_AlarmSet(alarm, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return