diff --git a/components/data_comps/drof/src/drof_comp_mod.F90 b/components/data_comps/drof/src/drof_comp_mod.F90 index cb060e02ff84..3be703ec6998 100644 --- a/components/data_comps/drof/src/drof_comp_mod.F90 +++ b/components/data_comps/drof/src/drof_comp_mod.F90 @@ -25,7 +25,11 @@ module drof_comp_mod use drof_shr_mod , only: rest_file ! namelist input use drof_shr_mod , only: rest_file_strm ! namelist input use drof_shr_mod , only: nullstr - +#ifdef HAVE_MOAB + use seq_comm_mct, only : mrofid ! id of moab rof app + use seq_comm_mct, only : mbrof_data ! turn on if the data rof + use iso_c_binding +#endif ! ! !PUBLIC TYPES: implicit none @@ -67,6 +71,12 @@ subroutine drof_comp_init(Eclock, x2r, r2x, & SDROF, gsmap, ggrid, mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart) +#ifdef HAVE_MOAB + use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & + iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities, iMOAB_CreateVertices, & + iMOAB_GetMeshInfo, iMOAB_UpdateMeshInfo, iMOAB_WriteMesh +#endif ! !DESCRIPTION: initialize drof model implicit none @@ -92,7 +102,19 @@ subroutine drof_comp_init(Eclock, x2r, r2x, & logical :: exists ! file existance logical integer(IN) :: nu ! unit number character(CL) :: calendar ! model calendar - +#ifdef HAVE_MOAB + character*400 tagname + real(R8) latv, lonv + integer iv, tagindex, ilat, ilon, ierr !, arrsize, nfields + real(R8), allocatable, target :: data(:) + integer(IN), pointer :: idata(:) ! temporary + real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary + !real(R8), allocatable, target :: vtags_zero(:, :) + +#ifdef MOABDEBUG + character*100 outfile, wopts +#endif +#endif !--- formats --- character(*), parameter :: F00 = "('(drof_comp_init) ',8a)" character(*), parameter :: F0L = "('(drof_comp_init) ',a, l2)" @@ -164,6 +186,121 @@ subroutine drof_comp_init(Eclock, x2r, r2x, & call t_stopf('drof_initmctdom') + +#ifdef HAVE_MOAB + ilat = mct_aVect_indexRA(ggrid%data,'lat') + ilon = mct_aVect_indexRA(ggrid%data,'lon') + allocate(moab_vert_coords(lsize*3)) + do iv = 1, lsize + lonv = ggrid%data%rAttr(ilon, iv) * SHR_CONST_PI/180. + latv = ggrid%data%rAttr(ilat, iv) * SHR_CONST_PI/180. + moab_vert_coords(3*iv-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*iv-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*iv )=SIN(latv) + enddo + + ! create the vertices with coordinates from MCT domain + ierr = iMOAB_CreateVertices(mrofid, lsize*3, 3, moab_vert_coords) + if (ierr .ne. 0) & + call shr_sys_abort('Error: fail to create MOAB vertices in land model') + + tagname='GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mrofid, tagname, & + 0, & ! dense, integer + 1, & ! number of components + tagindex ) + if (ierr .ne. 0) & + call shr_sys_abort('Error: fail to retrieve GLOBAL_ID tag ') + + ! get list of global IDs for Dofs + call mct_gsMap_orderedPoints(gsMap, my_task, idata) + + ierr = iMOAB_SetIntTagStorage ( mrofid, tagname, lsize, & + 0, & ! vertex type + idata) + if (ierr .ne. 0) & + call shr_sys_abort('Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( mrofid, lsize, idata ); + if (ierr .ne. 0) & + call shr_sys_abort('Error: fail to resolve shared entities') + + deallocate(moab_vert_coords) + deallocate(idata) + + ierr = iMOAB_UpdateMeshInfo( mrofid ) + if (ierr .ne. 0) & + call shr_sys_abort('Error: fail to update mesh info ') + + allocate(data(lsize)) + ierr = iMOAB_DefineTagStorage( mrofid, "area:aream:frac:mask"//C_NULL_CHAR, & + 1, & ! dense, double + 1, & ! number of components + tagindex ) + if (ierr > 0 ) & + call shr_sys_abort('Error: fail to create tag: area:aream:frac:mask' ) + + data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'area'),:) + tagname='area'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsize, & + 0, & ! set data on vertices + data) + if (ierr > 0 ) & + call shr_sys_abort('Error: fail to get area tag ') + + ! set the same data for aream (model area) as area + ! data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'aream'),:) + tagname='aream'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsize, & + 0, & ! set data on vertices + data) + if (ierr > 0 ) & + call shr_sys_abort('Error: fail to set aream tag ') + + data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'mask'),:) + tagname='mask'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsize, & + 0, & ! set data on vertices + data) + if (ierr > 0 ) & + call shr_sys_abort('Error: fail to set mask tag ') + + data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'frac'),:) + tagname='frac'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsize, & + 0, & ! set data on vertices + data) + if (ierr > 0 ) & + call shr_sys_abort('Error: fail to set frac tag ') + + deallocate(data) + + ! define tags + ierr = iMOAB_DefineTagStorage( mrofid, trim(seq_flds_x2r_fields)//C_NULL_CHAR, & + 1, & ! dense, double + 1, & ! number of components + tagindex ) + if (ierr > 0 ) & + call shr_sys_abort('Error: fail to create seq_flds_x2r_fields tags ') + + ierr = iMOAB_DefineTagStorage( mrofid, trim(seq_flds_r2x_fields)//C_NULL_CHAR, & + 1, & ! dense, double + 1, & ! number of components + tagindex ) + if (ierr > 0 ) & + call shr_sys_abort('Error: fail to create seq_flds_r2x_fields tags ') + mbrof_data = .true. ! will have effects +#ifdef MOABDEBUG + ! debug test + outfile = 'RofDataMesh.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mrofid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' ERROR in writing data mesh rof ') + endif +#endif +#endif !---------------------------------------------------------------------------- ! Initialize MCT attribute vectors !---------------------------------------------------------------------------- @@ -256,6 +393,13 @@ subroutine drof_comp_run(EClock, x2r, r2x, & SDROF, gsmap, ggrid, mpicom, compid, my_task, master_task, & inst_suffix, logunit, case_name) +#ifdef MOABDEBUG + use iMOAB, only: iMOAB_WriteMesh +#endif +#ifdef HAVE_MOAB + use seq_flds_mod , only: seq_flds_r2x_fields + use seq_flds_mod , only: moab_set_tag_from_av +#endif ! !DESCRIPTION: run method for drof model implicit none @@ -285,7 +429,18 @@ subroutine drof_comp_run(EClock, x2r, r2x, & integer(IN) :: nu ! unit number integer(IN) :: nflds_r2x character(len=18) :: date_str +#ifdef HAVE_MOAB + real(R8), allocatable, target :: datam(:) + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! + character*400 tagname, mct_field +#ifdef MOABDEBUG + integer :: cur_drof_stepno, ierr + character*100 outfile, wopts, lnum +#endif +#endif character(*), parameter :: F00 = "('(drof_comp_run) ',8a)" character(*), parameter :: F04 = "('(drof_comp_run) ',2a,2i8,'s')" character(*), parameter :: subName = "(drof_comp_run) " @@ -384,6 +539,32 @@ subroutine drof_comp_run(EClock, x2r, r2x, & !---------------------------------------------------------------------------- ! Log output for model date !---------------------------------------------------------------------------- +#ifdef HAVE_MOAB + lsize = mct_avect_lsize(r2x) ! is it the same as mct_avect_lsize(avstrm) ? + allocate(datam(lsize)) ! + call mct_list_init(temp_list ,seq_flds_r2x_fields) + size_list=mct_list_nitem (temp_list) + do index_list = 1, size_list + call mct_list_get(mctOStr,index_list,temp_list) + mct_field = mct_string_toChar(mctOStr) + tagname= trim(mct_field)//C_NULL_CHAR + call moab_set_tag_from_av(tagname, r2x, index_list, mrofid, datam, lsize) ! loop over all a2x fields, not just a few + enddo + call mct_list_clean(temp_list) + deallocate(datam) ! maybe we should keep it around, deallocate at the final only? + +#ifdef MOABDEBUG + call seq_timemgr_EClockGetData( EClock, stepno=cur_drof_stepno ) + write(lnum,"(I0.2)")cur_drof_stepno + outfile = 'drof_comp_run_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) + if (ierr > 0 ) then + write(logunit,*) 'Failed to write data rof component state ' + endif +#endif + +#endif call t_startf('drof_run2') if (my_task == master_task) then diff --git a/components/data_comps/drof/src/rof_comp_mct.F90 b/components/data_comps/drof/src/rof_comp_mct.F90 index bafdc6d3f988..7257028e7b52 100644 --- a/components/data_comps/drof/src/rof_comp_mct.F90 +++ b/components/data_comps/drof/src/rof_comp_mct.F90 @@ -16,7 +16,11 @@ module rof_comp_mct use drof_comp_mod , only: drof_comp_init, drof_comp_run, drof_comp_final use drof_shr_mod , only: drof_shr_read_namelists use seq_flds_mod , only: seq_flds_x2r_fields, seq_flds_r2x_fields - +#ifdef HAVE_MOAB + use seq_comm_mct, only : mrofid ! iMOAB app id for rof + use iso_c_binding + use iMOAB , only: iMOAB_RegisterApplication +#endif ! !PUBLIC TYPES: implicit none private ! except @@ -53,6 +57,9 @@ module rof_comp_mct !=============================================================================== subroutine rof_init_mct( EClock, cdata, x2r, r2x, NLFilename ) +#ifdef HAVE_MOAB + use shr_stream_mod, only: shr_stream_getDomainInfo, shr_stream_getFile +#endif ! !DESCRIPTION: initialize drof model implicit none @@ -74,6 +81,16 @@ subroutine rof_init_mct( EClock, cdata, x2r, r2x, NLFilename ) integer(IN) :: shrloglev ! original log level logical :: read_restart ! start from restart integer(IN) :: ierr ! error code + + character(CL) :: filePath ! generic file path + character(CL) :: fileName ! generic file name + character(CS) :: timeName ! domain file: time variable name + character(CS) :: lonName ! domain file: lon variable name + character(CS) :: latName ! domain file: lat variable name + character(CS) :: hgtName ! domain file: hgt variable name + character(CS) :: maskName ! domain file: mask variable name + character(CS) :: areaName ! domain file: area variable name + character(*), parameter :: subName = "(rof_init_mct) " !------------------------------------------------------------------------------- @@ -140,11 +157,28 @@ subroutine rof_init_mct( EClock, cdata, x2r, r2x, NLFilename ) ! Initialize drof !---------------------------------------------------------------------------- +#ifdef HAVE_MOAB + ierr = iMOAB_RegisterApplication(trim("DROF")//C_NULL_CHAR, mpicom, compid, mrofid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering data rof comp' + call shr_sys_abort(subname//' ERROR in registering data rof comp') + endif +#endif + call drof_comp_init(Eclock, x2r, r2x, & seq_flds_x2r_fields, seq_flds_r2x_fields, & SDROF, gsmap, ggrid, mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart) - +#ifdef HAVE_MOAB + if (my_task == master_task) then + call shr_stream_getDomainInfo(SDROF%stream(1), filePath,fileName,timeName,lonName, & + latName,hgtName,maskName,areaName) + call shr_stream_getFile(filePath,fileName) + ! send path of river domain to MOAB coupler. + call seq_infodata_PutData( infodata, rof_domain=fileName) + write(logunit,*), ' filename: ', filename + endif +#endif !---------------------------------------------------------------------------- ! Fill infodata that needs to be returned from drof !---------------------------------------------------------------------------- diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 6b006b5d9188..e533d5bcbc2b 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -846,7 +846,7 @@ subroutine init_moab_land(bounds, LNDID) use spmdmod , only: masterproc use iMOAB , only: iMOAB_CreateVertices, iMOAB_WriteMesh, iMOAB_RegisterApplication, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_UpdateMeshInfo type(bounds_type) , intent(in) :: bounds integer , intent(in) :: LNDID ! id of the land app diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 85a300356c9a..ebb3ad8f58e3 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -508,7 +508,7 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en difference = sqrt(differenceg) iamroot = seq_comm_iamroot(CPLID) if ( iamroot ) then - print * , subname, trim(comp%ntype), ' comp, difference on tag ', trim(tagname), ' = ', difference + print * , subname, trim(comp%ntype), ' on cpl, difference on tag ', trim(tagname), ' = ', difference !call shr_sys_abort(subname//'differences between mct and moab values') endif deallocate(GlobalIds) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 2fd8bb1f5f60..0e2682192697 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1017,7 +1017,7 @@ subroutine cplcomp_moab_Init(infodata,comp) integer :: mpigrp_old ! component group pes integer :: ierr, context_id character*200 :: appname, outfile, wopts, ropts - character(CL) :: rtm_mesh + character(CL) :: rtm_mesh, rof_domain character(CL) :: lnd_domain character(CL) :: ocn_domain character(CL) :: atm_mesh @@ -1112,11 +1112,14 @@ subroutine cplcomp_moab_Init(infodata,comp) else ! we need to read the atm mesh on coupler, from domain file ierr = iMOAB_LoadMesh(mbaxid, trim(atm_mesh)//C_NULL_CHAR, & - "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;NO_CULLING", 0) + "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;REPARTITION;NO_CULLING", 0) if ( ierr /= 0 ) then write(logunit,*) 'Failed to load atm domain mesh on coupler' call shr_sys_abort(subname//' ERROR Failed to load atm domain mesh on coupler ') endif + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' load atm domain mesh from file '//trim(atm_mesh) + endif ! right now, turn atm_pg_active to true atm_pg_active = .true. ! FIXME TODO ! need to add global id tag to the app, it will be used in restart @@ -1290,11 +1293,14 @@ subroutine cplcomp_moab_Init(infodata,comp) else ! we need to read the ocean mesh on coupler, from domain file ierr = iMOAB_LoadMesh(mboxid, trim(ocn_domain)//C_NULL_CHAR, & - "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;NO_CULLING", 0) + "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION", 0) if ( ierr /= 0 ) then write(logunit,*) 'Failed to load ocean domain mesh on coupler' call shr_sys_abort(subname//' ERROR Failed to load ocean domain mesh on coupler ') endif + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' load ocn domain mesh from file '//trim(ocn_domain) + endif ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 @@ -1399,11 +1405,14 @@ subroutine cplcomp_moab_Init(infodata,comp) else ! we need to read the ocean mesh on coupler, from domain file ierr = iMOAB_LoadMesh(mbofxid, trim(ocn_domain)//C_NULL_CHAR, & - "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;NO_CULLING", 0) + "PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;NO_CULLING;REPARTITION", 0) if ( ierr /= 0 ) then write(logunit,*) 'Failed to load second ocean domain mesh on coupler' call shr_sys_abort(subname//' ERROR Failed to load second ocean domain mesh on coupler ') endif + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' load ocn domain mesh from file for second ocn instance '//trim(ocn_domain) + endif ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 @@ -1445,7 +1454,7 @@ subroutine cplcomp_moab_Init(infodata,comp) ! do not receive the mesh anymore, read it from file, then pair it with mlnid, component land PC mesh ! similar to rof mosart mesh - ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE='//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;REPARTITION'//C_NULL_CHAR call seq_infodata_GetData(infodata,lnd_domain=lnd_domain) outfile = trim(lnd_domain)//C_NULL_CHAR nghlay = 0 ! no ghost layers @@ -1458,6 +1467,9 @@ subroutine cplcomp_moab_Init(infodata,comp) write(logunit,*) subname,' error in reading land coupler mesh from ', trim(lnd_domain) call shr_sys_abort(subname//' ERROR in reading land coupler mesh') endif + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' load lnd domain mesh from file '//trim(lnd_domain) + endif ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 @@ -1633,15 +1645,23 @@ subroutine cplcomp_moab_Init(infodata,comp) ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) ! load mesh from scrip file passed from river model - call seq_infodata_GetData(infodata,rof_mesh=rtm_mesh) - outfile = trim(rtm_mesh)//C_NULL_CHAR - ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=RCBZOLTAN'//C_NULL_CHAR - + call seq_infodata_GetData(infodata,rof_mesh=rtm_mesh,rof_domain=rof_domain) + if ( trim(rof_domain) == 'none' ) then + outfile = trim(rtm_mesh)//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=RCBZOLTAN'//C_NULL_CHAR + else + outfile = trim(rof_domain)//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE=;REPARTITION'//C_NULL_CHAR + endif nghlay = 0 ! no ghost layers ierr = iMOAB_LoadMesh(mbrxid, outfile, ropts, nghlay) + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A)') subname//' load rof from file '//trim(outfile) + endif if ( ierr .ne. 0 ) then call shr_sys_abort( subname//' ERROR: cannot read rof mesh on coupler' ) end if + ! need to add global id tag to the app, it will be used in restart tagtype = 0 ! dense, integer numco = 1 diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 7514cc40db01..44ec0c6a3c7a 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1985,6 +1985,9 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) outfile = 'OcnCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in writing ocean after merging') + endif endif #endif if (first_time) then @@ -2846,7 +2849,22 @@ subroutine prep_ocn_calc_r2x_ox(timer) !--------------------------------------------------------------- ! Description ! Create r2x_ox (note that r2x_ox is a local module variable) - ! +#ifdef MOABDEBUG + use iMOAB, only : iMOAB_WriteMesh + use seq_comm_mct, only: num_moab_exports ! used to count the steps for moab files +#endif + ! Arguments + + ! Local Variables +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum + integer :: ierr +#endif +#ifdef MOABCOMP + character*100 :: tagname, mct_field + integer :: ent_type + real*8 :: difference +#endif ! Arguments character(len=*), intent(in) :: timer ! @@ -2861,10 +2879,8 @@ subroutine prep_ocn_calc_r2x_ox(timer) r2x_rx => component_get_c2x_cx(rof(eri)) call seq_map_map(mapper_Rr2o_liq, r2x_rx, r2x_ox(eri), & fldlist=seq_flds_r2o_liq_fluxes, norm=.false.) - call seq_map_map(mapper_Rr2o_ice, r2x_rx, r2x_ox(eri), & fldlist=seq_flds_r2o_ice_fluxes, norm=.false.) - if (flood_present) then call seq_map_map(mapper_Fr2o, r2x_rx, r2x_ox(eri), & fldlist='Flrr_flood', norm=.true.) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 10a23b9c5094..44d29e91ad2c 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -241,6 +241,7 @@ module seq_comm_mct integer, public :: mbrmapro ! iMOAB id for read map between river and ocean; it exists on coupler PEs ! similar to intx id, oa, la; integer, public :: mbrxoid ! iMOAB id for rof migrated to coupler for ocean context (r2o mapping) + logical, public :: mbrof_data = .false. ! made true if no rtm mesh, which means data rof ? integer, public :: mbintxar ! iMOAB id for intx mesh between atm and river integer, public :: mbintxlr ! iMOAB id for intx mesh between land and river integer, public :: mbintxrl ! iMOAB id for intx mesh between river and land diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 77236e027cc3..2e9838bc69c5 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -232,6 +232,7 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: iac_ny ! nx, ny of "2d" grid character(SHR_KIND_CL) :: lnd_domain ! path to land domain file character(SHR_KIND_CL) :: rof_mesh ! path to river mesh file + character(SHR_KIND_CL) :: rof_domain ! path to river domain file; only for data rof for now character(SHR_KIND_CL) :: ocn_domain ! path to ocean domain file, used by data ocean models only character(SHR_KIND_CL) :: atm_mesh ! path to atmosphere domain/mesh file, used by data atm models only @@ -792,6 +793,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%iac_ny = 0 infodata%lnd_domain = 'none' infodata%rof_mesh = 'none' + infodata%rof_domain = 'none' infodata%ocn_domain = 'none' ! will be used for ocean data models only; will be used as a signal infodata%atm_mesh = 'none' ! will be used for atmosphere data models only; will be used as a signal ! not sure if it exists always actually @@ -1037,8 +1039,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ glc_phase, rof_phase, atm_phase, lnd_phase, ocn_phase, ice_phase, & wav_phase, iac_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & lnd_nx, lnd_ny, rof_nx, rof_ny, ice_nx, ice_ny, ocn_nx, ocn_ny, & - iac_nx, iac_ny, glc_nx, glc_ny, lnd_domain, rof_mesh, ocn_domain, & - atm_mesh, eps_frac, & + iac_nx, iac_ny, glc_nx, glc_ny, lnd_domain, rof_mesh, rof_domain, & + ocn_domain, atm_mesh, eps_frac, & eps_amask, eps_agrid, eps_aarea, eps_omask, eps_ogrid, eps_oarea, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & @@ -1212,6 +1214,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(OUT) :: iac_ny character(SHR_KIND_CL), optional, intent(OUT) :: lnd_domain character(SHR_KIND_CL), optional, intent(OUT) :: rof_mesh + character(SHR_KIND_CL), optional, intent(OUT) :: rof_domain character(SHR_KIND_CL), optional, intent(OUT) :: ocn_domain character(SHR_KIND_CL), optional, intent(OUT) :: atm_mesh @@ -1401,6 +1404,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(iac_ny) ) iac_ny = infodata%iac_ny if ( present(lnd_domain) ) lnd_domain = infodata%lnd_domain if ( present(rof_mesh) ) rof_mesh = infodata%rof_mesh + if ( present(rof_domain) ) rof_domain = infodata%rof_domain if ( present(ocn_domain) ) ocn_domain = infodata%ocn_domain if ( present(atm_mesh) ) atm_mesh = infodata%atm_mesh @@ -1598,8 +1602,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ wav_phase, iac_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & lnd_nx, lnd_ny, rof_nx, rof_ny, ice_nx, ice_ny, ocn_nx, ocn_ny, & iac_nx, iac_ny, glc_nx, glc_ny, eps_frac, eps_amask, lnd_domain, & - rof_mesh, ocn_domain, atm_mesh, eps_agrid, eps_aarea, eps_omask, & - eps_ogrid, eps_oarea, & + rof_mesh, rof_domain, ocn_domain, atm_mesh, eps_agrid, eps_aarea, & + eps_omask, eps_ogrid, eps_oarea, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & mct_usealltoall, mct_usevector, glc_valid_input, nlmaps_verbosity) @@ -1771,6 +1775,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(IN) :: iac_ny character(SHR_KIND_CL), optional, intent(IN) :: lnd_domain character(SHR_KIND_CL), optional, intent(IN) :: rof_mesh + character(SHR_KIND_CL), optional, intent(IN) :: rof_domain character(SHR_KIND_CL), optional, intent(IN) :: ocn_domain character(SHR_KIND_CL), optional, intent(IN) :: atm_mesh @@ -1959,6 +1964,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(iac_ny) ) infodata%iac_ny = iac_ny if ( present(lnd_domain) ) infodata%lnd_domain = lnd_domain if ( present(rof_mesh) ) infodata%rof_mesh = rof_mesh + if ( present(rof_domain) ) infodata%rof_domain = rof_domain if ( present(ocn_domain) ) infodata%ocn_domain = ocn_domain if ( present(atm_mesh) ) infodata%atm_mesh = atm_mesh @@ -2271,6 +2277,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%iac_ny, mpicom) call shr_mpi_bcast(infodata%lnd_domain, mpicom) call shr_mpi_bcast(infodata%rof_mesh, mpicom) + call shr_mpi_bcast(infodata%rof_domain, mpicom) call shr_mpi_bcast(infodata%ocn_domain, mpicom) call shr_mpi_bcast(infodata%atm_mesh, mpicom) call shr_mpi_bcast(infodata%nextsw_cday, mpicom) @@ -2518,6 +2525,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%rof_ny, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%flood_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%rof_mesh, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%rof_domain, mpicom, pebcast=cmppe) ! dead_comps is true if it's ever set to true deads = infodata%dead_comps call shr_mpi_bcast(deads, mpicom, pebcast=cmppe) @@ -2990,6 +2998,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0I) subname,'iac_ny = ', infodata%iac_ny write(logunit,F0I) subname,'lnd_domain = ', infodata%lnd_domain write(logunit,F0I) subname,'rof_mesh = ', infodata%rof_mesh + write(logunit,F0I) subname,'rof_domain = ', infodata%rof_domain write(logunit,F0I) subname,'ocn_domain = ', infodata%ocn_domain write(logunit,F0I) subname,'atm_mesh = ', infodata%atm_mesh